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