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