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