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