FS/FS/cdr.pm

   1 package FS::cdr;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK $DEBUG $me
   5              $conf $cdr_prerate %cdr_prerate_cdrtypenums
   6              $use_lrn $support_key
   7            );
   8 use Exporter;
   9 use List::Util qw(first min);
  10 use Tie::IxHash;
  11 use Date::Parse;
  12 use Date::Format;
  13 use Time::Local;
  14 use List::Util qw( first min );
  15 use Text::CSV_XS;
  16 use FS::UID qw( dbh );
  17 use FS::Conf;
  18 use FS::Record qw( qsearch qsearchs );
  19 use FS::cdr_type;
  20 use FS::cdr_calltype;
  21 use FS::cdr_carrier;
  22 use FS::cdr_batch;
  23 use FS::cdr_termination;
  24 use FS::rate;
  25 use FS::rate_prefix;
  26 use FS::rate_detail;
  27
  28 # LRN lookup
  29 use LWP::UserAgent;
  30 use HTTP::Request::Common qw(POST);
  31 use IO::Socket::SSL;
  32 use Cpanel::JSON::XS qw(decode_json);
  33
  34 @ISA = qw(FS::Record);
  35 @EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker _cdr_date_parse );
  36
  37 $DEBUG = 0;
  38 $me = '[FS::cdr]';
  39
  40 #ask FS::UID to run this stuff for us later
  41 FS::UID->install_callback( sub {
  42   $conf = new FS::Conf;
  43
  44   my @cdr_prerate_cdrtypenums;
  45   $cdr_prerate = $conf->exists('cdr-prerate');
  46   @cdr_prerate_cdrtypenums = $conf->config('cdr-prerate-cdrtypenums')
  47     if $cdr_prerate;
  48   %cdr_prerate_cdrtypenums = map { $_=>1 } @cdr_prerate_cdrtypenums;
  49
  50   $support_key = $conf->config('support-key');
  51   $use_lrn = $conf->exists('cdr-lrn_lookup');
  52
  53 });
  54
  55 =head1 NAME
  56
  57 FS::cdr - Object methods for cdr records
  58
  59 =head1 SYNOPSIS
  60
  61   use FS::cdr;
  62
  63   $record = new FS::cdr \%hash;
  64   $record = new FS::cdr { 'column' => 'value' };
  65
  66   $error = $record->insert;
  67
  68   $error = $new_record->replace($old_record);
  69
  70   $error = $record->delete;
  71
  72   $error = $record->check;
  73
  74 =head1 DESCRIPTION
  75
  76 An FS::cdr object represents an Call Data Record, typically from a telephony
  77 system or provider of some sort.  FS::cdr inherits from FS::Record.  The
  78 following fields are currently supported:
  79
  80 =over 4
  81
  82 =item acctid - primary key
  83
  84 =item calldate - Call timestamp (SQL timestamp)
  85
  86 =item clid - Caller*ID with text
  87
  88 =item src - Caller*ID number / Source number
  89
  90 =item dst - Destination extension
  91
  92 =item dcontext - Destination context
  93
  94 =item channel - Channel used
  95
  96 =item dstchannel - Destination channel if appropriate
  97
  98 =item lastapp - Last application if appropriate
  99
 100 =item lastdata - Last application data
 101
 102 =item src_ip_addr - Source IP address (dotted quad, zero-filled)
 103
 104 =item dst_ip_addr - Destination IP address (same)
 105
 106 =item dst_term - Terminating destination number (if different from dst)
 107
 108 =item startdate - Start of call (UNIX-style integer timestamp)
 109
 110 =item answerdate - Answer time of call (UNIX-style integer timestamp)
 111
 112 =item enddate - End time of call (UNIX-style integer timestamp)
 113
 114 =item duration - Total time in system, in seconds
 115
 116 =item billsec - Total time call is up, in seconds
 117
 118 =item disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
 119
 120 =item amaflags - What flags to use: BILL, IGNORE etc, specified on a per channel basis like accountcode.
 121
 122 =cut
 123
 124   #ignore the "omit" and "documentation" AMAs??
 125   #AMA = Automated Message Accounting.
 126   #default: Sets the system default.
 127   #omit: Do not record calls.
 128   #billing: Mark the entry for billing
 129   #documentation: Mark the entry for documentation.
 130
 131 =item accountcode - CDR account number to use: account
 132
 133 =item uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
 134
 135 =item userfield - CDR user-defined field
 136
 137 =item cdr_type - CDR type - see L<FS::cdr_type> (Usage = 1, S&E = 7, OC&C = 8)
 138
 139 =item charged_party - Service number to be billed
 140
 141 =item upstream_currency - Wholesale currency from upstream
 142
 143 =item upstream_price - Wholesale price from upstream
 144
 145 =item upstream_rateplanid - Upstream rate plan ID
 146
 147 =item rated_price - Rated (or re-rated) price
 148
 149 =item distance - km (need units field?)
 150
 151 =item islocal - Local - 1, Non Local = 0
 152
 153 =item calltypenum - Type of call - see L<FS::cdr_calltype>
 154
 155 =item description - Description (cdr_type 7&8 only) (used for cust_bill_pkg.itemdesc)
 156
 157 =item quantity - Number of items (cdr_type 7&8 only)
 158
 159 =item carrierid - Upstream Carrier ID (see L<FS::cdr_carrier>)
 160
 161 =cut
 162
 163 #Telstra =1, Optus = 2, RSL COM = 3
 164
 165 =item upstream_rateid - Upstream Rate ID
 166
 167 =item svcnum - Link to customer service (see L<FS::cust_svc>)
 168
 169 =item freesidestatus - NULL, processing-tiered, rated, done, skipped, no-charge, failed
 170
 171 =item freesiderewritestatus - NULL, done, skipped
 172
 173 =item cdrbatch
 174
 175 =item detailnum - Link to invoice detail (L<FS::cust_bill_pkg_detail>)
 176
 177 =back
 178
 179 =head1 METHODS
 180
 181 =over 4
 182
 183 =item new HASHREF
 184
 185 Creates a new CDR.  To add the CDR to the database, see L<"insert">.
 186
 187 Note that this stores the hash reference, not a distinct copy of the hash it
 188 points to.  You can ask the object for a copy with the I<hash> method.
 189
 190 =cut
 191
 192 # the new method can be inherited from FS::Record, if a table method is defined
 193
 194 sub table { 'cdr'; }
 195
 196 sub table_info {
 197   {
 198     'fields' => {
 199 #XXX fill in some (more) nice names
 200         #'acctid'                => '',
 201         'calldate'              => 'Call date',
 202         'clid'                  => 'Caller ID',
 203         'src'                   => 'Source',
 204         'dst'                   => 'Destination',
 205         'dcontext'              => 'Dest. context',
 206         'channel'               => 'Channel',
 207         'dstchannel'            => 'Destination channel',
 208         #'lastapp'               => '',
 209         #'lastdata'              => '',
 210         'src_ip_addr'           => 'Source IP',
 211         'dst_ip_addr'           => 'Dest. IP',
 212         'dst_term'              => 'Termination dest.',
 213         'startdate'             => 'Start date',
 214         'answerdate'            => 'Answer date',
 215         'enddate'               => 'End date',
 216         'duration'              => 'Duration',
 217         'billsec'               => 'Billable seconds',
 218         'disposition'           => 'Disposition',
 219         'amaflags'              => 'AMA flags',
 220         'accountcode'           => 'Account code',
 221         #'uniqueid'              => '',
 222         'userfield'             => 'User field',
 223         #'cdrtypenum'            => '',
 224         'charged_party'         => 'Charged party',
 225         #'upstream_currency'     => '',
 226         'upstream_price'        => 'Upstream price',
 227         #'upstream_rateplanid'   => '',
 228         #'ratedetailnum'         => '',
 229         'src_lrn'               => 'Source LRN',
 230         'dst_lrn'               => 'Dest. LRN',
 231         'rated_price'           => 'Rated price',
 232         'rated_cost'            => 'Rated cost',
 233         #'distance'              => '',
 234         #'islocal'               => '',
 235         #'calltypenum'           => '',
 236         #'description'           => '',
 237         #'quantity'              => '',
 238         'carrierid'             => 'Carrier ID',
 239         #'upstream_rateid'       => '',
 240         'svcnum'                => 'Freeside service',
 241         'freesidestatus'        => 'Freeside status',
 242         'freesiderewritestatus' => 'Freeside rewrite status',
 243         'cdrbatch'              => 'Legacy batch',
 244         'cdrbatchnum'           => 'Batch',
 245         'detailnum'             => 'Freeside invoice detail line',
 246     },
 247
 248   };
 249
 250 }
 251
 252 =item insert
 253
 254 Adds this record to the database.  If there is an error, returns the error,
 255 otherwise returns false.
 256
 257 =cut
 258
 259 # the insert method can be inherited from FS::Record
 260
 261 =item delete
 262
 263 Delete this record from the database.
 264
 265 =cut
 266
 267 # the delete method can be inherited from FS::Record
 268
 269 =item replace OLD_RECORD
 270
 271 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 272 returns the error, otherwise returns false.
 273
 274 =cut
 275
 276 # the replace method can be inherited from FS::Record
 277
 278 =item check
 279
 280 Checks all fields to make sure this is a valid CDR.  If there is
 281 an error, returns the error, otherwise returns false.  Called by the insert
 282 and replace methods.
 283
 284 Note: Unlike most types of records, we don't want to "reject" a CDR and we want
 285 to process them as quickly as possible, so we allow the database to check most
 286 of the data.
 287
 288 =cut
 289
 290 sub check {
 291   my $self = shift;
 292
 293 # we don't want to "reject" a CDR like other sorts of input...
 294 #  my $error =
 295 #    $self->ut_numbern('acctid')
 296 ##    || $self->ut_('calldate')
 297 #    || $self->ut_text('clid')
 298 #    || $self->ut_text('src')
 299 #    || $self->ut_text('dst')
 300 #    || $self->ut_text('dcontext')
 301 #    || $self->ut_text('channel')
 302 #    || $self->ut_text('dstchannel')
 303 #    || $self->ut_text('lastapp')
 304 #    || $self->ut_text('lastdata')
 305 #    || $self->ut_numbern('startdate')
 306 #    || $self->ut_numbern('answerdate')
 307 #    || $self->ut_numbern('enddate')
 308 #    || $self->ut_number('duration')
 309 #    || $self->ut_number('billsec')
 310 #    || $self->ut_text('disposition')
 311 #    || $self->ut_number('amaflags')
 312 #    || $self->ut_text('accountcode')
 313 #    || $self->ut_text('uniqueid')
 314 #    || $self->ut_text('userfield')
 315 #    || $self->ut_numbern('cdrtypenum')
 316 #    || $self->ut_textn('charged_party')
 317 ##    || $self->ut_n('upstream_currency')
 318 ##    || $self->ut_n('upstream_price')
 319 #    || $self->ut_numbern('upstream_rateplanid')
 320 ##    || $self->ut_n('distance')
 321 #    || $self->ut_numbern('islocal')
 322 #    || $self->ut_numbern('calltypenum')
 323 #    || $self->ut_textn('description')
 324 #    || $self->ut_numbern('quantity')
 325 #    || $self->ut_numbern('carrierid')
 326 #    || $self->ut_numbern('upstream_rateid')
 327 #    || $self->ut_numbern('svcnum')
 328 #    || $self->ut_textn('freesidestatus')
 329 #    || $self->ut_textn('freesiderewritestatus')
 330 #  ;
 331 #  return $error if $error;
 332
 333   for my $f ( grep { $self->$_ =~ /\D/ } qw(startdate answerdate enddate)){
 334     $self->$f( str2time($self->$f) );
 335   }
 336
 337   $self->calldate( $self->startdate_sql )
 338     if !$self->calldate && $self->startdate;
 339
 340   #was just for $format eq 'taqua' but can't see the harm... add something to
 341   #disable if it becomes a problem
 342   if ( $self->duration eq '' && $self->enddate && $self->startdate ) {
 343     $self->duration( $self->enddate - $self->startdate  );
 344   }
 345   if ( $self->billsec eq '' && $self->enddate && $self->answerdate ) {
 346     $self->billsec(  $self->enddate - $self->answerdate );
 347   }
 348
 349   if ( ! $self->enddate && $self->startdate && $self->duration ) {
 350     $self->enddate( $self->startdate + $self->duration );
 351   }
 352
 353   $self->set_charged_party;
 354
 355   #check the foreign keys even?
 356   #do we want to outright *reject* the CDR?
 357   my $error = $self->ut_numbern('acctid');
 358   return $error if $error;
 359
 360   if ( $self->freesidestatus ne 'done' ) {
 361     $self->set('detailnum', ''); # can't have this on an unbilled call
 362   }
 363
 364   #add a config option to turn these back on if someone needs 'em
 365   #
 366   #  #Usage = 1, S&E = 7, OC&C = 8
 367   #  || $self->ut_foreign_keyn('cdrtypenum',  'cdr_type',     'cdrtypenum' )
 368   #
 369   #  #the big list in appendix 2
 370   #  || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
 371   #
 372   #  # Telstra =1, Optus = 2, RSL COM = 3
 373   #  || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
 374
 375   $self->SUPER::check;
 376 }
 377
 378 =item is_tollfree [ COLUMN ]
 379
 380 Returns true when the cdr represents a toll free number and false otherwise.
 381
 382 By default, inspects the dst field, but an optional column name can be passed
 383 to inspect other field.
 384
 385 =cut
 386
 387 sub is_tollfree {
 388   my $self = shift;
 389   my $field = scalar(@_) ? shift : 'dst';
 390   my $country = $conf->config('tollfree-country') || '';
 391   if ( $country eq 'AU' ) {
 392     ( $self->$field() =~ /^(\+?61)?(1800|1300)/ ) ? 1 : 0;
 393   } elsif ( $country eq 'NZ' ) {
 394     ( $self->$field() =~ /^(\+?64)?(800|508)/ ) ? 1 : 0;
 395   } else { #NANPA (US/Canaada)
 396     ( $self->$field() =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0;
 397   }
 398 }
 399
 400 =item set_charged_party
 401
 402 If the charged_party field is already set, does nothing.  Otherwise:
 403
 404 If the cdr-charged_party-accountcode config option is enabled, sets the
 405 charged_party to the accountcode.
 406
 407 Otherwise sets the charged_party normally: to the src field in most cases,
 408 or to the dst field if it is a toll free number.
 409
 410 =cut
 411
 412 sub set_charged_party {
 413   my $self = shift;
 414
 415   my $conf = new FS::Conf;
 416
 417   unless ( $self->charged_party ) {
 418
 419     if ( $conf->exists('cdr-charged_party-accountcode') && $self->accountcode ){
 420
 421       my $charged_party = $self->accountcode;
 422       $charged_party =~ s/^0+//
 423         if $conf->exists('cdr-charged_party-accountcode-trim_leading_0s');
 424       $self->charged_party( $charged_party );
 425
 426     } elsif ( $conf->exists('cdr-charged_party-field') ) {
 427
 428       my $field = $conf->config('cdr-charged_party-field');
 429       $self->charged_party( $self->$field() );
 430
 431     } else {
 432
 433       if ( $self->is_tollfree ) {
 434         $self->charged_party($self->dst);
 435       } else {
 436         $self->charged_party($self->src);
 437       }
 438
 439     }
 440
 441   }
 442
 443 #  my $prefix = $conf->config('cdr-charged_party-truncate_prefix');
 444 #  my $prefix_len = length($prefix);
 445 #  my $trunc_len = $conf->config('cdr-charged_party-truncate_length');
 446 #
 447 #  $self->charged_party( substr($self->charged_party, 0, $trunc_len) )
 448 #    if $prefix_len && $trunc_len
 449 #    && substr($self->charged_party, 0, $prefix_len) eq $prefix;
 450
 451 }
 452
 453 =item set_status STATUS
 454
 455 Sets the status to the provided string.  If there is an error, returns the
 456 error, otherwise returns false.
 457
 458 If status is being changed from 'rated' to some other status, also removes
 459 any usage allocations to this CDR.
 460
 461 =cut
 462
 463 sub set_status {
 464   my($self, $status) = @_;
 465   my $old_status = $self->freesidestatus;
 466   $self->freesidestatus($status);
 467   my $error = $self->replace;
 468   if ( $old_status eq 'rated' and $status ne 'done' ) {
 469     # deallocate any usage
 470     foreach (qsearch('cdr_cust_pkg_usage', {acctid => $self->acctid})) {
 471       my $cust_pkg_usage = $_->cust_pkg_usage;
 472       $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $_->minutes);
 473       $error ||= $cust_pkg_usage->replace || $_->delete;
 474     }
 475   }
 476   $error;
 477 }
 478
 479 =item set_status_and_rated_price STATUS RATED_PRICE [ SVCNUM [ OPTION => VALUE ... ] ]
 480
 481 Sets the status and rated price.
 482
 483 Available options are: inbound, rated_pretty_dst, rated_regionname,
 484 rated_seconds, rated_minutes, rated_granularity, rated_ratedetailnum,
 485 rated_classnum, rated_ratename.  If rated_ratedetailnum is provided,
 486 will also set a recalculated L</rate_cost> in the rated_cost field
 487 after the other fields are set (does not work with inbound.)
 488
 489 If there is an error, returns the error, otherwise returns false.
 490
 491 =cut
 492
 493 sub set_status_and_rated_price {
 494   my($self, $status, $rated_price, $svcnum, %opt) = @_;
 495
 496   if ($opt{'inbound'}) {
 497
 498     my $term = $self->cdr_termination( 1 ); #1: inbound
 499     my $error;
 500     if ( $term ) {
 501       warn "replacing existing cdr status (".$self->acctid.")\n" if $term;
 502       $error = $term->delete;
 503       return $error if $error;
 504     }
 505     $term = FS::cdr_termination->new({
 506         acctid      => $self->acctid,
 507         termpart    => 1,
 508         rated_price => $rated_price,
 509         status      => $status,
 510     });
 511     foreach (qw(rated_seconds rated_minutes rated_granularity)) {
 512       $term->set($_, $opt{$_}) if exists($opt{$_});
 513     }
 514     $term->svcnum($svcnum) if $svcnum;
 515     return $term->insert;
 516
 517   } else {
 518
 519     $self->freesidestatus($status);
 520     $self->rated_price($rated_price);
 521     $self->$_($opt{$_})
 522       foreach grep exists($opt{$_}), map "rated_$_",
 523         qw( pretty_dst regionname seconds minutes granularity
 524             ratedetailnum classnum ratename );
 525     $self->svcnum($svcnum) if $svcnum;
 526     $self->rated_cost($self->rate_cost) if $opt{'rated_ratedetailnum'};
 527
 528     return $self->replace();
 529
 530   }
 531 }
 532
 533 =item parse_number [ OPTION => VALUE ... ]
 534
 535 Returns two scalars, the countrycode and the rest of the number.
 536
 537 Options are passed as name-value pairs.  Currently available options are:
 538
 539 =over 4
 540
 541 =item column
 542
 543 The column containing the number to be parsed.  Defaults to dst.
 544
 545 =item international_prefix
 546
 547 The digits for international dialing.  Defaults to '011'  The value '+' is
 548 always recognized.
 549
 550 =item domestic_prefix
 551
 552 The digits for domestic long distance dialing.  Defaults to '1'
 553
 554 =back
 555
 556 =cut
 557
 558 sub parse_number {
 559   my ($self, %options) = @_;
 560
 561   my $field = $options{column} || 'dst';
 562   my $intl = $options{international_prefix} || '011';
 563   # Still, don't break anyone's CDR rating if they have an empty string in
 564   # there. Require an explicit statement that there's no prefix.
 565   $intl = '' if lc($intl) eq 'none';
 566   my $countrycode = '';
 567   my $number = $self->$field();
 568
 569   my $to_or_from = 'concerning';
 570   $to_or_from = 'from' if $field eq 'src';
 571   $to_or_from = 'to' if $field eq 'dst';
 572   warn "parsing call $to_or_from $number\n" if $DEBUG;
 573
 574   #remove non-phone# stuff and whitespace
 575   $number =~ s/\s//g;
 576 #          my $proto = '';
 577 #          $dest =~ s/^(\w+):// and $proto = $1; #sip:
 578 #          my $siphost = '';
 579 #          $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
 580
 581   if (    $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
 582        || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
 583      )
 584   {
 585
 586     my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 );
 587     #first look for 1 digit country code
 588     if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) {
 589       $countrycode = $one;
 590       $number = $u1.$u2.$rest;
 591     } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
 592       $countrycode = $two;
 593       $number = $u2.$rest;
 594     } else { #3 digit country code
 595       $countrycode = $three;
 596       $number = $rest;
 597     }
 598
 599   } else {
 600     my $domestic_prefix =
 601       exists($options{domestic_prefix}) ? $options{domestic_prefix} : '';
 602     $countrycode = length($domestic_prefix) ? $domestic_prefix : '1';
 603     $number =~ s/^$countrycode//;# if length($number) > 10;
 604   }
 605
 606   return($countrycode, $number);
 607
 608 }
 609
 610 =item rate [ OPTION => VALUE ... ]
 611
 612 Rates this CDR according and sets the status to 'rated'.
 613
 614 Available options are: part_pkg, svcnum, plan_included_min,
 615 detail_included_min_hashref.
 616
 617 part_pkg is required.
 618
 619 If svcnum is specified, will also associate this CDR with the specified svcnum.
 620
 621 plan_included_min should be set to a scalar reference of the number of
 622 included minutes and will be decremented by the rated minutes of this
 623 CDR.
 624
 625 detail_included_min_hashref should be set to an empty hashref at the
 626 start of a month's rating and then preserved across CDRs.
 627
 628 =cut
 629
 630 sub rate {
 631   my( $self, %opt ) = @_;
 632   my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
 633
 634   if ( $DEBUG > 1 ) {
 635     warn "rating CDR $self\n".
 636          join('', map { "  $_ => ". $self->{$_}. "\n" } keys %$self );
 637   }
 638
 639   my $rating_method = $part_pkg->option_cacheable('rating_method') || 'prefix';
 640   my $method = "rate_$rating_method";
 641   $self->$method(%opt);
 642 }
 643
 644 #here?
 645 our %interval_cache = (); # for timed rates
 646
 647 sub rate_prefix {
 648   my( $self, %opt ) = @_;
 649   my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
 650   my $cust_pkg = $opt{'cust_pkg'};
 651
 652   my $da_rewrote = 0;
 653   # this will result in those CDRs being marked as done... is that
 654   # what we want?
 655   my @dirass = ();
 656   if ( $part_pkg->option_cacheable('411_rewrite') ) {
 657     my $dirass = $part_pkg->option_cacheable('411_rewrite');
 658     $dirass =~ s/\s//g;
 659     @dirass = split(',', $dirass);
 660   }
 661
 662   if ( length($self->dst) && grep { $self->dst eq $_ } @dirass ) {
 663     $self->dst('411');
 664     $da_rewrote = 1;
 665   }
 666
 667   my $reason = $part_pkg->check_chargable( $self,
 668                                            'da_rewrote'   => $da_rewrote,
 669                                          );
 670   if ( $reason ) {
 671     warn "not charging for CDR ($reason)\n" if $DEBUG;
 672     return $self->set_status_and_rated_price( 'skipped',
 673                                               0,
 674                                               $opt{'svcnum'},
 675                                             );
 676   }
 677
 678   if ( $part_pkg->option_cacheable('skip_same_customer')
 679       and ! $self->is_tollfree ) {
 680     my ($dst_countrycode, $dst_number) = $self->parse_number(
 681       column => 'dst',
 682       international_prefix => $part_pkg->option_cacheable('international_prefix'),
 683       domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
 684     );
 685     my $dst_same_cust = FS::Record->scalar_sql(
 686         'SELECT COUNT(svc_phone.svcnum) AS count '.
 687         'FROM cust_pkg ' .
 688         'JOIN cust_svc   USING (pkgnum) ' .
 689         'JOIN svc_phone  USING (svcnum) ' .
 690         'WHERE svc_phone.countrycode = ' . dbh->quote($dst_countrycode) .
 691         ' AND svc_phone.phonenum = ' . dbh->quote($dst_number) .
 692         ' AND cust_pkg.custnum = ' . $cust_pkg->custnum,
 693     );
 694     if ( $dst_same_cust > 0 ) {
 695       warn "not charging for CDR (same source and destination customer)\n" if $DEBUG;
 696       return $self->set_status_and_rated_price( 'skipped',
 697                                                 0,
 698                                                 $opt{'svcnum'},
 699                                               );
 700     }
 701   }
 702
 703   ###
 704   # look up rate details based on called station id
 705   # (or calling station id for toll free calls)
 706   ###
 707
 708   my $eff_ratenum = $self->is_tollfree('accountcode')
 709     ? $part_pkg->option_cacheable('accountcode_tollfree_ratenum')
 710     : '';
 711
 712   my( $to_or_from, $column );
 713   if(
 714         ( $self->is_tollfree
 715            && ! $part_pkg->option_cacheable('disable_tollfree')
 716         )
 717      or ( $eff_ratenum
 718            && $part_pkg->option_cacheable('accountcode_tollfree_field') eq 'src'
 719         )
 720     )
 721   { #tollfree call
 722     $to_or_from = 'from';
 723     $column = 'src';
 724   } else { #regular call
 725     $to_or_from = 'to';
 726     $column = 'dst';
 727   }
 728
 729   #determine the country code
 730   my ($countrycode, $number) = $self->parse_number(
 731     column => $column,
 732     international_prefix => $part_pkg->option_cacheable('international_prefix'),
 733     domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
 734   );
 735
 736   my $ratename = '';
 737   my $intrastate_ratenum = $part_pkg->option_cacheable('intrastate_ratenum');
 738
 739   if ( $use_lrn and $countrycode eq '1' ) {
 740
 741     # then ask about the number
 742     foreach my $field ('src', 'dst') {
 743
 744       $self->get_lrn($field);
 745       if ( $field eq $column ) {
 746         # then we are rating on this number
 747         $number = $self->get($field.'_lrn');
 748         $number =~ s/^1//;
 749         # is this ever meaningful? can the LRN be outside NANP space?
 750       }
 751
 752     } # foreach $field
 753
 754   }
 755
 756   warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG;
 757   my $pretty_dst = "+$countrycode $number";
 758   #asterisks here causes inserting the detail to barf, so:
 759   $pretty_dst =~ s/\*//g;
 760
 761   # should check $countrycode eq '1' here?
 762   if ( $intrastate_ratenum && !$self->is_tollfree ) {
 763     $ratename = 'Interstate'; #until proven otherwise
 764     # this is relatively easy only because:
 765     # -assume all numbers are valid NANP numbers NOT in a fully-qualified format
 766     # -disregard toll-free
 767     # -disregard private or unknown numbers
 768     # -there is exactly one record in rate_prefix for a given NPANXX
 769     # -default to interstate if we can't find one or both of the prefixes
 770     my $dst_col = $use_lrn ? 'dst_lrn' : 'dst';
 771     my $src_col = $use_lrn ? 'src_lrn' : 'src';
 772     my (undef, $dstprefix) = $self->parse_number(
 773       column => $dst_col,
 774       international_prefix => $part_pkg->option_cacheable('international_prefix'),
 775       domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
 776     );
 777     $dstprefix =~ /^(\d{6})/;
 778     $dstprefix = qsearchs('rate_prefix', {   'countrycode' => '1',
 779                                                 'npa' => $1,
 780                                          }) || '';
 781     my (undef, $srcprefix) = $self->parse_number(
 782       column => $src_col,
 783       international_prefix => $part_pkg->option_cacheable('international_prefix'),
 784       domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
 785     );
 786     $srcprefix =~ /^(\d{6})/;
 787     $srcprefix = qsearchs('rate_prefix', {   'countrycode' => '1',
 788                                              'npa' => $1,
 789                                          }) || '';
 790     if ($srcprefix && $dstprefix
 791         && $srcprefix->state && $dstprefix->state
 792         && $srcprefix->state eq $dstprefix->state) {
 793       $eff_ratenum = $intrastate_ratenum;
 794       $ratename = 'Intrastate'; # XXX possibly just use the ratename?
 795     }
 796   }
 797
 798   $eff_ratenum ||= $part_pkg->option_cacheable('ratenum');
 799   my $rate = qsearchs('rate', { 'ratenum' => $eff_ratenum })
 800     or die "ratenum $eff_ratenum not found!";
 801
 802   my @ltime = localtime($self->startdate);
 803   my $weektime = $ltime[0] +
 804                  $ltime[1]*60 +   #minutes
 805                  $ltime[2]*3600 + #hours
 806                  $ltime[6]*86400; #days since sunday
 807   # if there's no timed rate_detail for this time/region combination,
 808   # dest_detail returns the default.  There may still be a timed rate
 809   # that applies after the starttime of the call, so be careful...
 810   my $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
 811                                          'phonenum'    => $number,
 812                                          'weektime'    => $weektime,
 813                                          'cdrtypenum'  => $self->cdrtypenum,
 814                                       });
 815
 816   unless ( $rate_detail ) {
 817
 818     if ( $part_pkg->option_cacheable('ignore_unrateable') ) {
 819
 820       if ( $part_pkg->option_cacheable('ignore_unrateable') == 2 ) {
 821         # mark the CDR as unrateable
 822         return $self->set_status_and_rated_price(
 823           'failed',
 824           '',
 825           $opt{'svcnum'},
 826         );
 827       } elsif ( $part_pkg->option_cacheable('ignore_unrateable') == 1 ) {
 828         # warn and continue
 829         warn "no rate_detail found for CDR.acctid: ". $self->acctid.
 830              "; skipping\n";
 831         return '';
 832
 833       } else {
 834         die "unknown ignore_unrateable, pkgpart ". $part_pkg->pkgpart;
 835       }
 836
 837     } else {
 838
 839       die "FATAL: no rate_detail found in ".
 840           $rate->ratenum. ":". $rate->ratename. " rate plan ".
 841           "for +$countrycode $number (CDR acctid ". $self->acctid. "); ".
 842           "add a rate or set ignore_unrateable flag on the package def\n";
 843     }
 844
 845   }
 846
 847   my $regionnum = $rate_detail->dest_regionnum;
 848   my $rate_region = $rate_detail->dest_region;
 849   warn "  found rate for regionnum $regionnum ".
 850        "and rate detail $rate_detail\n"
 851     if $DEBUG;
 852
 853   if ( !exists($interval_cache{$regionnum}) ) {
 854     my @intervals = (
 855       sort { $a->stime <=> $b->stime }
 856         map { $_->rate_time->intervals }
 857           qsearch({ 'table'     => 'rate_detail',
 858                     'hashref'   => { 'ratenum' => $rate->ratenum },
 859                     'extra_sql' => 'AND ratetimenum IS NOT NULL',
 860                  })
 861     );
 862     $interval_cache{$regionnum} = \@intervals;
 863     warn "  cached ".scalar(@intervals)." interval(s)\n"
 864       if $DEBUG;
 865   }
 866
 867   ###
 868   # find the price and add detail to the invoice
 869   ###
 870
 871   # About this section:
 872   # We don't round _anything_ (except granularizing)
 873   # until the final $charge = sprintf("%.2f"...).
 874
 875   my $rated_seconds = $part_pkg->option_cacheable('use_duration')
 876                         ? $self->duration
 877                         : $self->billsec;
 878   my $seconds_left = $rated_seconds;
 879
 880   #no, do this later so it respects (group) included minutes
 881   #  # charge for the first (conn_sec) seconds
 882   #  my $seconds = min($seconds_left, $rate_detail->conn_sec);
 883   #  $seconds_left -= $seconds;
 884   #  $weektime     += $seconds;
 885   #  my $charge = $rate_detail->conn_charge;
 886   #my $seconds = 0;
 887   my $charge = 0;
 888   my $connection_charged = 0;
 889
 890   # before doing anything else, if there's an upstream multiplier and
 891   # an upstream price, add that to the charge. (usually the rate detail
 892   # will then have a minute charge of zero, but not necessarily.)
 893   $charge += ($self->upstream_price || 0) * $rate_detail->upstream_mult_charge;
 894
 895   my $etime;
 896   while($seconds_left) {
 897     my $ratetimenum = $rate_detail->ratetimenum; # may be empty
 898
 899     # find the end of the current rate interval
 900     if(@{ $interval_cache{$regionnum} } == 0) {
 901       # There are no timed rates in this group, so just stay
 902       # in the default rate_detail for the entire duration.
 903       # Set an "end" of 1 past the end of the current call.
 904       $etime = $weektime + $seconds_left + 1;
 905     }
 906     elsif($ratetimenum) {
 907       # This is a timed rate, so go to the etime of this interval.
 908       # If it's followed by another timed rate, the stime of that
 909       # interval should match the etime of this one.
 910       my $interval = $rate_detail->rate_time->contains($weektime);
 911       $etime = $interval->etime;
 912     }
 913     else {
 914       # This is a default rate, so use the stime of the next
 915       # interval in the sequence.
 916       my $next_int = first { $_->stime > $weektime }
 917                       @{ $interval_cache{$regionnum} };
 918       if ($next_int) {
 919         $etime = $next_int->stime;
 920       }
 921       else {
 922         # weektime is near the end of the week, so decrement
 923         # it by a full week and use the stime of the first
 924         # interval.
 925         $weektime -= (3600*24*7);
 926         $etime = $interval_cache{$regionnum}->[0]->stime;
 927       }
 928     }
 929
 930     my $charge_sec = min($seconds_left, $etime - $weektime);
 931
 932     $seconds_left -= $charge_sec;
 933
 934     my $granularity = $rate_detail->sec_granularity;
 935
 936     my $minutes;
 937     if ( $granularity ) { # charge per minute
 938       # Round up to the nearest $granularity
 939       if ( $charge_sec and $charge_sec % $granularity ) {
 940         $charge_sec += $granularity - ($charge_sec % $granularity);
 941       }
 942       $minutes = $charge_sec / 60; #don't round this
 943     }
 944     else { # per call
 945       $minutes = 1;
 946       $seconds_left = 0;
 947     }
 948
 949     #$seconds += $charge_sec;
 950
 951     if ( $rate_detail->min_included ) {
 952       # the old, kind of deprecated way to do this:
 953       #
 954       # The rate detail itself has included minutes.  We MUST have a place
 955       # to track them.
 956       my $included_min = $opt{'detail_included_min_hashref'}
 957         or return "unable to rate CDR: rate detail has included minutes, but ".
 958                   "no detail_included_min_hashref provided.\n";
 959
 960       # by default, set the included minutes for this region/time to
 961       # what's in the rate_detail
 962       if (!exists( $included_min->{$regionnum}{$ratetimenum} )) {
 963         $included_min->{$regionnum}{$ratetimenum} =
 964           ($rate_detail->min_included * $cust_pkg->quantity || 1);
 965       }
 966
 967       if ( $included_min->{$regionnum}{$ratetimenum} >= $minutes ) {
 968         $charge_sec = 0;
 969         $included_min->{$regionnum}{$ratetimenum} -= $minutes;
 970       } else {
 971         $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60);
 972         $included_min->{$regionnum}{$ratetimenum} = 0;
 973       }
 974     } elsif ( $opt{plan_included_min} && ${ $opt{plan_included_min} } > 0 ) {
 975       # The package definition has included minutes, but only for in-group
 976       # rate details.  Decrement them if this is an in-group call.
 977       if ( $rate_detail->region_group ) {
 978         if ( ${ $opt{'plan_included_min'} } >= $minutes ) {
 979           $charge_sec = 0;
 980           ${ $opt{'plan_included_min'} } -= $minutes;
 981         } else {
 982           $charge_sec -= (${ $opt{'plan_included_min'} } * 60);
 983           ${ $opt{'plan_included_min'} } = 0;
 984         }
 985       }
 986     } else {
 987       # the new way!
 988       my $applied_min = $cust_pkg->apply_usage(
 989         'cdr'         => $self,
 990         'rate_detail' => $rate_detail,
 991         'minutes'     => $minutes
 992       );
 993       # for now, usage pools deal only in whole minutes
 994       $charge_sec -= $applied_min * 60;
 995     }
 996
 997     if ( $charge_sec > 0 ) {
 998
 999       #NOW do connection charges here... right?
1000       #my $conn_seconds = min($seconds_left, $rate_detail->conn_sec);
1001       my $conn_seconds = 0;
1002       unless ( $connection_charged++ ) { #only one connection charge
1003         $conn_seconds = min($charge_sec, $rate_detail->conn_sec);
1004         $seconds_left -= $conn_seconds;
1005         $weektime     += $conn_seconds;
1006         $charge += $rate_detail->conn_charge;
1007       }
1008
1009                            #should preserve (display?) this
1010       if ( $granularity == 0 ) { # per call rate
1011         $charge += $rate_detail->min_charge;
1012       } else {
1013         my $charge_min = ( $charge_sec - $conn_seconds ) / 60;
1014         $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
1015       }
1016
1017     }
1018
1019     # choose next rate_detail
1020     $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
1021                                         'phonenum'    => $number,
1022                                         'weektime'    => $etime,
1023                                         'cdrtypenum'  => $self->cdrtypenum })
1024             if($seconds_left);
1025     # we have now moved forward to $etime
1026     $weektime = $etime;
1027
1028   } #while $seconds_left
1029
1030   # this is why we need regionnum/rate_region....
1031   warn "  (rate region $rate_region)\n" if $DEBUG;
1032
1033   # NOW round it.
1034   my $rounding = $part_pkg->option_cacheable('rounding') || 2;
1035   my $sprintformat = '%.'. $rounding. 'f';
1036   my $roundup = 10**(-3-$rounding);
1037   my $price = sprintf($sprintformat, $charge + $roundup);
1038
1039   $self->set_status_and_rated_price(
1040     'rated',
1041     $price,
1042     $opt{'svcnum'},
1043     'rated_pretty_dst'    => $pretty_dst,
1044     'rated_regionname'    => ($rate_region ? $rate_region->regionname : ''),
1045     'rated_seconds'       => $rated_seconds, #$seconds,
1046     'rated_granularity'   => $rate_detail->sec_granularity, #$granularity
1047     'rated_ratedetailnum' => $rate_detail->ratedetailnum,
1048     'rated_classnum'      => $rate_detail->classnum, #rated_ratedetailnum?
1049     'rated_ratename'      => $ratename, #not rate_detail - Intrastate/Interstate
1050   );
1051
1052 }
1053
1054 sub rate_upstream_simple {
1055   my( $self, %opt ) = @_;
1056
1057   $self->set_status_and_rated_price(
1058     'rated',
1059     sprintf('%.3f', $self->upstream_price),
1060     $opt{'svcnum'},
1061     'rated_classnum' => $self->calltypenum,
1062     'rated_seconds'  => $self->billsec,
1063     # others? upstream_*_regionname => rated_regionname is possible
1064   );
1065 }
1066
1067 sub rate_single_price {
1068   my( $self, %opt ) = @_;
1069   my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
1070
1071   # a little false laziness w/abov
1072   # $rate_detail = new FS::rate_detail({sec_granularity => ... }) ?
1073
1074   my $granularity = length($part_pkg->option_cacheable('sec_granularity'))
1075                       ? $part_pkg->option_cacheable('sec_granularity')
1076                       : 60;
1077
1078   my $seconds = $part_pkg->option_cacheable('use_duration')
1079                   ? $self->duration
1080                   : $self->billsec;
1081
1082   $seconds += $granularity - ( $seconds % $granularity )
1083     if $seconds      # don't granular-ize 0 billsec calls (bills them)
1084     && $granularity  # 0 is per call
1085     && $seconds % $granularity;
1086   my $minutes = $granularity ? ($seconds / 60) : 1;
1087
1088   my $charge_min = $minutes;
1089
1090   ${$opt{plan_included_min}} -= $minutes;
1091   if ( ${$opt{plan_included_min}} > 0 ) {
1092     $charge_min = 0;
1093   } else {
1094      $charge_min = 0 - ${$opt{plan_included_min}};
1095      ${$opt{plan_included_min}} = 0;
1096   }
1097
1098   my $charge =
1099     sprintf('%.4f', ( $part_pkg->option_cacheable('min_charge') * $charge_min )
1100                     + 0.0000000001 ); #so 1.00005 rounds to 1.0001
1101
1102   $self->set_status_and_rated_price(
1103     'rated',
1104     $charge,
1105     $opt{'svcnum'},
1106     'rated_granularity' => $granularity,
1107     'rated_seconds'     => $seconds,
1108   );
1109
1110 }
1111
1112 =item rate_cost
1113
1114 Rates an already-rated CDR according to the cost fields from the rate plan.
1115
1116 Returns the amount.
1117
1118 =cut
1119
1120 sub rate_cost {
1121   my $self = shift;
1122
1123   return 0 unless $self->rated_ratedetailnum;
1124
1125   my $rate_detail =
1126     qsearchs('rate_detail', { 'ratedetailnum' => $self->rated_ratedetailnum } );
1127
1128   my $charge = 0;
1129   $charge += ($self->upstream_price || 0) * ($rate_detail->upstream_mult_cost);
1130
1131   if ( $self->rated_granularity == 0 ) {
1132     $charge += $rate_detail->min_cost;
1133   } else {
1134     my $minutes = $self->rated_seconds / 60;
1135     $charge += $rate_detail->conn_cost + $minutes * $rate_detail->min_cost;
1136   }
1137
1138   sprintf('%.2f', $charge + .00001 );
1139
1140 }
1141
1142 =item cdr_termination [ TERMPART ]
1143
1144 =cut
1145
1146 sub cdr_termination {
1147   my $self = shift;
1148
1149   if ( scalar(@_) && $_[0] ) {
1150     my $termpart = shift;
1151
1152     qsearchs('cdr_termination', { acctid   => $self->acctid,
1153                                   termpart => $termpart,
1154                                 }
1155             );
1156
1157   } else {
1158
1159     qsearch('cdr_termination', { acctid => $self->acctid, } );
1160
1161   }
1162
1163 }
1164
1165 =item calldate_unix
1166
1167 Parses the calldate in SQL string format and returns a UNIX timestamp.
1168
1169 =cut
1170
1171 sub calldate_unix {
1172   str2time(shift->calldate);
1173 }
1174
1175 =item startdate_sql
1176
1177 Parses the startdate in UNIX timestamp format and returns a string in SQL
1178 format.
1179
1180 =cut
1181
1182 sub startdate_sql {
1183   my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
1184   $mon++;
1185   $year += 1900;
1186   "$year-$mon-$mday $hour:$min:$sec";
1187 }
1188
1189 =item cdr_carrier
1190
1191 Returns the FS::cdr_carrier object associated with this CDR, or false if no
1192 carrierid is defined.
1193
1194 =cut
1195
1196 my %carrier_cache = ();
1197
1198 sub cdr_carrier {
1199   my $self = shift;
1200   return '' unless $self->carrierid;
1201   $carrier_cache{$self->carrierid} ||=
1202     qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
1203 }
1204
1205 =item carriername
1206
1207 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
1208 no FS::cdr_carrier object is assocated with this CDR.
1209
1210 =cut
1211
1212 sub carriername {
1213   my $self = shift;
1214   my $cdr_carrier = $self->cdr_carrier;
1215   $cdr_carrier ? $cdr_carrier->carriername : '';
1216 }
1217
1218 =item cdr_calltype
1219
1220 Returns the FS::cdr_calltype object associated with this CDR, or false if no
1221 calltypenum is defined.
1222
1223 =cut
1224
1225 my %calltype_cache = ();
1226
1227 sub cdr_calltype {
1228   my $self = shift;
1229   return '' unless $self->calltypenum;
1230   $calltype_cache{$self->calltypenum} ||=
1231     qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
1232 }
1233
1234 =item calltypename
1235
1236 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
1237 no FS::cdr_calltype object is assocated with this CDR.
1238
1239 =cut
1240
1241 sub calltypename {
1242   my $self = shift;
1243   my $cdr_calltype = $self->cdr_calltype;
1244   $cdr_calltype ? $cdr_calltype->calltypename : '';
1245 }
1246
1247 =item downstream_csv [ OPTION => VALUE, ... ]
1248
1249 =cut
1250
1251 # in the future, load this dynamically from detail_format classes
1252
1253 my %export_names = (
1254   'simple'  => {
1255     'name'           => 'Simple',
1256     'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
1257   },
1258   'simple2' => {
1259     'name'           => 'Simple with source',
1260     'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
1261                        #"Date,Time,Name,Called From,Destination,Duration,Price",
1262   },
1263   'accountcode_simple' => {
1264     'name'           => 'Simple with accountcode',
1265     'invoice_header' => "Date,Time,Called From,Account,Duration,Price",
1266   },
1267   'basic' => {
1268     'name'           => 'Basic',
1269     'invoice_header' => "Date/Time,Called Number,Min/Sec,Price",
1270   },
1271   'basic_upstream_dst_regionname' => {
1272     'name'           => 'Basic with upstream destination name',
1273     'invoice_header' => "Date/Time,Called Number,Destination,Min/Sec,Price",
1274   },
1275   'default' => {
1276     'name'           => 'Default',
1277     'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
1278   },
1279   'source_default' => {
1280     'name'           => 'Default with source',
1281     'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1282   },
1283   'accountcode_default' => {
1284     'name'           => 'Default plus accountcode',
1285     'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
1286   },
1287   'description_default' => {
1288     'name'           => 'Default with description field as destination',
1289     'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1290   },
1291   'sum_duration' => {
1292     'name'           => 'Summary, one line per service',
1293     'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1294   },
1295   'sum_count' => {
1296     'name'           => 'Number of calls, one line per service',
1297     'invoice_header' => 'Caller,Rate,Messages,Price',
1298   },
1299   'sum_duration' => {
1300     'name'           => 'Summary, one line per service',
1301     'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1302   },
1303   'sum_duration_prefix' => {
1304     'name'           => 'Summary, one line per destination prefix',
1305     'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1306   },
1307   'sum_count_class' => {
1308     'name'           => 'Summary, one line per usage class',
1309     'invoice_header' => 'Caller,Class,Calls,Price',
1310   },
1311   'sum_duration_accountcode' => {
1312     'name'           => 'Summary, one line per accountcode',
1313     'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1314   },
1315 );
1316
1317 my %export_formats = ();
1318 sub export_formats {
1319   #my $self = shift;
1320
1321   return %export_formats if keys %export_formats;
1322
1323   my $conf = new FS::Conf;
1324   my $date_format = $conf->config('date_format') || '%m/%d/%Y';
1325
1326   # call duration in the largest units that accurately reflect the granularity
1327   my $duration_sub = sub {
1328     my($cdr, %opt) = @_;
1329     my $sec = $opt{seconds} || $cdr->billsec;
1330     if ( defined $opt{granularity} &&
1331          $opt{granularity} == 0 ) { #per call
1332       return '1 call';
1333     }
1334     elsif ( defined $opt{granularity} && $opt{granularity} == 60 ) {#full minutes
1335       my $min = int($sec/60);
1336       $min++ if $sec%60;
1337       return $min.'m';
1338     }
1339     else { #anything else
1340       return sprintf("%dm %ds", $sec/60, $sec%60);
1341     }
1342   };
1343
1344   my $price_sub = sub {
1345     my ($cdr, %opt) = @_;
1346     my $price;
1347     if ( defined($opt{charge}) ) {
1348       $price = $opt{charge};
1349     }
1350     elsif ( $opt{inbound} ) {
1351       my $term = $cdr->cdr_termination(1); # 1 = inbound
1352       $price = $term->rated_price if defined $term;
1353     }
1354     else {
1355       $price = $cdr->rated_price;
1356     }
1357     length($price) ? ($opt{money_char} . $price) : '';
1358   };
1359
1360   my $src_sub = sub { $_[0]->clid || $_[0]->src };
1361
1362   %export_formats = (
1363     'simple' => [
1364       sub { time2str($date_format, shift->calldate_unix ) },   #DATE
1365       sub { time2str('%r', shift->calldate_unix ) },   #TIME
1366       'userfield',                                     #USER
1367       'dst',                                           #NUMBER_DIALED
1368       $duration_sub,                                   #DURATION
1369       #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1370       $price_sub,
1371     ],
1372     'simple2' => [
1373       sub { time2str($date_format, shift->calldate_unix ) },   #DATE
1374       sub { time2str('%r', shift->calldate_unix ) },   #TIME
1375       #'userfield',                                     #USER
1376       $src_sub,                                           #called from
1377       'dst',                                           #NUMBER_DIALED
1378       $duration_sub,                                   #DURATION
1379       #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1380       $price_sub,
1381     ],
1382     'accountcode_simple' => [
1383       sub { time2str($date_format, shift->calldate_unix ) },   #DATE
1384       sub { time2str('%r', shift->calldate_unix ) },   #TIME
1385       $src_sub,                                           #called from
1386       'accountcode',                                   #NUMBER_DIALED
1387       $duration_sub,                                   #DURATION
1388       $price_sub,
1389     ],
1390     'sum_duration' => [
1391       # for summary formats, the CDR is a fictitious object containing the
1392       # total billsec and the phone number of the service
1393       $src_sub,
1394       sub { my($cdr, %opt) = @_; $opt{ratename} },
1395       sub { my($cdr, %opt) = @_; $opt{count} },
1396       sub { my($cdr, %opt) = @_; int($opt{seconds}/60).'m' },
1397       $price_sub,
1398     ],
1399     'sum_count' => [
1400       $src_sub,
1401       sub { my($cdr, %opt) = @_; $opt{ratename} },
1402       sub { my($cdr, %opt) = @_; $opt{count} },
1403       $price_sub,
1404     ],
1405     'basic' => [
1406       sub { time2str('%d %b - %I:%M %p', shift->calldate_unix) },
1407       'dst',
1408       $duration_sub,
1409       $price_sub,
1410     ],
1411     'default' => [
1412
1413       #DATE
1414       sub { time2str($date_format, shift->calldate_unix ) },
1415             # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
1416
1417       #TIME
1418       sub { time2str('%r', shift->calldate_unix ) },
1419             # time2str("%c", $cdr->calldate_unix),  #XXX this should probably be a config option dropdown so they can select US vs- rest of world dates or whatnot
1420
1421       #DEST ("Number")
1422       sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
1423
1424       #REGIONNAME ("Destination")
1425       sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
1426
1427       #DURATION
1428       $duration_sub,
1429
1430       #PRICE
1431       $price_sub,
1432     ],
1433   );
1434   $export_formats{'source_default'} = [ $src_sub, @{ $export_formats{'default'} }, ];
1435   $export_formats{'accountcode_default'} =
1436     [ @{ $export_formats{'default'} }[0,1],
1437       'accountcode',
1438       @{ $export_formats{'default'} }[2..5],
1439     ];
1440   my @default = @{ $export_formats{'default'} };
1441   $export_formats{'description_default'} =
1442     [ $src_sub, @default[0..2],
1443       sub { my($cdr, %opt) = @_; $cdr->description },
1444       @default[4,5] ];
1445
1446   return %export_formats;
1447 }
1448
1449 =item downstream_csv OPTION => VALUE ...
1450
1451 Returns a string of formatted call details for display on an invoice.
1452
1453 Options:
1454
1455 format
1456
1457 charge - override the 'rated_price' field of the CDR
1458
1459 seconds - override the 'billsec' field of the CDR
1460
1461 count - number of usage events included in this record, for summary formats
1462
1463 ratename - name of the rate table used to rate this call
1464
1465 granularity
1466
1467 =cut
1468
1469 sub downstream_csv {
1470   my( $self, %opt ) = @_;
1471
1472   my $format = $opt{'format'};
1473   my %formats = $self->export_formats;
1474   return "Unknown format $format" unless exists $formats{$format};
1475
1476   #my $conf = new FS::Conf;
1477   #$opt{'money_char'} ||= $conf->config('money_char') || '$';
1478   $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
1479
1480   my $csv = new Text::CSV_XS;
1481
1482   my @columns =
1483     map {
1484           ref($_) ? &{$_}($self, %opt) : $self->$_();
1485         }
1486     @{ $formats{$format} };
1487
1488   return @columns if defined $opt{'keeparray'};
1489
1490   my $status = $csv->combine(@columns);
1491   die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
1492     unless $status;
1493
1494   $csv->string;
1495
1496 }
1497
1498 sub get_lrn {
1499   my $self = shift;
1500   my $field = shift;
1501
1502   my $ua = LWP::UserAgent->new(
1503              'ssl_opts' => {
1504                verify_hostname => 0,
1505                SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
1506              },
1507            );
1508
1509   my $url = 'https://ws.freeside.biz/get_lrn';
1510
1511   my %content = ( 'support-key' => $support_key,
1512                   'tn' => $self->get($field),
1513                 );
1514   my $response = $ua->request( POST $url, \%content );
1515
1516   die "LRN service error: ". $response->message. "\n"
1517     unless $response->is_success;
1518
1519   local $@;
1520   my $data = eval { decode_json($response->content) };
1521   die "LRN service JSON error : $@\n" if $@;
1522
1523   if ($data->{error}) {
1524     die "acctid ".$self->acctid." $field LRN lookup failed:\n$data->{error}";
1525     # for testing; later we should respect ignore_unrateable
1526   } elsif ($data->{lrn}) {
1527     # normal case
1528     $self->set($field.'_lrn', $data->{lrn});
1529   } else {
1530     die "acctid ".$self->acctid." $field LRN lookup returned no number.\n";
1531   }
1532
1533   return $data; # in case it's interesting somehow
1534 }
1535
1536 =back
1537
1538 =head1 CLASS METHODS
1539
1540 =over 4
1541
1542 =item invoice_formats
1543
1544 Returns an ordered list of key value pairs containing invoice format names
1545 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
1546
1547 =cut
1548
1549 # in the future, load this dynamically from detail_format classes
1550
1551 sub invoice_formats {
1552   map { ($_ => $export_names{$_}->{'name'}) }
1553     grep { $export_names{$_}->{'invoice_header'} }
1554     sort keys %export_names;
1555 }
1556
1557 =item invoice_header FORMAT
1558
1559 Returns a scalar containing the CSV column header for invoice format FORMAT.
1560
1561 =cut
1562
1563 sub invoice_header {
1564   my $format = shift;
1565   $export_names{$format}->{'invoice_header'};
1566 }
1567
1568 =item clear_status
1569
1570 Clears cdr and any associated cdr_termination statuses - used for
1571 CDR reprocessing.
1572
1573 =cut
1574
1575 sub clear_status {
1576   my $self = shift;
1577   my %opt = @_;
1578
1579   local $SIG{HUP} = 'IGNORE';
1580   local $SIG{INT} = 'IGNORE';
1581   local $SIG{QUIT} = 'IGNORE';
1582   local $SIG{TERM} = 'IGNORE';
1583   local $SIG{TSTP} = 'IGNORE';
1584   local $SIG{PIPE} = 'IGNORE';
1585
1586   my $oldAutoCommit = $FS::UID::AutoCommit;
1587   local $FS::UID::AutoCommit = 0;
1588   my $dbh = dbh;
1589
1590   if ( $cdr_prerate && $cdr_prerate_cdrtypenums{$self->cdrtypenum}
1591        && $self->rated_ratedetailnum #avoid putting old CDRs back in "rated"
1592        && $self->freesidestatus eq 'done'
1593        && ! $opt{'rerate'}
1594      )
1595   { #special case
1596     $self->freesidestatus('rated');
1597   } else {
1598     $self->freesidestatus('');
1599   }
1600
1601   my $error = $self->replace;
1602   if ( $error ) {
1603     $dbh->rollback if $oldAutoCommit;
1604     return $error;
1605   }
1606
1607   foreach my $cdr_termination ( $self->cdr_termination ) {
1608       #$cdr_termination->status('');
1609       #$error = $cdr_termination->replace;
1610       $error = $cdr_termination->delete;
1611       if ( $error ) {
1612         $dbh->rollback if $oldAutoCommit;
1613         return $error;
1614       }
1615   }
1616
1617   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1618
1619   '';
1620 }
1621
1622 =item import_formats
1623
1624 Returns an ordered list of key value pairs containing import format names
1625 as keys (for use with batch_import) and "pretty" format names as values.
1626
1627 =cut
1628
1629 #false laziness w/part_pkg & part_export
1630
1631 my %cdr_info;
1632 foreach my $INC ( @INC ) {
1633   warn "globbing $INC/FS/cdr/[a-z]*.pm\n" if $DEBUG;
1634   foreach my $file ( glob("$INC/FS/cdr/[a-z]*.pm") ) {
1635     warn "attempting to load CDR format info from $file\n" if $DEBUG;
1636     $file =~ /\/(\w+)\.pm$/ or do {
1637       warn "unrecognized file in $INC/FS/cdr/: $file\n";
1638       next;
1639     };
1640     my $mod = $1;
1641     my $info = eval "use FS::cdr::$mod; ".
1642                     "\\%FS::cdr::$mod\::info;";
1643     if ( $@ ) {
1644       die "error using FS::cdr::$mod (skipping): $@\n" if $@;
1645       next;
1646     }
1647     unless ( keys %$info ) {
1648       warn "no %info hash found in FS::cdr::$mod, skipping\n";
1649       next;
1650     }
1651     warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
1652     if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1653       warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
1654       next;
1655     }
1656     $cdr_info{$mod} = $info;
1657   }
1658 }
1659
1660 tie my %import_formats, 'Tie::IxHash',
1661   map  { $_ => $cdr_info{$_}->{'name'} }
1662   sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
1663   grep { exists($cdr_info{$_}->{'import_fields'}) }
1664   keys %cdr_info;
1665
1666 sub import_formats {
1667   %import_formats;
1668 }
1669
1670 sub _cdr_min_parser_maker {
1671   my $field = shift;
1672   my @fields = ref($field) ? @$field : ($field);
1673   @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
1674   return sub {
1675     my( $cdr, $min ) = @_;
1676     my $sec = eval { _cdr_min_parse($min) };
1677     die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
1678     $cdr->$_($sec) foreach @fields;
1679   };
1680 }
1681
1682 sub _cdr_min_parse {
1683   my $min = shift;
1684   sprintf('%.0f', $min * 60 );
1685 }
1686
1687 sub _cdr_date_parser_maker {
1688   my $field = shift;
1689   my %options = @_;
1690   my @fields = ref($field) ? @$field : ($field);
1691   return sub {
1692     my( $cdr, $datestring ) = @_;
1693     my $unixdate = eval { _cdr_date_parse($datestring, %options) };
1694     die "error parsing date for @fields from $datestring: $@\n" if $@;
1695     $cdr->$_($unixdate) foreach @fields;
1696   };
1697 }
1698
1699 sub _cdr_date_parse {
1700   my $date = shift;
1701   my %options = @_;
1702
1703   return '' unless length($date); #that's okay, it becomes NULL
1704   return '' if $date eq 'NA'; #sansay
1705
1706   if ( $date =~ /^([a-z]{3})\s+([a-z]{3})\s+(\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s+(\d{4})$/i && $7 > 1970 ) {
1707     my $time = str2time($date);
1708     return $time if $time > 100000; #just in case
1709   }
1710
1711   my($year, $mon, $day, $hour, $min, $sec);
1712
1713   #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
1714   #taqua  #2007-10-31 08:57:24.113000000
1715
1716   if ( $date =~ /^\s*(\d{4})\D(\d{1,2})\D(\d{1,2})\D+(\d{1,2})\D(\d{1,2})\D(\d{1,2})(\D|$)/ ) {
1717     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1718   } elsif ( $date  =~ /^\s*(\d{1,2})\D(\d{1,2})\D(\d{4})\s+(\d{1,2})\D(\d{1,2})(?:\D(\d{1,2}))?(\D|$)/ ) {
1719     # 8/26/2010 12:20:01
1720     # optionally without seconds
1721     ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1722     $sec = 0 if !defined($sec);
1723    } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\.\d+)$/ ) {
1724     # broadsoft: 20081223201938.314
1725     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1726   } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\d+(\D|$)/ ) {
1727     # Taqua OM:  20050422203450943
1728     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1729   } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) {
1730     # WIP: 20100329121420
1731     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1732   } elsif ( $date =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z$/) {
1733     # Telos 2014-10-10T05:30:33Z
1734     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1735     $options{gmt} = 1;
1736   } else {
1737      die "unparsable date: $date"; #maybe we shouldn't die...
1738   }
1739
1740   return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
1741             && $hour == 0 && $min == 0 && $sec == 0;
1742
1743   if ($options{gmt}) {
1744     timegm($sec, $min, $hour, $day, $mon-1, $year);
1745   } else {
1746     timelocal($sec, $min, $hour, $day, $mon-1, $year);
1747   }
1748 }
1749
1750 =item batch_import HASHREF
1751
1752 Imports CDR records.  Available options are:
1753
1754 =over 4
1755
1756 =item file
1757
1758 Filename
1759
1760 =item format
1761
1762 =item params
1763
1764 Hash reference of preset fields, typically cdrbatch
1765
1766 =item empty_ok
1767
1768 Set true to prevent throwing an error on empty imports
1769
1770 =back
1771
1772 =cut
1773
1774 my %import_options = (
1775   'table'         => 'cdr',
1776
1777   'batch_keycol'  => 'cdrbatchnum',
1778   'batch_table'   => 'cdr_batch',
1779   'batch_namecol' => 'cdrbatch',
1780
1781   'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
1782                      keys %cdr_info
1783                },
1784
1785                           #drop the || 'csv' to allow auto xls for csv types?
1786   'format_types' => { map { $_ => lc($cdr_info{$_}->{'type'} || 'csv'); }
1787                           keys %cdr_info
1788                     },
1789
1790   'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
1791                             keys %cdr_info
1792                       },
1793
1794   'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
1795                               keys %cdr_info
1796                         },
1797
1798   'format_fixedlength_formats' =>
1799     { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
1800           keys %cdr_info
1801     },
1802
1803   'format_xml_formats' =>
1804     { map { $_ => $cdr_info{$_}->{'xml_format'}; }
1805           keys %cdr_info
1806     },
1807
1808   'format_asn_formats' =>
1809     { map { $_ => $cdr_info{$_}->{'asn_format'}; }
1810           keys %cdr_info
1811     },
1812
1813   'format_row_callbacks' =>
1814     { map { $_ => $cdr_info{$_}->{'row_callback'}; }
1815           keys %cdr_info
1816     },
1817
1818   'format_parser_opts' =>
1819     { map { $_ => $cdr_info{$_}->{'parser_opt'}; }
1820           keys %cdr_info
1821     },
1822 );
1823
1824 sub _import_options {
1825   \%import_options;
1826 }
1827
1828 sub batch_import {
1829   my $opt = shift;
1830
1831   my $iopt = _import_options;
1832   $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
1833
1834   if ( defined $opt->{'cdrtypenum'} ) {
1835         $opt->{'preinsert_callback'} = sub {
1836                 my($record,$param) = (shift,shift);
1837                 $record->cdrtypenum($opt->{'cdrtypenum'});
1838                 '';
1839         };
1840   }
1841
1842   FS::Record::batch_import( $opt );
1843
1844 }
1845
1846 =item process_batch_import
1847
1848 =cut
1849
1850 sub process_batch_import {
1851   my $job = shift;
1852
1853   my $opt = _import_options;
1854 #  $opt->{'params'} = [ 'format', 'cdrbatch' ];
1855
1856   FS::Record::process_batch_import( $job, $opt, @_ );
1857
1858 }
1859 #  if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
1860 #    @columns = map { s/^ +//; $_; } @columns;
1861 #  }
1862
1863 # _ upgrade_data
1864 #
1865 # Used by FS::Upgrade to migrate to a new database.
1866
1867 sub _upgrade_data {
1868   my ($class, %opts) = @_;
1869
1870   warn "$me upgrading $class\n" if $DEBUG;
1871
1872   my $sth = dbh->prepare(
1873     'SELECT DISTINCT(cdrbatch) FROM cdr WHERE cdrbatch IS NOT NULL'
1874   ) or die dbh->errstr;
1875
1876   $sth->execute or die $sth->errstr;
1877
1878   my %cdrbatchnum = ();
1879   while (my $row = $sth->fetchrow_arrayref) {
1880
1881     my $cdr_batch = qsearchs( 'cdr_batch', { 'cdrbatch' => $row->[0] } );
1882     unless ( $cdr_batch ) {
1883       $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] };
1884       my $error = $cdr_batch->insert;
1885       die $error if $error;
1886     }
1887
1888     $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum;
1889   }
1890
1891   $sth = dbh->prepare('UPDATE cdr SET cdrbatch = NULL, cdrbatchnum = ? WHERE cdrbatch IS NOT NULL AND cdrbatch = ?') or die dbh->errstr;
1892
1893   foreach my $cdrbatch (keys %cdrbatchnum) {
1894     $sth->execute($cdrbatchnum{$cdrbatch}, $cdrbatch) or die $sth->errstr;
1895   }
1896
1897 }
1898
1899 =item ip_addr_sql FIELD RANGE
1900
1901 Returns an SQL condition to search for CDRs with an IP address
1902 within RANGE.  FIELD is either 'src_ip_addr' or 'dst_ip_addr'.  RANGE
1903 should be in the form "a.b.c.d-e.f.g.h' (dotted quads), where any of
1904 the leftmost octets of the second address can be omitted if they're
1905 the same as the first address.
1906
1907 =cut
1908
1909 sub ip_addr_sql {
1910   my $class = shift;
1911   my ($field, $range) = @_;
1912   $range =~ /^[\d\.-]+$/ or die "bad ip address range '$range'";
1913   my @r = split('-', $range);
1914   my @saddr = split('\.', $r[0] || '');
1915   my @eaddr = split('\.', $r[1] || '');
1916   unshift @eaddr, (undef) x (4 - scalar @eaddr);
1917   for(0..3) {
1918     $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
1919   }
1920   "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
1921   "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
1922 }
1923
1924 =back
1925
1926 =head1 BUGS
1927
1928 =head1 SEE ALSO
1929
1930 L<FS::Record>, schema.html from the base documentation.
1931
1932 =cut
1933
1934 1;
1935