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