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