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 cdrbatch
 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         'cdrbatch'              => 'Legacy batch',
 246         'cdrbatchnum'           => 'Batch',
 247         'detailnum'             => 'Freeside invoice detail line',
 248     },
 249
 250   };
 251
 252 }
 253
 254 =item insert
 255
 256 Adds this record to the database.  If there is an error, returns the error,
 257 otherwise returns false.
 258
 259 =cut
 260
 261 # the insert method can be inherited from FS::Record
 262
 263 =item delete
 264
 265 Delete this record from the database.
 266
 267 =cut
 268
 269 # the delete method can be inherited from FS::Record
 270
 271 =item replace OLD_RECORD
 272
 273 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 274 returns the error, otherwise returns false.
 275
 276 =cut
 277
 278 # the replace method can be inherited from FS::Record
 279
 280 =item check
 281
 282 Checks all fields to make sure this is a valid CDR.  If there is
 283 an error, returns the error, otherwise returns false.  Called by the insert
 284 and replace methods.
 285
 286 Note: Unlike most types of records, we don't want to "reject" a CDR and we want
 287 to process them as quickly as possible, so we allow the database to check most
 288 of the data.
 289
 290 =cut
 291
 292 sub check {
 293   my $self = shift;
 294
 295 # we don't want to "reject" a CDR like other sorts of input...
 296 #  my $error =
 297 #    $self->ut_numbern('acctid')
 298 ##    || $self->ut_('calldate')
 299 #    || $self->ut_text('clid')
 300 #    || $self->ut_text('src')
 301 #    || $self->ut_text('dst')
 302 #    || $self->ut_text('dcontext')
 303 #    || $self->ut_text('channel')
 304 #    || $self->ut_text('dstchannel')
 305 #    || $self->ut_text('lastapp')
 306 #    || $self->ut_text('lastdata')
 307 #    || $self->ut_numbern('startdate')
 308 #    || $self->ut_numbern('answerdate')
 309 #    || $self->ut_numbern('enddate')
 310 #    || $self->ut_number('duration')
 311 #    || $self->ut_number('billsec')
 312 #    || $self->ut_text('disposition')
 313 #    || $self->ut_number('amaflags')
 314 #    || $self->ut_text('accountcode')
 315 #    || $self->ut_text('uniqueid')
 316 #    || $self->ut_text('userfield')
 317 #    || $self->ut_numbern('cdrtypenum')
 318 #    || $self->ut_textn('charged_party')
 319 ##    || $self->ut_n('upstream_currency')
 320 ##    || $self->ut_n('upstream_price')
 321 #    || $self->ut_numbern('upstream_rateplanid')
 322 ##    || $self->ut_n('distance')
 323 #    || $self->ut_numbern('islocal')
 324 #    || $self->ut_numbern('calltypenum')
 325 #    || $self->ut_textn('description')
 326 #    || $self->ut_numbern('quantity')
 327 #    || $self->ut_numbern('carrierid')
 328 #    || $self->ut_numbern('upstream_rateid')
 329 #    || $self->ut_numbern('svcnum')
 330 #    || $self->ut_textn('freesidestatus')
 331 #    || $self->ut_textn('freesiderewritestatus')
 332 #  ;
 333 #  return $error if $error;
 334
 335   for my $f ( grep { $self->$_ =~ /\D/ } qw(startdate answerdate enddate)){
 336     $self->$f( str2time($self->$f) );
 337   }
 338
 339   $self->calldate( $self->startdate_sql )
 340     if !$self->calldate && $self->startdate;
 341
 342   #was just for $format eq 'taqua' but can't see the harm... add something to
 343   #disable if it becomes a problem
 344   if ( $self->duration eq '' && $self->enddate && $self->startdate ) {
 345     $self->duration( $self->enddate - $self->startdate  );
 346   }
 347   if ( $self->billsec eq '' && $self->enddate && $self->answerdate ) {
 348     $self->billsec(  $self->enddate - $self->answerdate );
 349   }
 350
 351   if ( ! $self->enddate && $self->startdate && $self->duration ) {
 352     $self->enddate( $self->startdate + $self->duration );
 353   }
 354
 355   $self->set_charged_party;
 356
 357   #check the foreign keys even?
 358   #do we want to outright *reject* the CDR?
 359   my $error = $self->ut_numbern('acctid');
 360   return $error if $error;
 361
 362   if ( $self->freesidestatus ne 'done' ) {
 363     $self->set('detailnum', ''); # can't have this on an unbilled call
 364   }
 365
 366   #add a config option to turn these back on if someone needs 'em
 367   #
 368   #  #Usage = 1, S&E = 7, OC&C = 8
 369   #  || $self->ut_foreign_keyn('cdrtypenum',  'cdr_type',     'cdrtypenum' )
 370   #
 371   #  #the big list in appendix 2
 372   #  || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
 373   #
 374   #  # Telstra =1, Optus = 2, RSL COM = 3
 375   #  || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
 376
 377   $self->SUPER::check;
 378 }
 379
 380 =item is_tollfree [ COLUMN ]
 381
 382 Returns true when the cdr represents a toll free number and false otherwise.
 383
 384 By default, inspects the dst field, but an optional column name can be passed
 385 to inspect other field.
 386
 387 =cut
 388
 389 sub is_tollfree {
 390   my $self = shift;
 391   my $field = scalar(@_) ? shift : 'dst';
 392   my $country = $conf->config('tollfree-country') || '';
 393   if ( $country eq 'AU' ) {
 394     ( $self->$field() =~ /^(\+?61)?(1800|1300)/ ) ? 1 : 0;
 395   } elsif ( $country eq 'NZ' ) {
 396     ( $self->$field() =~ /^(\+?64)?(800|508)/ ) ? 1 : 0;
 397   } else { #NANPA (US/Canaada)
 398     ( $self->$field() =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0;
 399   }
 400 }
 401
 402 =item set_charged_party
 403
 404 If the charged_party field is already set, does nothing.  Otherwise:
 405
 406 If the cdr-charged_party-accountcode config option is enabled, sets the
 407 charged_party to the accountcode.
 408
 409 Otherwise sets the charged_party normally: to the src field in most cases,
 410 or to the dst field if it is a toll free number.
 411
 412 =cut
 413
 414 sub set_charged_party {
 415   my $self = shift;
 416
 417   my $conf = new FS::Conf;
 418
 419   unless ( $self->charged_party ) {
 420
 421     if ( $conf->exists('cdr-charged_party-accountcode') && $self->accountcode ){
 422
 423       my $charged_party = $self->accountcode;
 424       $charged_party =~ s/^0+//
 425         if $conf->exists('cdr-charged_party-accountcode-trim_leading_0s');
 426       $self->charged_party( $charged_party );
 427
 428     } elsif ( $conf->exists('cdr-charged_party-field') ) {
 429
 430       my $field = $conf->config('cdr-charged_party-field');
 431       $self->charged_party( $self->$field() );
 432
 433     } else {
 434
 435       if ( $self->is_tollfree ) {
 436         $self->charged_party($self->dst);
 437       } else {
 438         $self->charged_party($self->src);
 439       }
 440
 441     }
 442
 443   }
 444
 445 #  my $prefix = $conf->config('cdr-charged_party-truncate_prefix');
 446 #  my $prefix_len = length($prefix);
 447 #  my $trunc_len = $conf->config('cdr-charged_party-truncate_length');
 448 #
 449 #  $self->charged_party( substr($self->charged_party, 0, $trunc_len) )
 450 #    if $prefix_len && $trunc_len
 451 #    && substr($self->charged_party, 0, $prefix_len) eq $prefix;
 452
 453 }
 454
 455 =item set_status STATUS
 456
 457 Sets the status to the provided string.  If there is an error, returns the
 458 error, otherwise returns false.
 459
 460 If status is being changed from 'rated' to some other status, also removes
 461 any usage allocations to this CDR.
 462
 463 =cut
 464
 465 sub set_status {
 466   my($self, $status) = @_;
 467   my $old_status = $self->freesidestatus;
 468   $self->freesidestatus($status);
 469   my $error = $self->replace;
 470   if ( $old_status eq 'rated' and $status ne 'done' ) {
 471     # deallocate any usage
 472     foreach (qsearch('cdr_cust_pkg_usage', {acctid => $self->acctid})) {
 473       my $cust_pkg_usage = $_->cust_pkg_usage;
 474       $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $_->minutes);
 475       $error ||= $cust_pkg_usage->replace || $_->delete;
 476     }
 477   }
 478   $error;
 479 }
 480
 481 =item set_status_and_rated_price STATUS RATED_PRICE [ SVCNUM [ OPTION => VALUE ... ] ]
 482
 483 Sets the status and rated price.
 484
 485 Available options are: inbound, rated_pretty_dst, rated_regionname,
 486 rated_seconds, rated_minutes, rated_granularity, rated_ratedetailnum,
 487 rated_classnum, rated_ratename.  If rated_ratedetailnum is provided,
 488 will also set a recalculated L</rate_cost> in the rated_cost field
 489 after the other fields are set (does not work with inbound.)
 490
 491 If there is an error, returns the error, otherwise returns false.
 492
 493 =cut
 494
 495 sub set_status_and_rated_price {
 496   my($self, $status, $rated_price, $svcnum, %opt) = @_;
 497
 498   if ($opt{'inbound'}) {
 499
 500     my $term = $self->cdr_termination( 1 ); #1: inbound
 501     my $error;
 502     if ( $term ) {
 503       warn "replacing existing cdr status (".$self->acctid.")\n" if $term;
 504       $error = $term->delete;
 505       return $error if $error;
 506     }
 507     $term = FS::cdr_termination->new({
 508         acctid      => $self->acctid,
 509         termpart    => 1,
 510         rated_price => $rated_price,
 511         status      => $status,
 512     });
 513     foreach (qw(rated_seconds rated_minutes rated_granularity)) {
 514       $term->set($_, $opt{$_}) if exists($opt{$_});
 515     }
 516     $term->svcnum($svcnum) if $svcnum;
 517     return $term->insert;
 518
 519   } else {
 520
 521     $self->freesidestatus($status);
 522     $self->freesidestatustext($opt{'statustext'}) if exists($opt{'statustext'});
 523     $self->rated_price($rated_price);
 524     $self->$_($opt{$_})
 525       foreach grep exists($opt{$_}), map "rated_$_",
 526         qw( pretty_dst regionname seconds minutes granularity
 527             ratedetailnum classnum ratename );
 528     $self->svcnum($svcnum) if $svcnum;
 529     $self->rated_cost($self->rate_cost) if $opt{'rated_ratedetailnum'};
 530
 531     return $self->replace();
 532
 533   }
 534 }
 535
 536 =item parse_number [ OPTION => VALUE ... ]
 537
 538 Returns two scalars, the countrycode and the rest of the number.
 539
 540 Options are passed as name-value pairs.  Currently available options are:
 541
 542 =over 4
 543
 544 =item column
 545
 546 The column containing the number to be parsed.  Defaults to dst.
 547
 548 =item international_prefix
 549
 550 The digits for international dialing.  Defaults to '011'  The value '+' is
 551 always recognized.
 552
 553 =item domestic_prefix
 554
 555 The digits for domestic long distance dialing.  Defaults to '1'
 556
 557 =back
 558
 559 =cut
 560
 561 sub parse_number {
 562   my ($self, %options) = @_;
 563
 564   my $field = $options{column} || 'dst';
 565   my $intl = $options{international_prefix} || '011';
 566   # Still, don't break anyone's CDR rating if they have an empty string in
 567   # there. Require an explicit statement that there's no prefix.
 568   $intl = '' if lc($intl) eq 'none';
 569   my $countrycode = '';
 570   my $number = $self->$field();
 571
 572   my $to_or_from = 'concerning';
 573   $to_or_from = 'from' if $field eq 'src';
 574   $to_or_from = 'to' if $field eq 'dst';
 575   warn "parsing call $to_or_from $number\n" if $DEBUG;
 576
 577   #remove non-phone# stuff and whitespace
 578   $number =~ s/\s//g;
 579 #          my $proto = '';
 580 #          $dest =~ s/^(\w+):// and $proto = $1; #sip:
 581 #          my $siphost = '';
 582 #          $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
 583
 584   if (    $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
 585        || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
 586      )
 587   {
 588
 589     my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 );
 590     #first look for 1 digit country code
 591     if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) {
 592       $countrycode = $one;
 593       $number = $u1.$u2.$rest;
 594     } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
 595       $countrycode = $two;
 596       $number = $u2.$rest;
 597     } else { #3 digit country code
 598       $countrycode = $three;
 599       $number = $rest;
 600     }
 601
 602   } else {
 603     my $domestic_prefix =
 604       exists($options{domestic_prefix}) ? $options{domestic_prefix} : '';
 605     $countrycode = length($domestic_prefix) ? $domestic_prefix : '1';
 606     $number =~ s/^$countrycode//;# if length($number) > 10;
 607   }
 608
 609   return($countrycode, $number);
 610
 611 }
 612
 613 =item rate [ OPTION => VALUE ... ]
 614
 615 Rates this CDR according and sets the status to 'rated'.
 616
 617 Available options are: part_pkg, svcnum, plan_included_min,
 618 detail_included_min_hashref.
 619
 620 part_pkg is required.
 621
 622 If svcnum is specified, will also associate this CDR with the specified svcnum.
 623
 624 plan_included_min should be set to a scalar reference of the number of
 625 included minutes and will be decremented by the rated minutes of this
 626 CDR.
 627
 628 detail_included_min_hashref should be set to an empty hashref at the
 629 start of a month's rating and then preserved across CDRs.
 630
 631 =cut
 632
 633 sub rate {
 634   my( $self, %opt ) = @_;
 635   my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
 636
 637   if ( $DEBUG > 1 ) {
 638     warn "rating CDR $self\n".
 639          join('', map { "  $_ => ". $self->{$_}. "\n" } keys %$self );
 640   }
 641
 642   my $rating_method = $part_pkg->option_cacheable('rating_method') || 'prefix';
 643   my $method = "rate_$rating_method";
 644   $self->$method(%opt);
 645 }
 646
 647 #here?
 648 our %interval_cache = (); # for timed rates
 649
 650 sub rate_prefix {
 651   my( $self, %opt ) = @_;
 652   my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
 653   my $cust_pkg = $opt{'cust_pkg'};
 654
 655   ###
 656   # (Directory assistance) rewriting
 657   ###
 658
 659   my $da_rewrote = 0;
 660   # this will result in those CDRs being marked as done... is that
 661   # what we want?
 662   my @dirass = ();
 663   if ( $part_pkg->option_cacheable('411_rewrite') ) {
 664     my $dirass = $part_pkg->option_cacheable('411_rewrite');
 665     $dirass =~ s/\s//g;
 666     @dirass = split(',', $dirass);
 667   }
 668
 669   if ( length($self->dst) && grep { $self->dst eq $_ } @dirass ) {
 670     $self->dst('411');
 671     $da_rewrote = 1;
 672   }
 673
 674   ###
 675   # Checks to see if the CDR is chargeable
 676   ###
 677
 678   my $reason = $part_pkg->check_chargable( $self,
 679                                            'da_rewrote'   => $da_rewrote,
 680                                          );
 681   if ( $reason ) {
 682     warn "not charging for CDR ($reason)\n" if $DEBUG;
 683     return $self->set_status_and_rated_price( 'skipped',
 684                                               0,
 685                                               $opt{'svcnum'},
 686                                               'statustext' => $reason,
 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
1683   #this is not doing anything useful anymore
1684   #sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
1685   #so just sort alpha
1686   sort { lc($cdr_info{$a}->{'name'}) cmp lc($cdr_info{$b}->{'name'}) }
1687
1688   grep { exists($cdr_info{$_}->{'import_fields'}) }
1689   keys %cdr_info;
1690
1691 sub import_formats {
1692   %import_formats;
1693 }
1694
1695 sub _cdr_min_parser_maker {
1696   my $field = shift;
1697   my @fields = ref($field) ? @$field : ($field);
1698   @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
1699   return sub {
1700     my( $cdr, $min ) = @_;
1701     my $sec = eval { _cdr_min_parse($min) };
1702     die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
1703     $cdr->$_($sec) foreach @fields;
1704   };
1705 }
1706
1707 sub _cdr_min_parse {
1708   my $min = shift;
1709   sprintf('%.0f', $min * 60 );
1710 }
1711
1712 sub _cdr_date_parser_maker {
1713   my $field = shift;
1714   my %options = @_;
1715   my @fields = ref($field) ? @$field : ($field);
1716   return sub {
1717     my( $cdr, $datestring ) = @_;
1718     my $unixdate = eval { _cdr_date_parse($datestring, %options) };
1719     die "error parsing date for @fields from $datestring: $@\n" if $@;
1720     $cdr->$_($unixdate) foreach @fields;
1721   };
1722 }
1723
1724 sub _cdr_date_parse {
1725   my $date = shift;
1726   my %options = @_;
1727
1728   return '' unless length($date); #that's okay, it becomes NULL
1729   return '' if $date eq 'NA'; #sansay
1730
1731   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 ) {
1732     my $time = str2time($date);
1733     return $time if $time > 100000; #just in case
1734   }
1735
1736   my($year, $mon, $day, $hour, $min, $sec);
1737
1738   #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
1739   #taqua  #2007-10-31 08:57:24.113000000
1740
1741   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|$)/ ) {
1742     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1743   } 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|$)/ ) {
1744     # 8/26/2010 12:20:01
1745     # optionally without seconds
1746     ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1747     $sec = 0 if !defined($sec);
1748    } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\.\d+)$/ ) {
1749     # broadsoft: 20081223201938.314
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})\d+(\D|$)/ ) {
1752     # Taqua OM:  20050422203450943
1753     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1754   } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) {
1755     # WIP: 20100329121420
1756     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1757   } elsif ( $date =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z$/) {
1758     # Telos 2014-10-10T05:30:33Z
1759     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1760     $options{gmt} = 1;
1761   } elsif ( $date =~ /^(\d+):(\d+):(\d+)\.\d+ \w+ (\w+) (\d+) (\d+)$/ ) {
1762     ($hour, $min, $sec, $mon, $day, $year) = ( $1, $2, $3, $4, $5, $6 );
1763     $mon = { # Acme Packet: 15:54:56.868 PST DEC 18 2017
1764       # My best guess of month abbv they may use
1765       JAN => '01', FEB => '02', MAR => '03', APR => '04',
1766       MAY => '05', JUN => '06', JUL => '07', AUG => '08',
1767       SEP => '09', OCT => '10', NOV => '11', DEC => '12'
1768     }->{$mon};
1769   } else {
1770      die "unparsable date: $date"; #maybe we shouldn't die...
1771   }
1772
1773   return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
1774             && $hour == 0 && $min == 0 && $sec == 0;
1775
1776   if ($options{gmt}) {
1777     timegm($sec, $min, $hour, $day, $mon-1, $year);
1778   } else {
1779     timelocal($sec, $min, $hour, $day, $mon-1, $year);
1780   }
1781 }
1782
1783 =item batch_import HASHREF
1784
1785 Imports CDR records.  Available options are:
1786
1787 =over 4
1788
1789 =item file
1790
1791 Filename
1792
1793 =item format
1794
1795 =item params
1796
1797 Hash reference of preset fields, typically cdrbatch
1798
1799 =item empty_ok
1800
1801 Set true to prevent throwing an error on empty imports
1802
1803 =back
1804
1805 =cut
1806
1807 my %import_options = (
1808   'table'         => 'cdr',
1809
1810   'batch_keycol'  => 'cdrbatchnum',
1811   'batch_table'   => 'cdr_batch',
1812   'batch_namecol' => 'cdrbatch',
1813
1814   'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
1815                      keys %cdr_info
1816                },
1817
1818                           #drop the || 'csv' to allow auto xls for csv types?
1819   'format_types' => { map { $_ => lc($cdr_info{$_}->{'type'} || 'csv'); }
1820                           keys %cdr_info
1821                     },
1822
1823   'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
1824                             keys %cdr_info
1825                       },
1826
1827   'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
1828                               keys %cdr_info
1829                         },
1830
1831   'format_fixedlength_formats' =>
1832     { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
1833           keys %cdr_info
1834     },
1835
1836   'format_xml_formats' =>
1837     { map { $_ => $cdr_info{$_}->{'xml_format'}; }
1838           keys %cdr_info
1839     },
1840
1841   'format_asn_formats' =>
1842     { map { $_ => $cdr_info{$_}->{'asn_format'}; }
1843           keys %cdr_info
1844     },
1845
1846   'format_row_callbacks' =>
1847     { map { $_ => $cdr_info{$_}->{'row_callback'}; }
1848           keys %cdr_info
1849     },
1850
1851   'format_parser_opts' =>
1852     { map { $_ => $cdr_info{$_}->{'parser_opt'}; }
1853           keys %cdr_info
1854     },
1855 );
1856
1857 sub _import_options {
1858   \%import_options;
1859 }
1860
1861 sub batch_import {
1862   my $opt = shift;
1863
1864   my $iopt = _import_options;
1865   $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
1866
1867   if ( defined $opt->{'cdrtypenum'} ) {
1868         $opt->{'preinsert_callback'} = sub {
1869                 my($record,$param) = (shift,shift);
1870                 $record->cdrtypenum($opt->{'cdrtypenum'});
1871                 '';
1872         };
1873   }
1874
1875   FS::Record::batch_import( $opt );
1876
1877 }
1878
1879 =item process_batch_import
1880
1881 =cut
1882
1883 sub process_batch_import {
1884   my $job = shift;
1885
1886   my $opt = _import_options;
1887 #  $opt->{'params'} = [ 'format', 'cdrbatch' ];
1888
1889   FS::Record::process_batch_import( $job, $opt, @_ );
1890
1891 }
1892 #  if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
1893 #    @columns = map { s/^ +//; $_; } @columns;
1894 #  }
1895
1896 # _ upgrade_data
1897 #
1898 # Used by FS::Upgrade to migrate to a new database.
1899
1900 use FS::upgrade_journal;
1901 sub _upgrade_data {
1902   my ($class, %opts) = @_;
1903
1904   return if FS::upgrade_journal->is_done('cdr_cdrbatchnum');
1905
1906   warn "$me upgrading $class\n" if $DEBUG;
1907
1908   my $sth = dbh->prepare(
1909     'SELECT DISTINCT(cdrbatch) FROM cdr WHERE cdrbatch IS NOT NULL'
1910   ) or die dbh->errstr;
1911
1912   $sth->execute or die $sth->errstr;
1913
1914   my %cdrbatchnum = ();
1915   while (my $row = $sth->fetchrow_arrayref) {
1916
1917     my $cdr_batch = qsearchs( 'cdr_batch', { 'cdrbatch' => $row->[0] } );
1918     unless ( $cdr_batch ) {
1919       $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] };
1920       my $error = $cdr_batch->insert;
1921       die $error if $error;
1922     }
1923
1924     $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum;
1925   }
1926
1927   $sth = dbh->prepare('UPDATE cdr SET cdrbatch = NULL, cdrbatchnum = ? WHERE cdrbatch IS NOT NULL AND cdrbatch = ?') or die dbh->errstr;
1928
1929   foreach my $cdrbatch (keys %cdrbatchnum) {
1930     $sth->execute($cdrbatchnum{$cdrbatch}, $cdrbatch) or die $sth->errstr;
1931   }
1932
1933   FS::upgrade_journal->set_done('cdr_cdrbatchnum');
1934
1935 }
1936
1937 =item ip_addr_sql FIELD RANGE
1938
1939 Returns an SQL condition to search for CDRs with an IP address
1940 within RANGE.  FIELD is either 'src_ip_addr' or 'dst_ip_addr'.  RANGE
1941 should be in the form "a.b.c.d-e.f.g.h' (dotted quads), where any of
1942 the leftmost octets of the second address can be omitted if they're
1943 the same as the first address.
1944
1945 =cut
1946
1947 sub ip_addr_sql {
1948   my $class = shift;
1949   my ($field, $range) = @_;
1950   $range =~ /^[\d\.-]+$/ or die "bad ip address range '$range'";
1951   my @r = split('-', $range);
1952   my @saddr = split('\.', $r[0] || '');
1953   my @eaddr = split('\.', $r[1] || '');
1954   unshift @eaddr, (undef) x (4 - scalar @eaddr);
1955   for(0..3) {
1956     $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
1957   }
1958   "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
1959   "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
1960 }
1961
1962 =back
1963
1964 =head1 BUGS
1965
1966 =head1 SEE ALSO
1967
1968 L<FS::Record>, schema.html from the base documentation.
1969
1970 =cut
1971
1972 1;