FS/FS/cdr.pm

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