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   if ( $part_pkg->option_cacheable('skip_same_customer')
 648       and ! $self->is_tollfree ) {
 649     my ($dst_countrycode, $dst_number) = $self->parse_number(
 650       column => 'dst',
 651       international_prefix => $part_pkg->option_cacheable('international_prefix'),
 652       domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
 653     );
 654     my $dst_same_cust = FS::Record->scalar_sql(
 655         'SELECT COUNT(svc_phone.svcnum) AS count '.
 656         'FROM cust_pkg ' .
 657         'JOIN cust_svc   USING (pkgnum) ' .
 658         'JOIN svc_phone  USING (svcnum) ' .
 659         'WHERE svc_phone.countrycode = ' . dbh->quote($dst_countrycode) .
 660         ' AND svc_phone.phonenum = ' . dbh->quote($dst_number) .
 661         ' AND cust_pkg.custnum = ' . $cust_pkg->custnum,
 662     );
 663     if ( $dst_same_cust > 0 ) {
 664       warn "not charging for CDR (same source and destination customer)\n" if $DEBUG;
 665       return $self->set_status_and_rated_price( 'skipped',
 666                                                 0,
 667                                                 $opt{'svcnum'},
 668                                               );
 669     }
 670   }
 671
 672
 673
 674
 675   ###
 676   # look up rate details based on called station id
 677   # (or calling station id for toll free calls)
 678   ###
 679
 680   my( $to_or_from, $column );
 681   if ( $self->is_tollfree && ! $part_pkg->option_cacheable('disable_tollfree') )
 682   { #tollfree call
 683     $to_or_from = 'from';
 684     $column = 'src';
 685   } else { #regular call
 686     $to_or_from = 'to';
 687     $column = 'dst';
 688   }
 689
 690   #determine the country code
 691   my ($countrycode, $number) = $self->parse_number(
 692     column => $column,
 693     international_prefix => $part_pkg->option_cacheable('international_prefix'),
 694     domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
 695   );
 696
 697   warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG;
 698   my $pretty_dst = "+$countrycode $number";
 699   #asterisks here causes inserting the detail to barf, so:
 700   $pretty_dst =~ s/\*//g;
 701
 702   my $eff_ratenum = $self->is_tollfree('accountcode')
 703     ? $part_pkg->option_cacheable('accountcode_tollfree_ratenum')
 704     : '';
 705
 706   my $ratename = '';
 707   my $intrastate_ratenum = $part_pkg->option_cacheable('intrastate_ratenum');
 708   if ( $intrastate_ratenum && !$self->is_tollfree ) {
 709     $ratename = 'Interstate'; #until proven otherwise
 710     # this is relatively easy only because:
 711     # -assume all numbers are valid NANP numbers NOT in a fully-qualified format
 712     # -disregard toll-free
 713     # -disregard private or unknown numbers
 714     # -there is exactly one record in rate_prefix for a given NPANXX
 715     # -default to interstate if we can't find one or both of the prefixes
 716     my (undef, $dstprefix) = $self->parse_number(
 717       column => 'dst',
 718       international_prefix => $part_pkg->option_cacheable('international_prefix'),
 719       domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
 720     );
 721     $dstprefix =~ /^(\d{6})/;
 722     $dstprefix = qsearchs('rate_prefix', {   'countrycode' => '1',
 723                                                 'npa' => $1,
 724                                          }) || '';
 725     my (undef, $srcprefix) = $self->parse_number(
 726       column => 'src',
 727       international_prefix => $part_pkg->option_cacheable('international_prefix'),
 728       domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
 729     );
 730     $srcprefix =~ /^(\d{6})/;
 731     $srcprefix = qsearchs('rate_prefix', {   'countrycode' => '1',
 732                                              'npa' => $1,
 733                                          }) || '';
 734     if ($srcprefix && $dstprefix
 735         && $srcprefix->state && $dstprefix->state
 736         && $srcprefix->state eq $dstprefix->state) {
 737       $eff_ratenum = $intrastate_ratenum;
 738       $ratename = 'Intrastate'; # XXX possibly just use the ratename?
 739     }
 740   }
 741
 742   $eff_ratenum ||= $part_pkg->option_cacheable('ratenum');
 743   my $rate = qsearchs('rate', { 'ratenum' => $eff_ratenum })
 744     or die "ratenum $eff_ratenum not found!";
 745
 746   my @ltime = localtime($self->startdate);
 747   my $weektime = $ltime[0] +
 748                  $ltime[1]*60 +   #minutes
 749                  $ltime[2]*3600 + #hours
 750                  $ltime[6]*86400; #days since sunday
 751   # if there's no timed rate_detail for this time/region combination,
 752   # dest_detail returns the default.  There may still be a timed rate
 753   # that applies after the starttime of the call, so be careful...
 754   my $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
 755                                          'phonenum'    => $number,
 756                                          'weektime'    => $weektime,
 757                                          'cdrtypenum'  => $self->cdrtypenum,
 758                                       });
 759
 760   unless ( $rate_detail ) {
 761
 762     if ( $part_pkg->option_cacheable('ignore_unrateable') ) {
 763
 764       if ( $part_pkg->option_cacheable('ignore_unrateable') == 2 ) {
 765         # mark the CDR as unrateable
 766         return $self->set_status_and_rated_price(
 767           'failed',
 768           '',
 769           $opt{'svcnum'},
 770         );
 771       } elsif ( $part_pkg->option_cacheable('ignore_unrateable') == 1 ) {
 772         # warn and continue
 773         warn "no rate_detail found for CDR.acctid: ". $self->acctid.
 774              "; skipping\n";
 775         return '';
 776
 777       } else {
 778         die "unknown ignore_unrateable, pkgpart ". $part_pkg->pkgpart;
 779       }
 780
 781     } else {
 782
 783       die "FATAL: no rate_detail found in ".
 784           $rate->ratenum. ":". $rate->ratename. " rate plan ".
 785           "for +$countrycode $number (CDR acctid ". $self->acctid. "); ".
 786           "add a rate or set ignore_unrateable flag on the package def\n";
 787     }
 788
 789   }
 790
 791   my $rate_region = $rate_detail->dest_region;
 792   my $regionnum = $rate_region->regionnum;
 793   warn "  found rate for regionnum $regionnum ".
 794        "and rate detail $rate_detail\n"
 795     if $DEBUG;
 796
 797   if ( !exists($interval_cache{$regionnum}) ) {
 798     my @intervals = (
 799       sort { $a->stime <=> $b->stime }
 800         map { $_->rate_time->intervals }
 801           qsearch({ 'table'     => 'rate_detail',
 802                     'hashref'   => { 'ratenum' => $rate->ratenum },
 803                     'extra_sql' => 'AND ratetimenum IS NOT NULL',
 804                  })
 805     );
 806     $interval_cache{$regionnum} = \@intervals;
 807     warn "  cached ".scalar(@intervals)." interval(s)\n"
 808       if $DEBUG;
 809   }
 810
 811   ###
 812   # find the price and add detail to the invoice
 813   ###
 814
 815   # About this section:
 816   # We don't round _anything_ (except granularizing)
 817   # until the final $charge = sprintf("%.2f"...).
 818
 819   my $seconds_left = $part_pkg->option_cacheable('use_duration')
 820                        ? $self->duration
 821                        : $self->billsec;
 822
 823   #no, do this later so it respects (group) included minutes
 824   #  # charge for the first (conn_sec) seconds
 825   #  my $seconds = min($seconds_left, $rate_detail->conn_sec);
 826   #  $seconds_left -= $seconds;
 827   #  $weektime     += $seconds;
 828   #  my $charge = $rate_detail->conn_charge;
 829   my $seconds = 0;
 830   my $charge = 0;
 831   my $connection_charged = 0;
 832
 833   my $etime;
 834   while($seconds_left) {
 835     my $ratetimenum = $rate_detail->ratetimenum; # may be empty
 836
 837     # find the end of the current rate interval
 838     if(@{ $interval_cache{$regionnum} } == 0) {
 839       # There are no timed rates in this group, so just stay
 840       # in the default rate_detail for the entire duration.
 841       # Set an "end" of 1 past the end of the current call.
 842       $etime = $weektime + $seconds_left + 1;
 843     }
 844     elsif($ratetimenum) {
 845       # This is a timed rate, so go to the etime of this interval.
 846       # If it's followed by another timed rate, the stime of that
 847       # interval should match the etime of this one.
 848       my $interval = $rate_detail->rate_time->contains($weektime);
 849       $etime = $interval->etime;
 850     }
 851     else {
 852       # This is a default rate, so use the stime of the next
 853       # interval in the sequence.
 854       my $next_int = first { $_->stime > $weektime }
 855                       @{ $interval_cache{$regionnum} };
 856       if ($next_int) {
 857         $etime = $next_int->stime;
 858       }
 859       else {
 860         # weektime is near the end of the week, so decrement
 861         # it by a full week and use the stime of the first
 862         # interval.
 863         $weektime -= (3600*24*7);
 864         $etime = $interval_cache{$regionnum}->[0]->stime;
 865       }
 866     }
 867
 868     my $charge_sec = min($seconds_left, $etime - $weektime);
 869
 870     $seconds_left -= $charge_sec;
 871
 872     my $granularity = $rate_detail->sec_granularity;
 873
 874     my $minutes;
 875     if ( $granularity ) { # charge per minute
 876       # Round up to the nearest $granularity
 877       if ( $charge_sec and $charge_sec % $granularity ) {
 878         $charge_sec += $granularity - ($charge_sec % $granularity);
 879       }
 880       $minutes = $charge_sec / 60; #don't round this
 881     }
 882     else { # per call
 883       $minutes = 1;
 884       $seconds_left = 0;
 885     }
 886
 887     $seconds += $charge_sec;
 888
 889     if ( $rate_detail->min_included ) {
 890       # the old, kind of deprecated way to do this
 891       my $included_min = $opt{'region_group_included_min_hashref'} || {};
 892
 893       # by default, set the included minutes for this region/time to
 894       # what's in the rate_detail
 895       $included_min->{$regionnum}{$ratetimenum} = $rate_detail->min_included
 896         unless exists $included_min->{$regionnum}{$ratetimenum};
 897
 898       # the way that doesn't work
 899       #my $region_group = ($part_pkg->option_cacheable('min_included') || 0) > 0;
 900
 901       #${$opt{region_group_included_min}} -= $minutes
 902       #    if $region_group && $rate_detail->region_group;
 903
 904       if ( $included_min->{$regionnum}{$ratetimenum} > $minutes ) {
 905         $charge_sec = 0;
 906         $included_min->{$regionnum}{$ratetimenum} -= $minutes;
 907       } else {
 908         $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60);
 909         $included_min->{$regionnum}{$ratetimenum} = 0;
 910       }
 911     } else {
 912       # the new way!
 913       my $applied_min = $cust_pkg->apply_usage(
 914         'cdr'         => $self,
 915         'rate_detail' => $rate_detail,
 916         'minutes'     => $minutes
 917       );
 918       # for now, usage pools deal only in whole minutes
 919       $charge_sec -= $applied_min * 60;
 920     }
 921
 922     if ( $charge_sec > 0 ) {
 923
 924       #NOW do connection charges here... right?
 925       #my $conn_seconds = min($seconds_left, $rate_detail->conn_sec);
 926       my $conn_seconds = 0;
 927       unless ( $connection_charged++ ) { #only one connection charge
 928         $conn_seconds = min($charge_sec, $rate_detail->conn_sec);
 929         $seconds_left -= $conn_seconds;
 930         $weektime     += $conn_seconds;
 931         $charge += $rate_detail->conn_charge;
 932       }
 933
 934                            #should preserve (display?) this
 935       if ( $granularity == 0 ) { # per call rate
 936         $charge += $rate_detail->min_charge;
 937       } else {
 938         my $charge_min = ( $charge_sec - $conn_seconds ) / 60;
 939         $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
 940       }
 941
 942     }
 943
 944     # choose next rate_detail
 945     $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
 946                                         'phonenum'    => $number,
 947                                         'weektime'    => $etime,
 948                                         'cdrtypenum'  => $self->cdrtypenum })
 949             if($seconds_left);
 950     # we have now moved forward to $etime
 951     $weektime = $etime;
 952
 953   } #while $seconds_left
 954
 955   # this is why we need regionnum/rate_region....
 956   warn "  (rate region $rate_region)\n" if $DEBUG;
 957
 958   # NOW round it.
 959   my $rounding = $part_pkg->option_cacheable('rounding') || 2;
 960   my $sprintformat = '%.'. $rounding. 'f';
 961   my $roundup = 10**(-3-$rounding);
 962   my $price = sprintf($sprintformat, $charge + $roundup);
 963
 964   $self->set_status_and_rated_price(
 965     'rated',
 966     $price,
 967     $opt{'svcnum'},
 968     'rated_pretty_dst'    => $pretty_dst,
 969     'rated_regionname'    => $rate_region->regionname,
 970     'rated_seconds'       => $seconds,
 971     'rated_granularity'   => $rate_detail->sec_granularity, #$granularity
 972     'rated_ratedetailnum' => $rate_detail->ratedetailnum,
 973     'rated_classnum'      => $rate_detail->classnum, #rated_ratedetailnum?
 974     'rated_ratename'      => $ratename, #not rate_detail - Intrastate/Interstate
 975   );
 976
 977 }
 978
 979 sub rate_upstream_simple {
 980   my( $self, %opt ) = @_;
 981
 982   $self->set_status_and_rated_price(
 983     'rated',
 984     sprintf('%.3f', $self->upstream_price),
 985     $opt{'svcnum'},
 986     'rated_classnum' => $self->calltypenum,
 987   );
 988 }
 989
 990 sub rate_single_price {
 991   my( $self, %opt ) = @_;
 992   my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
 993
 994   # a little false laziness w/abov
 995   # $rate_detail = new FS::rate_detail({sec_granularity => ... }) ?
 996
 997   my $granularity = length($part_pkg->option_cacheable('sec_granularity'))
 998                       ? $part_pkg->option_cacheable('sec_granularity')
 999                       : 60;
1000
1001   my $seconds = $part_pkg->option_cacheable('use_duration')
1002                   ? $self->duration
1003                   : $self->billsec;
1004
1005   $seconds += $granularity - ( $seconds % $granularity )
1006     if $seconds      # don't granular-ize 0 billsec calls (bills them)
1007     && $granularity  # 0 is per call
1008     && $seconds % $granularity;
1009   my $minutes = $granularity ? ($seconds / 60) : 1;
1010
1011   my $charge_min = $minutes;
1012
1013   ${$opt{single_price_included_min}} -= $minutes;
1014   if ( ${$opt{single_price_included_min}} > 0 ) {
1015     $charge_min = 0;
1016   } else {
1017      $charge_min = 0 - ${$opt{single_price_included_min}};
1018      ${$opt{single_price_included_min}} = 0;
1019   }
1020
1021   my $charge =
1022     sprintf('%.4f', ( $part_pkg->option_cacheable('min_charge') * $charge_min )
1023                     + 0.0000000001 ); #so 1.00005 rounds to 1.0001
1024
1025   $self->set_status_and_rated_price(
1026     'rated',
1027     $charge,
1028     $opt{'svcnum'},
1029     'rated_granularity' => $granularity,
1030     'rated_seconds'     => $seconds,
1031   );
1032
1033 }
1034
1035 =item cdr_termination [ TERMPART ]
1036
1037 =cut
1038
1039 sub cdr_termination {
1040   my $self = shift;
1041
1042   if ( scalar(@_) && $_[0] ) {
1043     my $termpart = shift;
1044
1045     qsearchs('cdr_termination', { acctid   => $self->acctid,
1046                                   termpart => $termpart,
1047                                 }
1048             );
1049
1050   } else {
1051
1052     qsearch('cdr_termination', { acctid => $self->acctid, } );
1053
1054   }
1055
1056 }
1057
1058 =item calldate_unix
1059
1060 Parses the calldate in SQL string format and returns a UNIX timestamp.
1061
1062 =cut
1063
1064 sub calldate_unix {
1065   str2time(shift->calldate);
1066 }
1067
1068 =item startdate_sql
1069
1070 Parses the startdate in UNIX timestamp format and returns a string in SQL
1071 format.
1072
1073 =cut
1074
1075 sub startdate_sql {
1076   my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
1077   $mon++;
1078   $year += 1900;
1079   "$year-$mon-$mday $hour:$min:$sec";
1080 }
1081
1082 =item cdr_carrier
1083
1084 Returns the FS::cdr_carrier object associated with this CDR, or false if no
1085 carrierid is defined.
1086
1087 =cut
1088
1089 my %carrier_cache = ();
1090
1091 sub cdr_carrier {
1092   my $self = shift;
1093   return '' unless $self->carrierid;
1094   $carrier_cache{$self->carrierid} ||=
1095     qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
1096 }
1097
1098 =item carriername
1099
1100 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
1101 no FS::cdr_carrier object is assocated with this CDR.
1102
1103 =cut
1104
1105 sub carriername {
1106   my $self = shift;
1107   my $cdr_carrier = $self->cdr_carrier;
1108   $cdr_carrier ? $cdr_carrier->carriername : '';
1109 }
1110
1111 =item cdr_calltype
1112
1113 Returns the FS::cdr_calltype object associated with this CDR, or false if no
1114 calltypenum is defined.
1115
1116 =cut
1117
1118 my %calltype_cache = ();
1119
1120 sub cdr_calltype {
1121   my $self = shift;
1122   return '' unless $self->calltypenum;
1123   $calltype_cache{$self->calltypenum} ||=
1124     qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
1125 }
1126
1127 =item calltypename
1128
1129 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
1130 no FS::cdr_calltype object is assocated with this CDR.
1131
1132 =cut
1133
1134 sub calltypename {
1135   my $self = shift;
1136   my $cdr_calltype = $self->cdr_calltype;
1137   $cdr_calltype ? $cdr_calltype->calltypename : '';
1138 }
1139
1140 =item downstream_csv [ OPTION => VALUE, ... ]
1141
1142 =cut
1143
1144 my %export_names = (
1145   'simple'  => {
1146     'name'           => 'Simple',
1147     'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
1148   },
1149   'simple2' => {
1150     'name'           => 'Simple with source',
1151     'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
1152                        #"Date,Time,Name,Called From,Destination,Duration,Price",
1153   },
1154   'accountcode_simple' => {
1155     'name'           => 'Simple with accountcode',
1156     'invoice_header' => "Date,Time,Called From,Account,Duration,Price",
1157   },
1158   'basic' => {
1159     'name'           => 'Basic',
1160     'invoice_header' => "Date/Time,Called Number,Min/Sec,Price",
1161   },
1162   'default' => {
1163     'name'           => 'Default',
1164     'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
1165   },
1166   'source_default' => {
1167     'name'           => 'Default with source',
1168     'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1169   },
1170   'accountcode_default' => {
1171     'name'           => 'Default plus accountcode',
1172     'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
1173   },
1174   'description_default' => {
1175     'name'           => 'Default with description field as destination',
1176     'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1177   },
1178   'sum_duration' => {
1179     'name'           => 'Summary, one line per service',
1180     'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1181   },
1182   'sum_count' => {
1183     'name'           => 'Number of calls, one line per service',
1184     'invoice_header' => 'Caller,Rate,Messages,Price',
1185   },
1186   'sum_duration_prefix' => {
1187     'name'           => 'Summary, one line per destination prefix',
1188     'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1189   },
1190 );
1191
1192 my %export_formats = ();
1193 sub export_formats {
1194   #my $self = shift;
1195
1196   return %export_formats if keys %export_formats;
1197
1198   my $conf = new FS::Conf;
1199   my $date_format = $conf->config('date_format') || '%m/%d/%Y';
1200
1201   # call duration in the largest units that accurately reflect the  granularity
1202   my $duration_sub = sub {
1203     my($cdr, %opt) = @_;
1204     my $sec = $opt{seconds} || $cdr->billsec;
1205     if ( defined $opt{granularity} &&
1206          $opt{granularity} == 0 ) { #per call
1207       return '1 call';
1208     }
1209     elsif ( defined $opt{granularity} && $opt{granularity} == 60 ) {#full minutes
1210       my $min = int($sec/60);
1211       $min++ if $sec%60;
1212       return $min.'m';
1213     }
1214     else { #anything else
1215       return sprintf("%dm %ds", $sec/60, $sec%60);
1216     }
1217   };
1218
1219   my $price_sub = sub {
1220     my ($cdr, %opt) = @_;
1221     my $price;
1222     if ( defined($opt{charge}) ) {
1223       $price = $opt{charge};
1224     }
1225     elsif ( $opt{inbound} ) {
1226       my $term = $cdr->cdr_termination(1); # 1 = inbound
1227       $price = $term->rated_price if defined $term;
1228     }
1229     else {
1230       $price = $cdr->rated_price;
1231     }
1232     length($price) ? ($opt{money_char} . $price) : '';
1233   };
1234
1235   my $src_sub = sub { $_[0]->clid || $_[0]->src };
1236
1237   %export_formats = (
1238     'simple' => [
1239       sub { time2str($date_format, shift->calldate_unix ) },   #DATE
1240       sub { time2str('%r', shift->calldate_unix ) },   #TIME
1241       'userfield',                                     #USER
1242       'dst',                                           #NUMBER_DIALED
1243       $duration_sub,                                   #DURATION
1244       #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1245       $price_sub,
1246     ],
1247     'simple2' => [
1248       sub { time2str($date_format, shift->calldate_unix ) },   #DATE
1249       sub { time2str('%r', shift->calldate_unix ) },   #TIME
1250       #'userfield',                                     #USER
1251       $src_sub,                                           #called from
1252       'dst',                                           #NUMBER_DIALED
1253       $duration_sub,                                   #DURATION
1254       #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1255       $price_sub,
1256     ],
1257     'accountcode_simple' => [
1258       sub { time2str($date_format, shift->calldate_unix ) },   #DATE
1259       sub { time2str('%r', shift->calldate_unix ) },   #TIME
1260       $src_sub,                                           #called from
1261       'accountcode',                                   #NUMBER_DIALED
1262       $duration_sub,                                   #DURATION
1263       $price_sub,
1264     ],
1265     'sum_duration' => [
1266       # for summary formats, the CDR is a fictitious object containing the
1267       # total billsec and the phone number of the service
1268       $src_sub,
1269       sub { my($cdr, %opt) = @_; $opt{ratename} },
1270       sub { my($cdr, %opt) = @_; $opt{count} },
1271       sub { my($cdr, %opt) = @_; int($opt{seconds}/60).'m' },
1272       $price_sub,
1273     ],
1274     'sum_count' => [
1275       $src_sub,
1276       sub { my($cdr, %opt) = @_; $opt{ratename} },
1277       sub { my($cdr, %opt) = @_; $opt{count} },
1278       $price_sub,
1279     ],
1280     'basic' => [
1281       sub { time2str('%d %b - %I:%M %p', shift->calldate_unix) },
1282       'dst',
1283       $duration_sub,
1284       $price_sub,
1285     ],
1286     'default' => [
1287
1288       #DATE
1289       sub { time2str($date_format, shift->calldate_unix ) },
1290             # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
1291
1292       #TIME
1293       sub { time2str('%r', shift->calldate_unix ) },
1294             # 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
1295
1296       #DEST ("Number")
1297       sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
1298
1299       #REGIONNAME ("Destination")
1300       sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
1301
1302       #DURATION
1303       $duration_sub,
1304
1305       #PRICE
1306       $price_sub,
1307     ],
1308   );
1309   $export_formats{'source_default'} = [ $src_sub, @{ $export_formats{'default'} }, ];
1310   $export_formats{'accountcode_default'} =
1311     [ @{ $export_formats{'default'} }[0,1],
1312       'accountcode',
1313       @{ $export_formats{'default'} }[2..5],
1314     ];
1315   my @default = @{ $export_formats{'default'} };
1316   $export_formats{'description_default'} =
1317     [ $src_sub, @default[0..2],
1318       sub { my($cdr, %opt) = @_; $cdr->description },
1319       @default[4,5] ];
1320
1321   return %export_formats;
1322 }
1323
1324 =item downstream_csv OPTION => VALUE ...
1325
1326 Returns a string of formatted call details for display on an invoice.
1327
1328 Options:
1329
1330 format
1331
1332 charge - override the 'rated_price' field of the CDR
1333
1334 seconds - override the 'billsec' field of the CDR
1335
1336 count - number of usage events included in this record, for summary formats
1337
1338 ratename - name of the rate table used to rate this call
1339
1340 granularity
1341
1342 =cut
1343
1344 sub downstream_csv {
1345   my( $self, %opt ) = @_;
1346
1347   my $format = $opt{'format'};
1348   my %formats = $self->export_formats;
1349   return "Unknown format $format" unless exists $formats{$format};
1350
1351   #my $conf = new FS::Conf;
1352   #$opt{'money_char'} ||= $conf->config('money_char') || '$';
1353   $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
1354
1355   my $csv = new Text::CSV_XS;
1356
1357   my @columns =
1358     map {
1359           ref($_) ? &{$_}($self, %opt) : $self->$_();
1360         }
1361     @{ $formats{$format} };
1362
1363   return @columns if defined $opt{'keeparray'};
1364
1365   my $status = $csv->combine(@columns);
1366   die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
1367     unless $status;
1368
1369   $csv->string;
1370
1371 }
1372
1373 =back
1374
1375 =head1 CLASS METHODS
1376
1377 =over 4
1378
1379 =item invoice_formats
1380
1381 Returns an ordered list of key value pairs containing invoice format names
1382 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
1383
1384 =cut
1385
1386 # in the future, load this dynamically from detail_format classes
1387
1388 sub invoice_formats {
1389   map { ($_ => $export_names{$_}->{'name'}) }
1390     grep { $export_names{$_}->{'invoice_header'} }
1391     keys %export_names;
1392 }
1393
1394 =item invoice_header FORMAT
1395
1396 Returns a scalar containing the CSV column header for invoice format FORMAT.
1397
1398 =cut
1399
1400 sub invoice_header {
1401   my $format = shift;
1402   $export_names{$format}->{'invoice_header'};
1403 }
1404
1405 =item clear_status
1406
1407 Clears cdr and any associated cdr_termination statuses - used for
1408 CDR reprocessing.
1409
1410 =cut
1411
1412 sub clear_status {
1413   my $self = shift;
1414   my %opt = @_;
1415
1416   local $SIG{HUP} = 'IGNORE';
1417   local $SIG{INT} = 'IGNORE';
1418   local $SIG{QUIT} = 'IGNORE';
1419   local $SIG{TERM} = 'IGNORE';
1420   local $SIG{TSTP} = 'IGNORE';
1421   local $SIG{PIPE} = 'IGNORE';
1422
1423   my $oldAutoCommit = $FS::UID::AutoCommit;
1424   local $FS::UID::AutoCommit = 0;
1425   my $dbh = dbh;
1426
1427   if ( $cdr_prerate && $cdr_prerate_cdrtypenums{$self->cdrtypenum}
1428        && $self->rated_ratedetailnum #avoid putting old CDRs back in "rated"
1429        && $self->freesidestatus eq 'done'
1430        && ! $opt{'rerate'}
1431      )
1432   { #special case
1433     $self->freesidestatus('rated');
1434   } else {
1435     $self->freesidestatus('');
1436   }
1437
1438   my $error = $self->replace;
1439   if ( $error ) {
1440     $dbh->rollback if $oldAutoCommit;
1441     return $error;
1442   }
1443
1444   foreach my $cdr_termination ( $self->cdr_termination ) {
1445       #$cdr_termination->status('');
1446       #$error = $cdr_termination->replace;
1447       $error = $cdr_termination->delete;
1448       if ( $error ) {
1449         $dbh->rollback if $oldAutoCommit;
1450         return $error;
1451       }
1452   }
1453
1454   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1455
1456   '';
1457 }
1458
1459 =item import_formats
1460
1461 Returns an ordered list of key value pairs containing import format names
1462 as keys (for use with batch_import) and "pretty" format names as values.
1463
1464 =cut
1465
1466 #false laziness w/part_pkg & part_export
1467
1468 my %cdr_info;
1469 foreach my $INC ( @INC ) {
1470   warn "globbing $INC/FS/cdr/*.pm\n" if $DEBUG;
1471   foreach my $file ( glob("$INC/FS/cdr/*.pm") ) {
1472     warn "attempting to load CDR format info from $file\n" if $DEBUG;
1473     $file =~ /\/(\w+)\.pm$/ or do {
1474       warn "unrecognized file in $INC/FS/cdr/: $file\n";
1475       next;
1476     };
1477     my $mod = $1;
1478     my $info = eval "use FS::cdr::$mod; ".
1479                     "\\%FS::cdr::$mod\::info;";
1480     if ( $@ ) {
1481       die "error using FS::cdr::$mod (skipping): $@\n" if $@;
1482       next;
1483     }
1484     unless ( keys %$info ) {
1485       warn "no %info hash found in FS::cdr::$mod, skipping\n";
1486       next;
1487     }
1488     warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
1489     if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1490       warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
1491       next;
1492     }
1493     $cdr_info{$mod} = $info;
1494   }
1495 }
1496
1497 tie my %import_formats, 'Tie::IxHash',
1498   map  { $_ => $cdr_info{$_}->{'name'} }
1499   sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
1500   grep { exists($cdr_info{$_}->{'import_fields'}) }
1501   keys %cdr_info;
1502
1503 sub import_formats {
1504   %import_formats;
1505 }
1506
1507 sub _cdr_min_parser_maker {
1508   my $field = shift;
1509   my @fields = ref($field) ? @$field : ($field);
1510   @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
1511   return sub {
1512     my( $cdr, $min ) = @_;
1513     my $sec = eval { _cdr_min_parse($min) };
1514     die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
1515     $cdr->$_($sec) foreach @fields;
1516   };
1517 }
1518
1519 sub _cdr_min_parse {
1520   my $min = shift;
1521   sprintf('%.0f', $min * 60 );
1522 }
1523
1524 sub _cdr_date_parser_maker {
1525   my $field = shift;
1526   my %options = @_;
1527   my @fields = ref($field) ? @$field : ($field);
1528   return sub {
1529     my( $cdr, $datestring ) = @_;
1530     my $unixdate = eval { _cdr_date_parse($datestring, %options) };
1531     die "error parsing date for @fields from $datestring: $@\n" if $@;
1532     $cdr->$_($unixdate) foreach @fields;
1533   };
1534 }
1535
1536 sub _cdr_date_parse {
1537   my $date = shift;
1538   my %options = @_;
1539
1540   return '' unless length($date); #that's okay, it becomes NULL
1541   return '' if $date eq 'NA'; #sansay
1542
1543   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 ) {
1544     my $time = str2time($date);
1545     return $time if $time > 100000; #just in case
1546   }
1547
1548   my($year, $mon, $day, $hour, $min, $sec);
1549
1550   #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
1551   #taqua  #2007-10-31 08:57:24.113000000
1552
1553   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|$)/ ) {
1554     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1555   } 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|$)/ ) {
1556     # 8/26/2010 12:20:01
1557     # optionally without seconds
1558     ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1559     $sec = 0 if !defined($sec);
1560   } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d+\.\d+)(\D|$)/ ) {
1561     # broadsoft: 20081223201938.314
1562     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1563   } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\d+(\D|$)/ ) {
1564     # Taqua OM:  20050422203450943
1565     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1566   } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) {
1567     # WIP: 20100329121420
1568     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1569   } elsif ( $date =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z$/) {
1570     # Telos
1571     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1572     $options{gmt} = 1;
1573   } else {
1574      die "unparsable date: $date"; #maybe we shouldn't die...
1575   }
1576
1577   return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
1578             && $hour == 0 && $min == 0 && $sec == 0;
1579
1580   if ($options{gmt}) {
1581     timegm($sec, $min, $hour, $day, $mon-1, $year);
1582   } else {
1583     timelocal($sec, $min, $hour, $day, $mon-1, $year);
1584   }
1585 }
1586
1587 =item batch_import HASHREF
1588
1589 Imports CDR records.  Available options are:
1590
1591 =over 4
1592
1593 =item file
1594
1595 Filename
1596
1597 =item format
1598
1599 =item params
1600
1601 Hash reference of preset fields, typically cdrbatch
1602
1603 =item empty_ok
1604
1605 Set true to prevent throwing an error on empty imports
1606
1607 =back
1608
1609 =cut
1610
1611 my %import_options = (
1612   'table'         => 'cdr',
1613
1614   'batch_keycol'  => 'cdrbatchnum',
1615   'batch_table'   => 'cdr_batch',
1616   'batch_namecol' => 'cdrbatch',
1617
1618   'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
1619                      keys %cdr_info
1620                },
1621
1622                           #drop the || 'csv' to allow auto xls for csv types?
1623   'format_types' => { map { $_ => lc($cdr_info{$_}->{'type'} || 'csv'); }
1624                           keys %cdr_info
1625                     },
1626
1627   'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
1628                             keys %cdr_info
1629                       },
1630
1631   'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
1632                               keys %cdr_info
1633                         },
1634
1635   'format_fixedlength_formats' =>
1636     { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
1637           keys %cdr_info
1638     },
1639
1640   'format_xml_formats' =>
1641     { map { $_ => $cdr_info{$_}->{'xml_format'}; }
1642           keys %cdr_info
1643     },
1644
1645   'format_asn_formats' =>
1646     { map { $_ => $cdr_info{$_}->{'asn_format'}; }
1647           keys %cdr_info
1648     },
1649
1650   'format_row_callbacks' => { map { $_ => $cdr_info{$_}->{'row_callback'}; }
1651                                   keys %cdr_info
1652                             },
1653 );
1654
1655 sub _import_options {
1656   \%import_options;
1657 }
1658
1659 sub batch_import {
1660   my $opt = shift;
1661
1662   my $iopt = _import_options;
1663   $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
1664
1665   if ( defined $opt->{'cdrtypenum'} ) {
1666         $opt->{'preinsert_callback'} = sub {
1667                 my($record,$param) = (shift,shift);
1668                 $record->cdrtypenum($opt->{'cdrtypenum'});
1669                 '';
1670         };
1671   }
1672
1673   FS::Record::batch_import( $opt );
1674
1675 }
1676
1677 =item process_batch_import
1678
1679 =cut
1680
1681 sub process_batch_import {
1682   my $job = shift;
1683
1684   my $opt = _import_options;
1685 #  $opt->{'params'} = [ 'format', 'cdrbatch' ];
1686
1687   FS::Record::process_batch_import( $job, $opt, @_ );
1688
1689 }
1690 #  if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
1691 #    @columns = map { s/^ +//; $_; } @columns;
1692 #  }
1693
1694 # _ upgrade_data
1695 #
1696 # Used by FS::Upgrade to migrate to a new database.
1697
1698 sub _upgrade_data {
1699   my ($class, %opts) = @_;
1700
1701   warn "$me upgrading $class\n" if $DEBUG;
1702
1703   my $sth = dbh->prepare(
1704     'SELECT DISTINCT(cdrbatch) FROM cdr WHERE cdrbatch IS NOT NULL'
1705   ) or die dbh->errstr;
1706
1707   $sth->execute or die $sth->errstr;
1708
1709   my %cdrbatchnum = ();
1710   while (my $row = $sth->fetchrow_arrayref) {
1711
1712     my $cdr_batch = qsearchs( 'cdr_batch', { 'cdrbatch' => $row->[0] } );
1713     unless ( $cdr_batch ) {
1714       $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] };
1715       my $error = $cdr_batch->insert;
1716       die $error if $error;
1717     }
1718
1719     $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum;
1720   }
1721
1722   $sth = dbh->prepare('UPDATE cdr SET cdrbatch = NULL, cdrbatchnum = ? WHERE cdrbatch IS NOT NULL AND cdrbatch = ?') or die dbh->errstr;
1723
1724   foreach my $cdrbatch (keys %cdrbatchnum) {
1725     $sth->execute($cdrbatchnum{$cdrbatch}, $cdrbatch) or die $sth->errstr;
1726   }
1727
1728 }
1729
1730 =item ip_addr_sql FIELD RANGE
1731
1732 Returns an SQL condition to search for CDRs with an IP address
1733 within RANGE.  FIELD is either 'src_ip_addr' or 'dst_ip_addr'.  RANGE
1734 should be in the form "a.b.c.d-e.f.g.h' (dotted quads), where any of
1735 the leftmost octets of the second address can be omitted if they're
1736 the same as the first address.
1737
1738 =cut
1739
1740 sub ip_addr_sql {
1741   my $class = shift;
1742   my ($field, $range) = @_;
1743   $range =~ /^[\d\.-]+$/ or die "bad ip address range '$range'";
1744   my @r = split('-', $range);
1745   my @saddr = split('\.', $r[0] || '');
1746   my @eaddr = split('\.', $r[1] || '');
1747   unshift @eaddr, (undef) x (4 - scalar @eaddr);
1748   for(0..3) {
1749     $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
1750   }
1751   "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
1752   "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
1753 }
1754
1755 =back
1756
1757 =head1 BUGS
1758
1759 =head1 SEE ALSO
1760
1761 L<FS::Record>, schema.html from the base documentation.
1762
1763 =cut
1764
1765 1;
1766