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