FS/FS/cdr.pm

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