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