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