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