FS/FS/cdr.pm

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