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