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