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