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, single_price_included_minutes, region_group, region_group_included_minutes.
 581
 582 part_pkg is required.
 583
 584 If svcnum is specified, will also associate this CDR with the specified svcnum.
 585
 586 single_price_included_minutes is requried for single_price price plans
 587 (otherwise unused/ignored).  It should be set to a scalar reference of the
 588 number of included minutes and will be decremented by the rated minutes of this
 589 CDR.
 590
 591 region_group_included_minutes is required for prefix price plans which have
 592 included minutes (otherwise unused/ignored).  It should be set to a scalar
 593 reference of the number of included minutes and will be decremented by the
 594 rated minutes of this CDR.
 595
 596 region_group_included_minutes_hashref is required for prefix price plans which
 597 have included minues (otherwise unused/ignored).  It should be set to an empty
 598 hashref at the start of a month's rating and then preserved across CDRs.
 599
 600 =cut
 601
 602 sub rate {
 603   my( $self, %opt ) = @_;
 604   my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
 605
 606   if ( $DEBUG > 1 ) {
 607     warn "rating CDR $self\n".
 608          join('', map { "  $_ => ". $self->{$_}. "\n" } keys %$self );
 609   }
 610
 611   my $rating_method = $part_pkg->option_cacheable('rating_method') || 'prefix';
 612   my $method = "rate_$rating_method";
 613   $self->$method(%opt);
 614 }
 615
 616 #here?
 617 our %interval_cache = (); # for timed rates
 618
 619 sub rate_prefix {
 620   my( $self, %opt ) = @_;
 621   my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
 622   my $cust_pkg = $opt{'cust_pkg'};
 623
 624   my $da_rewrote = 0;
 625   # this will result in those CDRs being marked as done... is that
 626   # what we want?
 627   my @dirass = ();
 628   if ( $part_pkg->option_cacheable('411_rewrite') ) {
 629     my $dirass = $part_pkg->option_cacheable('411_rewrite');
 630     $dirass =~ s/\s//g;
 631     @dirass = split(',', $dirass);
 632   }
 633
 634   if ( length($self->dst) && grep { $self->dst eq $_ } @dirass ) {
 635     $self->dst('411');
 636     $da_rewrote = 1;
 637   }
 638
 639   my $reason = $part_pkg->check_chargable( $self,
 640                                            'da_rewrote'   => $da_rewrote,
 641                                          );
 642   if ( $reason ) {
 643     warn "not charging for CDR ($reason)\n" if $DEBUG;
 644     return $self->set_status_and_rated_price( 'skipped',
 645                                               0,
 646                                               $opt{'svcnum'},
 647                                             );
 648   }
 649
 650   if ( $part_pkg->option_cacheable('skip_same_customer')
 651       and ! $self->is_tollfree ) {
 652     my ($dst_countrycode, $dst_number) = $self->parse_number(
 653       column => 'dst',
 654       international_prefix => $part_pkg->option_cacheable('international_prefix'),
 655       domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
 656     );
 657     my $dst_same_cust = FS::Record->scalar_sql(
 658         'SELECT COUNT(svc_phone.svcnum) AS count '.
 659         'FROM cust_pkg ' .
 660         'JOIN cust_svc   USING (pkgnum) ' .
 661         'JOIN svc_phone  USING (svcnum) ' .
 662         'WHERE svc_phone.countrycode = ' . dbh->quote($dst_countrycode) .
 663         ' AND svc_phone.phonenum = ' . dbh->quote($dst_number) .
 664         ' AND cust_pkg.custnum = ' . $cust_pkg->custnum,
 665     );
 666     if ( $dst_same_cust > 0 ) {
 667       warn "not charging for CDR (same source and destination customer)\n" if $DEBUG;
 668       return $self->set_status_and_rated_price( 'skipped',
 669                                                 0,
 670                                                 $opt{'svcnum'},
 671                                               );
 672     }
 673   }
 674
 675
 676
 677
 678   ###
 679   # look up rate details based on called station id
 680   # (or calling station id for toll free calls)
 681   ###
 682
 683   my $eff_ratenum = $self->is_tollfree('accountcode')
 684     ? $part_pkg->option_cacheable('accountcode_tollfree_ratenum')
 685     : '';
 686
 687   my( $to_or_from, $column );
 688   if(
 689         ( $self->is_tollfree
 690            && ! $part_pkg->option_cacheable('disable_tollfree')
 691         )
 692      or ( $eff_ratenum
 693            && $part_pkg->option_cacheable('accountcode_tollfree_field') eq 'src'
 694         )
 695     )
 696   { #tollfree call
 697     $to_or_from = 'from';
 698     $column = 'src';
 699   } else { #regular call
 700     $to_or_from = 'to';
 701     $column = 'dst';
 702   }
 703
 704   #determine the country code
 705   my ($countrycode, $number) = $self->parse_number(
 706     column => $column,
 707     international_prefix => $part_pkg->option_cacheable('international_prefix'),
 708     domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
 709   );
 710
 711   warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG;
 712   my $pretty_dst = "+$countrycode $number";
 713   #asterisks here causes inserting the detail to barf, so:
 714   $pretty_dst =~ s/\*//g;
 715
 716   my $ratename = '';
 717   my $intrastate_ratenum = $part_pkg->option_cacheable('intrastate_ratenum');
 718   if ( $intrastate_ratenum && !$self->is_tollfree ) {
 719     $ratename = 'Interstate'; #until proven otherwise
 720     # this is relatively easy only because:
 721     # -assume all numbers are valid NANP numbers NOT in a fully-qualified format
 722     # -disregard toll-free
 723     # -disregard private or unknown numbers
 724     # -there is exactly one record in rate_prefix for a given NPANXX
 725     # -default to interstate if we can't find one or both of the prefixes
 726     my (undef, $dstprefix) = $self->parse_number(
 727       column => 'dst',
 728       international_prefix => $part_pkg->option_cacheable('international_prefix'),
 729       domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
 730     );
 731     $dstprefix =~ /^(\d{6})/;
 732     $dstprefix = qsearchs('rate_prefix', {   'countrycode' => '1',
 733                                                 'npa' => $1,
 734                                          }) || '';
 735     my (undef, $srcprefix) = $self->parse_number(
 736       column => 'src',
 737       international_prefix => $part_pkg->option_cacheable('international_prefix'),
 738       domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
 739     );
 740     $srcprefix =~ /^(\d{6})/;
 741     $srcprefix = qsearchs('rate_prefix', {   'countrycode' => '1',
 742                                              'npa' => $1,
 743                                          }) || '';
 744     if ($srcprefix && $dstprefix
 745         && $srcprefix->state && $dstprefix->state
 746         && $srcprefix->state eq $dstprefix->state) {
 747       $eff_ratenum = $intrastate_ratenum;
 748       $ratename = 'Intrastate'; # XXX possibly just use the ratename?
 749     }
 750   }
 751
 752   $eff_ratenum ||= $part_pkg->option_cacheable('ratenum');
 753   my $rate = qsearchs('rate', { 'ratenum' => $eff_ratenum })
 754     or die "ratenum $eff_ratenum not found!";
 755
 756   my @ltime = localtime($self->startdate);
 757   my $weektime = $ltime[0] +
 758                  $ltime[1]*60 +   #minutes
 759                  $ltime[2]*3600 + #hours
 760                  $ltime[6]*86400; #days since sunday
 761   # if there's no timed rate_detail for this time/region combination,
 762   # dest_detail returns the default.  There may still be a timed rate
 763   # that applies after the starttime of the call, so be careful...
 764   my $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
 765                                          'phonenum'    => $number,
 766                                          'weektime'    => $weektime,
 767                                          'cdrtypenum'  => $self->cdrtypenum,
 768                                       });
 769
 770   unless ( $rate_detail ) {
 771
 772     if ( $part_pkg->option_cacheable('ignore_unrateable') ) {
 773
 774       if ( $part_pkg->option_cacheable('ignore_unrateable') == 2 ) {
 775         # mark the CDR as unrateable
 776         return $self->set_status_and_rated_price(
 777           'failed',
 778           '',
 779           $opt{'svcnum'},
 780         );
 781       } elsif ( $part_pkg->option_cacheable('ignore_unrateable') == 1 ) {
 782         # warn and continue
 783         warn "no rate_detail found for CDR.acctid: ". $self->acctid.
 784              "; skipping\n";
 785         return '';
 786
 787       } else {
 788         die "unknown ignore_unrateable, pkgpart ". $part_pkg->pkgpart;
 789       }
 790
 791     } else {
 792
 793       die "FATAL: no rate_detail found in ".
 794           $rate->ratenum. ":". $rate->ratename. " rate plan ".
 795           "for +$countrycode $number (CDR acctid ". $self->acctid. "); ".
 796           "add a rate or set ignore_unrateable flag on the package def\n";
 797     }
 798
 799   }
 800
 801   my $rate_region = $rate_detail->dest_region;
 802   my $regionnum = $rate_region->regionnum;
 803   warn "  found rate for regionnum $regionnum ".
 804        "and rate detail $rate_detail\n"
 805     if $DEBUG;
 806
 807   if ( !exists($interval_cache{$regionnum}) ) {
 808     my @intervals = (
 809       sort { $a->stime <=> $b->stime }
 810         map { $_->rate_time->intervals }
 811           qsearch({ 'table'     => 'rate_detail',
 812                     'hashref'   => { 'ratenum' => $rate->ratenum },
 813                     'extra_sql' => 'AND ratetimenum IS NOT NULL',
 814                  })
 815     );
 816     $interval_cache{$regionnum} = \@intervals;
 817     warn "  cached ".scalar(@intervals)." interval(s)\n"
 818       if $DEBUG;
 819   }
 820
 821   ###
 822   # find the price and add detail to the invoice
 823   ###
 824
 825   # About this section:
 826   # We don't round _anything_ (except granularizing)
 827   # until the final $charge = sprintf("%.2f"...).
 828
 829   my $seconds_left = $part_pkg->option_cacheable('use_duration')
 830                        ? $self->duration
 831                        : $self->billsec;
 832
 833   #no, do this later so it respects (group) included minutes
 834   #  # charge for the first (conn_sec) seconds
 835   #  my $seconds = min($seconds_left, $rate_detail->conn_sec);
 836   #  $seconds_left -= $seconds;
 837   #  $weektime     += $seconds;
 838   #  my $charge = $rate_detail->conn_charge;
 839   my $seconds = 0;
 840   my $charge = 0;
 841   my $connection_charged = 0;
 842
 843   my $etime;
 844   while($seconds_left) {
 845     my $ratetimenum = $rate_detail->ratetimenum; # may be empty
 846
 847     # find the end of the current rate interval
 848     if(@{ $interval_cache{$regionnum} } == 0) {
 849       # There are no timed rates in this group, so just stay
 850       # in the default rate_detail for the entire duration.
 851       # Set an "end" of 1 past the end of the current call.
 852       $etime = $weektime + $seconds_left + 1;
 853     }
 854     elsif($ratetimenum) {
 855       # This is a timed rate, so go to the etime of this interval.
 856       # If it's followed by another timed rate, the stime of that
 857       # interval should match the etime of this one.
 858       my $interval = $rate_detail->rate_time->contains($weektime);
 859       $etime = $interval->etime;
 860     }
 861     else {
 862       # This is a default rate, so use the stime of the next
 863       # interval in the sequence.
 864       my $next_int = first { $_->stime > $weektime }
 865                       @{ $interval_cache{$regionnum} };
 866       if ($next_int) {
 867         $etime = $next_int->stime;
 868       }
 869       else {
 870         # weektime is near the end of the week, so decrement
 871         # it by a full week and use the stime of the first
 872         # interval.
 873         $weektime -= (3600*24*7);
 874         $etime = $interval_cache{$regionnum}->[0]->stime;
 875       }
 876     }
 877
 878     my $charge_sec = min($seconds_left, $etime - $weektime);
 879
 880     $seconds_left -= $charge_sec;
 881
 882     my $granularity = $rate_detail->sec_granularity;
 883
 884     my $minutes;
 885     if ( $granularity ) { # charge per minute
 886       # Round up to the nearest $granularity
 887       if ( $charge_sec and $charge_sec % $granularity ) {
 888         $charge_sec += $granularity - ($charge_sec % $granularity);
 889       }
 890       $minutes = $charge_sec / 60; #don't round this
 891     }
 892     else { # per call
 893       $minutes = 1;
 894       $seconds_left = 0;
 895     }
 896
 897     $seconds += $charge_sec;
 898
 899     if ( $rate_detail->min_included ) {
 900       # the old, kind of deprecated way to do this
 901       my $included_min = $opt{'region_group_included_min_hashref'} || {};
 902
 903       # by default, set the included minutes for this region/time to
 904       # what's in the rate_detail
 905       $included_min->{$regionnum}{$ratetimenum} = $rate_detail->min_included
 906         unless exists $included_min->{$regionnum}{$ratetimenum};
 907
 908       # the way that doesn't work
 909       #my $region_group = ($part_pkg->option_cacheable('min_included') || 0) > 0;
 910
 911       #${$opt{region_group_included_min}} -= $minutes
 912       #    if $region_group && $rate_detail->region_group;
 913
 914       if ( $included_min->{$regionnum}{$ratetimenum} >= $minutes ) {
 915         $charge_sec = 0;
 916         $included_min->{$regionnum}{$ratetimenum} -= $minutes;
 917       } else {
 918         $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60);
 919         $included_min->{$regionnum}{$ratetimenum} = 0;
 920       }
 921     } else {
 922       # the new way!
 923       my $applied_min = $cust_pkg->apply_usage(
 924         'cdr'         => $self,
 925         'rate_detail' => $rate_detail,
 926         'minutes'     => $minutes
 927       );
 928       # for now, usage pools deal only in whole minutes
 929       $charge_sec -= $applied_min * 60;
 930     }
 931
 932     if ( $charge_sec > 0 ) {
 933
 934       #NOW do connection charges here... right?
 935       #my $conn_seconds = min($seconds_left, $rate_detail->conn_sec);
 936       my $conn_seconds = 0;
 937       unless ( $connection_charged++ ) { #only one connection charge
 938         $conn_seconds = min($charge_sec, $rate_detail->conn_sec);
 939         $seconds_left -= $conn_seconds;
 940         $weektime     += $conn_seconds;
 941         $charge += $rate_detail->conn_charge;
 942       }
 943
 944                            #should preserve (display?) this
 945       if ( $granularity == 0 ) { # per call rate
 946         $charge += $rate_detail->min_charge;
 947       } else {
 948         my $charge_min = ( $charge_sec - $conn_seconds ) / 60;
 949         $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
 950       }
 951
 952     }
 953
 954     # choose next rate_detail
 955     $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
 956                                         'phonenum'    => $number,
 957                                         'weektime'    => $etime,
 958                                         'cdrtypenum'  => $self->cdrtypenum })
 959             if($seconds_left);
 960     # we have now moved forward to $etime
 961     $weektime = $etime;
 962
 963   } #while $seconds_left
 964
 965   # this is why we need regionnum/rate_region....
 966   warn "  (rate region $rate_region)\n" if $DEBUG;
 967
 968   # NOW round it.
 969   my $rounding = $part_pkg->option_cacheable('rounding') || 2;
 970   my $sprintformat = '%.'. $rounding. 'f';
 971   my $roundup = 10**(-3-$rounding);
 972   my $price = sprintf($sprintformat, $charge + $roundup);
 973
 974   $self->set_status_and_rated_price(
 975     'rated',
 976     $price,
 977     $opt{'svcnum'},
 978     'rated_pretty_dst'    => $pretty_dst,
 979     'rated_regionname'    => $rate_region->regionname,
 980     'rated_seconds'       => $seconds,
 981     'rated_granularity'   => $rate_detail->sec_granularity, #$granularity
 982     'rated_ratedetailnum' => $rate_detail->ratedetailnum,
 983     'rated_classnum'      => $rate_detail->classnum, #rated_ratedetailnum?
 984     'rated_ratename'      => $ratename, #not rate_detail - Intrastate/Interstate
 985   );
 986
 987 }
 988
 989 sub rate_upstream_simple {
 990   my( $self, %opt ) = @_;
 991
 992   $self->set_status_and_rated_price(
 993     'rated',
 994     sprintf('%.3f', $self->upstream_price),
 995     $opt{'svcnum'},
 996     'rated_classnum' => $self->calltypenum,
 997   );
 998 }
 999
1000 sub rate_single_price {
1001   my( $self, %opt ) = @_;
1002   my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
1003
1004   # a little false laziness w/abov
1005   # $rate_detail = new FS::rate_detail({sec_granularity => ... }) ?
1006
1007   my $granularity = length($part_pkg->option_cacheable('sec_granularity'))
1008                       ? $part_pkg->option_cacheable('sec_granularity')
1009                       : 60;
1010
1011   my $seconds = $part_pkg->option_cacheable('use_duration')
1012                   ? $self->duration
1013                   : $self->billsec;
1014
1015   $seconds += $granularity - ( $seconds % $granularity )
1016     if $seconds      # don't granular-ize 0 billsec calls (bills them)
1017     && $granularity  # 0 is per call
1018     && $seconds % $granularity;
1019   my $minutes = $granularity ? ($seconds / 60) : 1;
1020
1021   my $charge_min = $minutes;
1022
1023   ${$opt{single_price_included_min}} -= $minutes;
1024   if ( ${$opt{single_price_included_min}} > 0 ) {
1025     $charge_min = 0;
1026   } else {
1027      $charge_min = 0 - ${$opt{single_price_included_min}};
1028      ${$opt{single_price_included_min}} = 0;
1029   }
1030
1031   my $charge =
1032     sprintf('%.4f', ( $part_pkg->option_cacheable('min_charge') * $charge_min )
1033                     + 0.0000000001 ); #so 1.00005 rounds to 1.0001
1034
1035   $self->set_status_and_rated_price(
1036     'rated',
1037     $charge,
1038     $opt{'svcnum'},
1039     'rated_granularity' => $granularity,
1040     'rated_seconds'     => $seconds,
1041   );
1042
1043 }
1044
1045 =item cdr_termination [ TERMPART ]
1046
1047 =cut
1048
1049 sub cdr_termination {
1050   my $self = shift;
1051
1052   if ( scalar(@_) && $_[0] ) {
1053     my $termpart = shift;
1054
1055     qsearchs('cdr_termination', { acctid   => $self->acctid,
1056                                   termpart => $termpart,
1057                                 }
1058             );
1059
1060   } else {
1061
1062     qsearch('cdr_termination', { acctid => $self->acctid, } );
1063
1064   }
1065
1066 }
1067
1068 =item calldate_unix
1069
1070 Parses the calldate in SQL string format and returns a UNIX timestamp.
1071
1072 =cut
1073
1074 sub calldate_unix {
1075   str2time(shift->calldate);
1076 }
1077
1078 =item startdate_sql
1079
1080 Parses the startdate in UNIX timestamp format and returns a string in SQL
1081 format.
1082
1083 =cut
1084
1085 sub startdate_sql {
1086   my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
1087   $mon++;
1088   $year += 1900;
1089   "$year-$mon-$mday $hour:$min:$sec";
1090 }
1091
1092 =item cdr_carrier
1093
1094 Returns the FS::cdr_carrier object associated with this CDR, or false if no
1095 carrierid is defined.
1096
1097 =cut
1098
1099 my %carrier_cache = ();
1100
1101 sub cdr_carrier {
1102   my $self = shift;
1103   return '' unless $self->carrierid;
1104   $carrier_cache{$self->carrierid} ||=
1105     qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
1106 }
1107
1108 =item carriername
1109
1110 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
1111 no FS::cdr_carrier object is assocated with this CDR.
1112
1113 =cut
1114
1115 sub carriername {
1116   my $self = shift;
1117   my $cdr_carrier = $self->cdr_carrier;
1118   $cdr_carrier ? $cdr_carrier->carriername : '';
1119 }
1120
1121 =item cdr_calltype
1122
1123 Returns the FS::cdr_calltype object associated with this CDR, or false if no
1124 calltypenum is defined.
1125
1126 =cut
1127
1128 my %calltype_cache = ();
1129
1130 sub cdr_calltype {
1131   my $self = shift;
1132   return '' unless $self->calltypenum;
1133   $calltype_cache{$self->calltypenum} ||=
1134     qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
1135 }
1136
1137 =item calltypename
1138
1139 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
1140 no FS::cdr_calltype object is assocated with this CDR.
1141
1142 =cut
1143
1144 sub calltypename {
1145   my $self = shift;
1146   my $cdr_calltype = $self->cdr_calltype;
1147   $cdr_calltype ? $cdr_calltype->calltypename : '';
1148 }
1149
1150 =item downstream_csv [ OPTION => VALUE, ... ]
1151
1152 =cut
1153
1154 # in the future, load this dynamically from detail_format classes
1155
1156 my %export_names = (
1157   'simple'  => {
1158     'name'           => 'Simple',
1159     'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
1160   },
1161   'simple2' => {
1162     'name'           => 'Simple with source',
1163     'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
1164                        #"Date,Time,Name,Called From,Destination,Duration,Price",
1165   },
1166   'accountcode_simple' => {
1167     'name'           => 'Simple with accountcode',
1168     'invoice_header' => "Date,Time,Called From,Account,Duration,Price",
1169   },
1170   'basic' => {
1171     'name'           => 'Basic',
1172     'invoice_header' => "Date/Time,Called Number,Min/Sec,Price",
1173   },
1174   'basic_upstream_dst_regionname' => {
1175     'name'           => 'Basic with upstream destination name',
1176     'invoice_header' => "Date/Time,Called Number,Destination,Min/Sec,Price",
1177   },
1178   'default' => {
1179     'name'           => 'Default',
1180     'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
1181   },
1182   'source_default' => {
1183     'name'           => 'Default with source',
1184     'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1185   },
1186   'accountcode_default' => {
1187     'name'           => 'Default plus accountcode',
1188     'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
1189   },
1190   'description_default' => {
1191     'name'           => 'Default with description field as destination',
1192     'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1193   },
1194   'sum_duration' => {
1195     'name'           => 'Summary, one line per service',
1196     'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1197   },
1198   'sum_count' => {
1199     'name'           => 'Number of calls, one line per service',
1200     'invoice_header' => 'Caller,Rate,Messages,Price',
1201   },
1202   'sum_duration_prefix' => {
1203     'name'           => 'Summary, one line per destination prefix',
1204     'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1205   },
1206 );
1207
1208 my %export_formats = ();
1209 sub export_formats {
1210   #my $self = shift;
1211
1212   return %export_formats if keys %export_formats;
1213
1214   my $conf = new FS::Conf;
1215   my $date_format = $conf->config('date_format') || '%m/%d/%Y';
1216
1217   # call duration in the largest units that accurately reflect the  granularity
1218   my $duration_sub = sub {
1219     my($cdr, %opt) = @_;
1220     my $sec = $opt{seconds} || $cdr->billsec;
1221     if ( defined $opt{granularity} &&
1222          $opt{granularity} == 0 ) { #per call
1223       return '1 call';
1224     }
1225     elsif ( defined $opt{granularity} && $opt{granularity} == 60 ) {#full minutes
1226       my $min = int($sec/60);
1227       $min++ if $sec%60;
1228       return $min.'m';
1229     }
1230     else { #anything else
1231       return sprintf("%dm %ds", $sec/60, $sec%60);
1232     }
1233   };
1234
1235   my $price_sub = sub {
1236     my ($cdr, %opt) = @_;
1237     my $price;
1238     if ( defined($opt{charge}) ) {
1239       $price = $opt{charge};
1240     }
1241     elsif ( $opt{inbound} ) {
1242       my $term = $cdr->cdr_termination(1); # 1 = inbound
1243       $price = $term->rated_price if defined $term;
1244     }
1245     else {
1246       $price = $cdr->rated_price;
1247     }
1248     length($price) ? ($opt{money_char} . $price) : '';
1249   };
1250
1251   my $src_sub = sub { $_[0]->clid || $_[0]->src };
1252
1253   %export_formats = (
1254     'simple' => [
1255       sub { time2str($date_format, shift->calldate_unix ) },   #DATE
1256       sub { time2str('%r', shift->calldate_unix ) },   #TIME
1257       'userfield',                                     #USER
1258       'dst',                                           #NUMBER_DIALED
1259       $duration_sub,                                   #DURATION
1260       #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1261       $price_sub,
1262     ],
1263     'simple2' => [
1264       sub { time2str($date_format, shift->calldate_unix ) },   #DATE
1265       sub { time2str('%r', shift->calldate_unix ) },   #TIME
1266       #'userfield',                                     #USER
1267       $src_sub,                                           #called from
1268       'dst',                                           #NUMBER_DIALED
1269       $duration_sub,                                   #DURATION
1270       #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1271       $price_sub,
1272     ],
1273     'accountcode_simple' => [
1274       sub { time2str($date_format, shift->calldate_unix ) },   #DATE
1275       sub { time2str('%r', shift->calldate_unix ) },   #TIME
1276       $src_sub,                                           #called from
1277       'accountcode',                                   #NUMBER_DIALED
1278       $duration_sub,                                   #DURATION
1279       $price_sub,
1280     ],
1281     'sum_duration' => [
1282       # for summary formats, the CDR is a fictitious object containing the
1283       # total billsec and the phone number of the service
1284       $src_sub,
1285       sub { my($cdr, %opt) = @_; $opt{ratename} },
1286       sub { my($cdr, %opt) = @_; $opt{count} },
1287       sub { my($cdr, %opt) = @_; int($opt{seconds}/60).'m' },
1288       $price_sub,
1289     ],
1290     'sum_count' => [
1291       $src_sub,
1292       sub { my($cdr, %opt) = @_; $opt{ratename} },
1293       sub { my($cdr, %opt) = @_; $opt{count} },
1294       $price_sub,
1295     ],
1296     'basic' => [
1297       sub { time2str('%d %b - %I:%M %p', shift->calldate_unix) },
1298       'dst',
1299       $duration_sub,
1300       $price_sub,
1301     ],
1302     'default' => [
1303
1304       #DATE
1305       sub { time2str($date_format, shift->calldate_unix ) },
1306             # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
1307
1308       #TIME
1309       sub { time2str('%r', shift->calldate_unix ) },
1310             # 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
1311
1312       #DEST ("Number")
1313       sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
1314
1315       #REGIONNAME ("Destination")
1316       sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
1317
1318       #DURATION
1319       $duration_sub,
1320
1321       #PRICE
1322       $price_sub,
1323     ],
1324   );
1325   $export_formats{'source_default'} = [ $src_sub, @{ $export_formats{'default'} }, ];
1326   $export_formats{'accountcode_default'} =
1327     [ @{ $export_formats{'default'} }[0,1],
1328       'accountcode',
1329       @{ $export_formats{'default'} }[2..5],
1330     ];
1331   my @default = @{ $export_formats{'default'} };
1332   $export_formats{'description_default'} =
1333     [ $src_sub, @default[0..2],
1334       sub { my($cdr, %opt) = @_; $cdr->description },
1335       @default[4,5] ];
1336
1337   return %export_formats;
1338 }
1339
1340 =item downstream_csv OPTION => VALUE ...
1341
1342 Returns a string of formatted call details for display on an invoice.
1343
1344 Options:
1345
1346 format
1347
1348 charge - override the 'rated_price' field of the CDR
1349
1350 seconds - override the 'billsec' field of the CDR
1351
1352 count - number of usage events included in this record, for summary formats
1353
1354 ratename - name of the rate table used to rate this call
1355
1356 granularity
1357
1358 =cut
1359
1360 sub downstream_csv {
1361   my( $self, %opt ) = @_;
1362
1363   my $format = $opt{'format'};
1364   my %formats = $self->export_formats;
1365   return "Unknown format $format" unless exists $formats{$format};
1366
1367   #my $conf = new FS::Conf;
1368   #$opt{'money_char'} ||= $conf->config('money_char') || '$';
1369   $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
1370
1371   my $csv = new Text::CSV_XS;
1372
1373   my @columns =
1374     map {
1375           ref($_) ? &{$_}($self, %opt) : $self->$_();
1376         }
1377     @{ $formats{$format} };
1378
1379   return @columns if defined $opt{'keeparray'};
1380
1381   my $status = $csv->combine(@columns);
1382   die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
1383     unless $status;
1384
1385   $csv->string;
1386
1387 }
1388
1389 =back
1390
1391 =head1 CLASS METHODS
1392
1393 =over 4
1394
1395 =item invoice_formats
1396
1397 Returns an ordered list of key value pairs containing invoice format names
1398 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
1399
1400 =cut
1401
1402 # in the future, load this dynamically from detail_format classes
1403
1404 sub invoice_formats {
1405   map { ($_ => $export_names{$_}->{'name'}) }
1406     grep { $export_names{$_}->{'invoice_header'} }
1407     keys %export_names;
1408 }
1409
1410 =item invoice_header FORMAT
1411
1412 Returns a scalar containing the CSV column header for invoice format FORMAT.
1413
1414 =cut
1415
1416 sub invoice_header {
1417   my $format = shift;
1418   $export_names{$format}->{'invoice_header'};
1419 }
1420
1421 =item clear_status
1422
1423 Clears cdr and any associated cdr_termination statuses - used for
1424 CDR reprocessing.
1425
1426 =cut
1427
1428 sub clear_status {
1429   my $self = shift;
1430   my %opt = @_;
1431
1432   local $SIG{HUP} = 'IGNORE';
1433   local $SIG{INT} = 'IGNORE';
1434   local $SIG{QUIT} = 'IGNORE';
1435   local $SIG{TERM} = 'IGNORE';
1436   local $SIG{TSTP} = 'IGNORE';
1437   local $SIG{PIPE} = 'IGNORE';
1438
1439   my $oldAutoCommit = $FS::UID::AutoCommit;
1440   local $FS::UID::AutoCommit = 0;
1441   my $dbh = dbh;
1442
1443   if ( $cdr_prerate && $cdr_prerate_cdrtypenums{$self->cdrtypenum}
1444        && $self->rated_ratedetailnum #avoid putting old CDRs back in "rated"
1445        && $self->freesidestatus eq 'done'
1446        && ! $opt{'rerate'}
1447      )
1448   { #special case
1449     $self->freesidestatus('rated');
1450   } else {
1451     $self->freesidestatus('');
1452   }
1453
1454   my $error = $self->replace;
1455   if ( $error ) {
1456     $dbh->rollback if $oldAutoCommit;
1457     return $error;
1458   }
1459
1460   foreach my $cdr_termination ( $self->cdr_termination ) {
1461       #$cdr_termination->status('');
1462       #$error = $cdr_termination->replace;
1463       $error = $cdr_termination->delete;
1464       if ( $error ) {
1465         $dbh->rollback if $oldAutoCommit;
1466         return $error;
1467       }
1468   }
1469
1470   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1471
1472   '';
1473 }
1474
1475 =item import_formats
1476
1477 Returns an ordered list of key value pairs containing import format names
1478 as keys (for use with batch_import) and "pretty" format names as values.
1479
1480 =cut
1481
1482 #false laziness w/part_pkg & part_export
1483
1484 my %cdr_info;
1485 foreach my $INC ( @INC ) {
1486   warn "globbing $INC/FS/cdr/*.pm\n" if $DEBUG;
1487   foreach my $file ( glob("$INC/FS/cdr/*.pm") ) {
1488     warn "attempting to load CDR format info from $file\n" if $DEBUG;
1489     $file =~ /\/(\w+)\.pm$/ or do {
1490       warn "unrecognized file in $INC/FS/cdr/: $file\n";
1491       next;
1492     };
1493     my $mod = $1;
1494     my $info = eval "use FS::cdr::$mod; ".
1495                     "\\%FS::cdr::$mod\::info;";
1496     if ( $@ ) {
1497       die "error using FS::cdr::$mod (skipping): $@\n" if $@;
1498       next;
1499     }
1500     unless ( keys %$info ) {
1501       warn "no %info hash found in FS::cdr::$mod, skipping\n";
1502       next;
1503     }
1504     warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
1505     if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1506       warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
1507       next;
1508     }
1509     $cdr_info{$mod} = $info;
1510   }
1511 }
1512
1513 tie my %import_formats, 'Tie::IxHash',
1514   map  { $_ => $cdr_info{$_}->{'name'} }
1515   sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
1516   grep { exists($cdr_info{$_}->{'import_fields'}) }
1517   keys %cdr_info;
1518
1519 sub import_formats {
1520   %import_formats;
1521 }
1522
1523 sub _cdr_min_parser_maker {
1524   my $field = shift;
1525   my @fields = ref($field) ? @$field : ($field);
1526   @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
1527   return sub {
1528     my( $cdr, $min ) = @_;
1529     my $sec = eval { _cdr_min_parse($min) };
1530     die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
1531     $cdr->$_($sec) foreach @fields;
1532   };
1533 }
1534
1535 sub _cdr_min_parse {
1536   my $min = shift;
1537   sprintf('%.0f', $min * 60 );
1538 }
1539
1540 sub _cdr_date_parser_maker {
1541   my $field = shift;
1542   my %options = @_;
1543   my @fields = ref($field) ? @$field : ($field);
1544   return sub {
1545     my( $cdr, $datestring ) = @_;
1546     my $unixdate = eval { _cdr_date_parse($datestring, %options) };
1547     die "error parsing date for @fields from $datestring: $@\n" if $@;
1548     $cdr->$_($unixdate) foreach @fields;
1549   };
1550 }
1551
1552 sub _cdr_date_parse {
1553   my $date = shift;
1554   my %options = @_;
1555
1556   return '' unless length($date); #that's okay, it becomes NULL
1557   return '' if $date eq 'NA'; #sansay
1558
1559   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 ) {
1560     my $time = str2time($date);
1561     return $time if $time > 100000; #just in case
1562   }
1563
1564   my($year, $mon, $day, $hour, $min, $sec);
1565
1566   #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
1567   #taqua  #2007-10-31 08:57:24.113000000
1568
1569   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|$)/ ) {
1570     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1571   } 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|$)/ ) {
1572     # 8/26/2010 12:20:01
1573     # optionally without seconds
1574     ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1575     $sec = 0 if !defined($sec);
1576   } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d+\.\d+)(\D|$)/ ) {
1577     # broadsoft: 20081223201938.314
1578     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1579   } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\d+(\D|$)/ ) {
1580     # Taqua OM:  20050422203450943
1581     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1582   } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) {
1583     # WIP: 20100329121420
1584     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1585   } elsif ( $date =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z$/) {
1586     # Telos
1587     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1588     $options{gmt} = 1;
1589   } else {
1590      die "unparsable date: $date"; #maybe we shouldn't die...
1591   }
1592
1593   return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
1594             && $hour == 0 && $min == 0 && $sec == 0;
1595
1596   if ($options{gmt}) {
1597     timegm($sec, $min, $hour, $day, $mon-1, $year);
1598   } else {
1599     timelocal($sec, $min, $hour, $day, $mon-1, $year);
1600   }
1601 }
1602
1603 =item batch_import HASHREF
1604
1605 Imports CDR records.  Available options are:
1606
1607 =over 4
1608
1609 =item file
1610
1611 Filename
1612
1613 =item format
1614
1615 =item params
1616
1617 Hash reference of preset fields, typically cdrbatch
1618
1619 =item empty_ok
1620
1621 Set true to prevent throwing an error on empty imports
1622
1623 =back
1624
1625 =cut
1626
1627 my %import_options = (
1628   'table'         => 'cdr',
1629
1630   'batch_keycol'  => 'cdrbatchnum',
1631   'batch_table'   => 'cdr_batch',
1632   'batch_namecol' => 'cdrbatch',
1633
1634   'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
1635                      keys %cdr_info
1636                },
1637
1638                           #drop the || 'csv' to allow auto xls for csv types?
1639   'format_types' => { map { $_ => lc($cdr_info{$_}->{'type'} || 'csv'); }
1640                           keys %cdr_info
1641                     },
1642
1643   'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
1644                             keys %cdr_info
1645                       },
1646
1647   'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
1648                               keys %cdr_info
1649                         },
1650
1651   'format_fixedlength_formats' =>
1652     { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
1653           keys %cdr_info
1654     },
1655
1656   'format_xml_formats' =>
1657     { map { $_ => $cdr_info{$_}->{'xml_format'}; }
1658           keys %cdr_info
1659     },
1660
1661   'format_asn_formats' =>
1662     { map { $_ => $cdr_info{$_}->{'asn_format'}; }
1663           keys %cdr_info
1664     },
1665
1666   'format_row_callbacks' =>
1667     { map { $_ => $cdr_info{$_}->{'row_callback'}; }
1668           keys %cdr_info
1669     },
1670
1671   'format_parser_opts' =>
1672     { map { $_ => $cdr_info{$_}->{'parser_opt'}; }
1673           keys %cdr_info
1674     },
1675 );
1676
1677 sub _import_options {
1678   \%import_options;
1679 }
1680
1681 sub batch_import {
1682   my $opt = shift;
1683
1684   my $iopt = _import_options;
1685   $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
1686
1687   if ( defined $opt->{'cdrtypenum'} ) {
1688         $opt->{'preinsert_callback'} = sub {
1689                 my($record,$param) = (shift,shift);
1690                 $record->cdrtypenum($opt->{'cdrtypenum'});
1691                 '';
1692         };
1693   }
1694
1695   FS::Record::batch_import( $opt );
1696
1697 }
1698
1699 =item process_batch_import
1700
1701 =cut
1702
1703 sub process_batch_import {
1704   my $job = shift;
1705
1706   my $opt = _import_options;
1707 #  $opt->{'params'} = [ 'format', 'cdrbatch' ];
1708
1709   FS::Record::process_batch_import( $job, $opt, @_ );
1710
1711 }
1712 #  if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
1713 #    @columns = map { s/^ +//; $_; } @columns;
1714 #  }
1715
1716 # _ upgrade_data
1717 #
1718 # Used by FS::Upgrade to migrate to a new database.
1719
1720 sub _upgrade_data {
1721   my ($class, %opts) = @_;
1722
1723   warn "$me upgrading $class\n" if $DEBUG;
1724
1725   my $sth = dbh->prepare(
1726     'SELECT DISTINCT(cdrbatch) FROM cdr WHERE cdrbatch IS NOT NULL'
1727   ) or die dbh->errstr;
1728
1729   $sth->execute or die $sth->errstr;
1730
1731   my %cdrbatchnum = ();
1732   while (my $row = $sth->fetchrow_arrayref) {
1733
1734     my $cdr_batch = qsearchs( 'cdr_batch', { 'cdrbatch' => $row->[0] } );
1735     unless ( $cdr_batch ) {
1736       $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] };
1737       my $error = $cdr_batch->insert;
1738       die $error if $error;
1739     }
1740
1741     $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum;
1742   }
1743
1744   $sth = dbh->prepare('UPDATE cdr SET cdrbatch = NULL, cdrbatchnum = ? WHERE cdrbatch IS NOT NULL AND cdrbatch = ?') or die dbh->errstr;
1745
1746   foreach my $cdrbatch (keys %cdrbatchnum) {
1747     $sth->execute($cdrbatchnum{$cdrbatch}, $cdrbatch) or die $sth->errstr;
1748   }
1749
1750 }
1751
1752 =item ip_addr_sql FIELD RANGE
1753
1754 Returns an SQL condition to search for CDRs with an IP address
1755 within RANGE.  FIELD is either 'src_ip_addr' or 'dst_ip_addr'.  RANGE
1756 should be in the form "a.b.c.d-e.f.g.h' (dotted quads), where any of
1757 the leftmost octets of the second address can be omitted if they're
1758 the same as the first address.
1759
1760 =cut
1761
1762 sub ip_addr_sql {
1763   my $class = shift;
1764   my ($field, $range) = @_;
1765   $range =~ /^[\d\.-]+$/ or die "bad ip address range '$range'";
1766   my @r = split('-', $range);
1767   my @saddr = split('\.', $r[0] || '');
1768   my @eaddr = split('\.', $r[1] || '');
1769   unshift @eaddr, (undef) x (4 - scalar @eaddr);
1770   for(0..3) {
1771     $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
1772   }
1773   "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
1774   "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
1775 }
1776
1777 =back
1778
1779 =head1 BUGS
1780
1781 =head1 SEE ALSO
1782
1783 L<FS::Record>, schema.html from the base documentation.
1784
1785 =cut
1786
1787 1;
1788