FS/FS/cdr.pm

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