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