cd1416533e509b2f8b56b898d6f4fc23b45afccc
[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/ ) ? 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 $rate_region = $rate_detail->dest_region;
803   my $regionnum = $rate_region->regionnum;
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   my $etime;
846   while($seconds_left) {
847     my $ratetimenum = $rate_detail->ratetimenum; # may be empty
848
849     # find the end of the current rate interval
850     if(@{ $interval_cache{$regionnum} } == 0) {
851       # There are no timed rates in this group, so just stay 
852       # in the default rate_detail for the entire duration.
853       # Set an "end" of 1 past the end of the current call.
854       $etime = $weektime + $seconds_left + 1;
855     } 
856     elsif($ratetimenum) {
857       # This is a timed rate, so go to the etime of this interval.
858       # If it's followed by another timed rate, the stime of that 
859       # interval should match the etime of this one.
860       my $interval = $rate_detail->rate_time->contains($weektime);
861       $etime = $interval->etime;
862     }
863     else {
864       # This is a default rate, so use the stime of the next 
865       # interval in the sequence.
866       my $next_int = first { $_->stime > $weektime } 
867                       @{ $interval_cache{$regionnum} };
868       if ($next_int) {
869         $etime = $next_int->stime;
870       }
871       else {
872         # weektime is near the end of the week, so decrement 
873         # it by a full week and use the stime of the first 
874         # interval.
875         $weektime -= (3600*24*7);
876         $etime = $interval_cache{$regionnum}->[0]->stime;
877       }
878     }
879
880     my $charge_sec = min($seconds_left, $etime - $weektime);
881
882     $seconds_left -= $charge_sec;
883
884     my $granularity = $rate_detail->sec_granularity;
885
886     my $minutes;
887     if ( $granularity ) { # charge per minute
888       # Round up to the nearest $granularity
889       if ( $charge_sec and $charge_sec % $granularity ) {
890         $charge_sec += $granularity - ($charge_sec % $granularity);
891       }
892       $minutes = $charge_sec / 60; #don't round this
893     }
894     else { # per call
895       $minutes = 1;
896       $seconds_left = 0;
897     }
898
899     #$seconds += $charge_sec;
900
901     if ( $rate_detail->min_included ) {
902       # the old, kind of deprecated way to do this:
903       # 
904       # The rate detail itself has included minutes.  We MUST have a place
905       # to track them.
906       my $included_min = $opt{'detail_included_min_hashref'}
907         or return "unable to rate CDR: rate detail has included minutes, but ".
908                   "no detail_included_min_hashref provided.\n";
909
910       # by default, set the included minutes for this region/time to
911       # what's in the rate_detail
912       $included_min->{$regionnum}{$ratetimenum} = $rate_detail->min_included
913         unless exists $included_min->{$regionnum}{$ratetimenum};
914
915       if ( $included_min->{$regionnum}{$ratetimenum} >= $minutes ) {
916         $charge_sec = 0;
917         $included_min->{$regionnum}{$ratetimenum} -= $minutes;
918       } else {
919         $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60);
920         $included_min->{$regionnum}{$ratetimenum} = 0;
921       }
922     } elsif ( $opt{plan_included_min} && ${ $opt{plan_included_min} } > 0 ) {
923       # The package definition has included minutes, but only for in-group
924       # rate details.  Decrement them if this is an in-group call.
925       if ( $rate_detail->region_group ) {
926         if ( ${ $opt{'plan_included_min'} } >= $minutes ) {
927           $charge_sec = 0;
928           ${ $opt{'plan_included_min'} } -= $minutes;
929         } else {
930           $charge_sec -= (${ $opt{'plan_included_min'} } * 60);
931           ${ $opt{'plan_included_min'} } = 0;
932         }
933       }
934     } else {
935       # the new way!
936       my $applied_min = $cust_pkg->apply_usage(
937         'cdr'         => $self,
938         'rate_detail' => $rate_detail,
939         'minutes'     => $minutes
940       );
941       # for now, usage pools deal only in whole minutes
942       $charge_sec -= $applied_min * 60;
943     }
944
945     if ( $charge_sec > 0 ) {
946
947       #NOW do connection charges here... right?
948       #my $conn_seconds = min($seconds_left, $rate_detail->conn_sec);
949       my $conn_seconds = 0;
950       unless ( $connection_charged++ ) { #only one connection charge
951         $conn_seconds = min($charge_sec, $rate_detail->conn_sec);
952         $seconds_left -= $conn_seconds; 
953         $weektime     += $conn_seconds;
954         $charge += $rate_detail->conn_charge; 
955       }
956
957                            #should preserve (display?) this
958       if ( $granularity == 0 ) { # per call rate
959         $charge += $rate_detail->min_charge;
960       } else {
961         my $charge_min = ( $charge_sec - $conn_seconds ) / 60;
962         $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
963       }
964
965     }
966
967     # choose next rate_detail
968     $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
969                                         'phonenum'    => $number,
970                                         'weektime'    => $etime,
971                                         'cdrtypenum'  => $self->cdrtypenum })
972             if($seconds_left);
973     # we have now moved forward to $etime
974     $weektime = $etime;
975
976   } #while $seconds_left
977
978   # this is why we need regionnum/rate_region....
979   warn "  (rate region $rate_region)\n" if $DEBUG;
980
981   # NOW round it.
982   my $rounding = $part_pkg->option_cacheable('rounding') || 2;
983   my $sprintformat = '%.'. $rounding. 'f';
984   my $roundup = 10**(-3-$rounding);
985   my $price = sprintf($sprintformat, $charge + $roundup);
986
987   $self->set_status_and_rated_price(
988     'rated',
989     $price,
990     $opt{'svcnum'},
991     'rated_pretty_dst'    => $pretty_dst,
992     'rated_regionname'    => $rate_region->regionname,
993     'rated_seconds'       => $rated_seconds, #$seconds,
994     'rated_granularity'   => $rate_detail->sec_granularity, #$granularity
995     'rated_ratedetailnum' => $rate_detail->ratedetailnum,
996     'rated_classnum'      => $rate_detail->classnum, #rated_ratedetailnum?
997     'rated_ratename'      => $ratename, #not rate_detail - Intrastate/Interstate
998   );
999
1000 }
1001
1002 sub rate_upstream_simple {
1003   my( $self, %opt ) = @_;
1004
1005   $self->set_status_and_rated_price(
1006     'rated',
1007     sprintf('%.3f', $self->upstream_price),
1008     $opt{'svcnum'},
1009     'rated_classnum' => $self->calltypenum,
1010     'rated_seconds'  => $self->billsec,
1011     # others? upstream_*_regionname => rated_regionname is possible
1012   );
1013 }
1014
1015 sub rate_single_price {
1016   my( $self, %opt ) = @_;
1017   my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
1018
1019   # a little false laziness w/abov
1020   # $rate_detail = new FS::rate_detail({sec_granularity => ... }) ?
1021
1022   my $granularity = length($part_pkg->option_cacheable('sec_granularity'))
1023                       ? $part_pkg->option_cacheable('sec_granularity')
1024                       : 60;
1025
1026   my $seconds = $part_pkg->option_cacheable('use_duration')
1027                   ? $self->duration
1028                   : $self->billsec;
1029
1030   $seconds += $granularity - ( $seconds % $granularity )
1031     if $seconds      # don't granular-ize 0 billsec calls (bills them)
1032     && $granularity  # 0 is per call
1033     && $seconds % $granularity;
1034   my $minutes = $granularity ? ($seconds / 60) : 1;
1035
1036   my $charge_min = $minutes;
1037
1038   ${$opt{plan_included_min}} -= $minutes;
1039   if ( ${$opt{plan_included_min}} > 0 ) {
1040     $charge_min = 0;
1041   } else {
1042      $charge_min = 0 - ${$opt{plan_included_min}};
1043      ${$opt{plan_included_min}} = 0;
1044   }
1045
1046   my $charge =
1047     sprintf('%.4f', ( $part_pkg->option_cacheable('min_charge') * $charge_min )
1048                     + 0.0000000001 ); #so 1.00005 rounds to 1.0001
1049
1050   $self->set_status_and_rated_price(
1051     'rated',
1052     $charge,
1053     $opt{'svcnum'},
1054     'rated_granularity' => $granularity,
1055     'rated_seconds'     => $seconds,
1056   );
1057
1058 }
1059
1060 =item rate_cost
1061
1062 Rates an already-rated CDR according to the cost fields from the rate plan.
1063
1064 Returns the amount.
1065
1066 =cut
1067
1068 sub rate_cost {
1069   my $self = shift;
1070
1071   return 0 unless $self->rated_ratedetailnum;
1072
1073   my $rate_detail =
1074     qsearchs('rate_detail', { 'ratedetailnum' => $self->rated_ratedetailnum } );
1075
1076   return $rate_detail->min_cost if $self->rated_granularity == 0;
1077
1078   my $minutes = $self->rated_seconds / 60;
1079   my $charge = $rate_detail->conn_cost + $minutes * $rate_detail->min_cost;
1080
1081   sprintf('%.2f', $charge + .00001 );
1082
1083 }
1084
1085 =item cdr_termination [ TERMPART ]
1086
1087 =cut
1088
1089 sub cdr_termination {
1090   my $self = shift;
1091
1092   if ( scalar(@_) && $_[0] ) {
1093     my $termpart = shift;
1094
1095     qsearchs('cdr_termination', { acctid   => $self->acctid,
1096                                   termpart => $termpart,
1097                                 }
1098             );
1099
1100   } else {
1101
1102     qsearch('cdr_termination', { acctid => $self->acctid, } );
1103
1104   }
1105
1106 }
1107
1108 =item calldate_unix 
1109
1110 Parses the calldate in SQL string format and returns a UNIX timestamp.
1111
1112 =cut
1113
1114 sub calldate_unix {
1115   str2time(shift->calldate);
1116 }
1117
1118 =item startdate_sql
1119
1120 Parses the startdate in UNIX timestamp format and returns a string in SQL
1121 format.
1122
1123 =cut
1124
1125 sub startdate_sql {
1126   my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
1127   $mon++;
1128   $year += 1900;
1129   "$year-$mon-$mday $hour:$min:$sec";
1130 }
1131
1132 =item cdr_carrier
1133
1134 Returns the FS::cdr_carrier object associated with this CDR, or false if no
1135 carrierid is defined.
1136
1137 =cut
1138
1139 my %carrier_cache = ();
1140
1141 sub cdr_carrier {
1142   my $self = shift;
1143   return '' unless $self->carrierid;
1144   $carrier_cache{$self->carrierid} ||=
1145     qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
1146 }
1147
1148 =item carriername 
1149
1150 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
1151 no FS::cdr_carrier object is assocated with this CDR.
1152
1153 =cut
1154
1155 sub carriername {
1156   my $self = shift;
1157   my $cdr_carrier = $self->cdr_carrier;
1158   $cdr_carrier ? $cdr_carrier->carriername : '';
1159 }
1160
1161 =item cdr_calltype
1162
1163 Returns the FS::cdr_calltype object associated with this CDR, or false if no
1164 calltypenum is defined.
1165
1166 =cut
1167
1168 my %calltype_cache = ();
1169
1170 sub cdr_calltype {
1171   my $self = shift;
1172   return '' unless $self->calltypenum;
1173   $calltype_cache{$self->calltypenum} ||=
1174     qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
1175 }
1176
1177 =item calltypename 
1178
1179 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
1180 no FS::cdr_calltype object is assocated with this CDR.
1181
1182 =cut
1183
1184 sub calltypename {
1185   my $self = shift;
1186   my $cdr_calltype = $self->cdr_calltype;
1187   $cdr_calltype ? $cdr_calltype->calltypename : '';
1188 }
1189
1190 =item downstream_csv [ OPTION => VALUE, ... ]
1191
1192 =cut
1193
1194 # in the future, load this dynamically from detail_format classes
1195
1196 my %export_names = (
1197   'simple'  => {
1198     'name'           => 'Simple',
1199     'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
1200   },
1201   'simple2' => {
1202     'name'           => 'Simple with source',
1203     'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
1204                        #"Date,Time,Name,Called From,Destination,Duration,Price",
1205   },
1206   'accountcode_simple' => {
1207     'name'           => 'Simple with accountcode',
1208     'invoice_header' => "Date,Time,Called From,Account,Duration,Price",
1209   },
1210   'basic' => {
1211     'name'           => 'Basic',
1212     'invoice_header' => "Date/Time,Called Number,Min/Sec,Price",
1213   },
1214   'basic_upstream_dst_regionname' => {
1215     'name'           => 'Basic with upstream destination name',
1216     'invoice_header' => "Date/Time,Called Number,Destination,Min/Sec,Price",
1217   },
1218   'default' => {
1219     'name'           => 'Default',
1220     'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
1221   },
1222   'source_default' => {
1223     'name'           => 'Default with source',
1224     'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1225   },
1226   'accountcode_default' => {
1227     'name'           => 'Default plus accountcode',
1228     'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
1229   },
1230   'description_default' => {
1231     'name'           => 'Default with description field as destination',
1232     'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1233   },
1234   'sum_duration' => {
1235     'name'           => 'Summary, one line per service',
1236     'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1237   },
1238   'sum_count' => {
1239     'name'           => 'Number of calls, one line per service',
1240     'invoice_header' => 'Caller,Rate,Messages,Price',
1241   },
1242   'sum_duration_prefix' => {
1243     'name'           => 'Summary, one line per destination prefix',
1244     'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1245   },
1246   'sum_count_class' => {
1247     'name'           => 'Summary, one line per usage class',
1248     'invoice_header' => 'Caller,Class,Calls,Price',
1249   },
1250 );
1251
1252 my %export_formats = ();
1253 sub export_formats {
1254   #my $self = shift;
1255
1256   return %export_formats if keys %export_formats;
1257
1258   my $conf = new FS::Conf;
1259   my $date_format = $conf->config('date_format') || '%m/%d/%Y';
1260
1261   # call duration in the largest units that accurately reflect the granularity
1262   my $duration_sub = sub {
1263     my($cdr, %opt) = @_;
1264     my $sec = $opt{seconds} || $cdr->billsec;
1265     if ( defined $opt{granularity} && 
1266          $opt{granularity} == 0 ) { #per call
1267       return '1 call';
1268     }
1269     elsif ( defined $opt{granularity} && $opt{granularity} == 60 ) {#full minutes
1270       my $min = int($sec/60);
1271       $min++ if $sec%60;
1272       return $min.'m';
1273     }
1274     else { #anything else
1275       return sprintf("%dm %ds", $sec/60, $sec%60);
1276     }
1277   };
1278
1279   my $price_sub = sub {
1280     my ($cdr, %opt) = @_;
1281     my $price;
1282     if ( defined($opt{charge}) ) {
1283       $price = $opt{charge};
1284     }
1285     elsif ( $opt{inbound} ) {
1286       my $term = $cdr->cdr_termination(1); # 1 = inbound
1287       $price = $term->rated_price if defined $term;
1288     }
1289     else {
1290       $price = $cdr->rated_price;
1291     }
1292     length($price) ? ($opt{money_char} . $price) : '';
1293   };
1294
1295   my $src_sub = sub { $_[0]->clid || $_[0]->src };
1296
1297   %export_formats = (
1298     'simple' => [
1299       sub { time2str($date_format, shift->calldate_unix ) },   #DATE
1300       sub { time2str('%r', shift->calldate_unix ) },   #TIME
1301       'userfield',                                     #USER
1302       'dst',                                           #NUMBER_DIALED
1303       $duration_sub,                                   #DURATION
1304       #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1305       $price_sub,
1306     ],
1307     'simple2' => [
1308       sub { time2str($date_format, shift->calldate_unix ) },   #DATE
1309       sub { time2str('%r', shift->calldate_unix ) },   #TIME
1310       #'userfield',                                     #USER
1311       $src_sub,                                           #called from
1312       'dst',                                           #NUMBER_DIALED
1313       $duration_sub,                                   #DURATION
1314       #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1315       $price_sub,
1316     ],
1317     'accountcode_simple' => [
1318       sub { time2str($date_format, shift->calldate_unix ) },   #DATE
1319       sub { time2str('%r', shift->calldate_unix ) },   #TIME
1320       $src_sub,                                           #called from
1321       'accountcode',                                   #NUMBER_DIALED
1322       $duration_sub,                                   #DURATION
1323       $price_sub,
1324     ],
1325     'sum_duration' => [ 
1326       # for summary formats, the CDR is a fictitious object containing the 
1327       # total billsec and the phone number of the service
1328       $src_sub,
1329       sub { my($cdr, %opt) = @_; $opt{ratename} },
1330       sub { my($cdr, %opt) = @_; $opt{count} },
1331       sub { my($cdr, %opt) = @_; int($opt{seconds}/60).'m' },
1332       $price_sub,
1333     ],
1334     'sum_count' => [
1335       $src_sub,
1336       sub { my($cdr, %opt) = @_; $opt{ratename} },
1337       sub { my($cdr, %opt) = @_; $opt{count} },
1338       $price_sub,
1339     ],
1340     'basic' => [
1341       sub { time2str('%d %b - %I:%M %p', shift->calldate_unix) },
1342       'dst',
1343       $duration_sub,
1344       $price_sub,
1345     ],
1346     'default' => [
1347
1348       #DATE
1349       sub { time2str($date_format, shift->calldate_unix ) },
1350             # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
1351
1352       #TIME
1353       sub { time2str('%r', shift->calldate_unix ) },
1354             # 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
1355
1356       #DEST ("Number")
1357       sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
1358
1359       #REGIONNAME ("Destination")
1360       sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
1361
1362       #DURATION
1363       $duration_sub,
1364
1365       #PRICE
1366       $price_sub,
1367     ],
1368   );
1369   $export_formats{'source_default'} = [ $src_sub, @{ $export_formats{'default'} }, ];
1370   $export_formats{'accountcode_default'} =
1371     [ @{ $export_formats{'default'} }[0,1],
1372       'accountcode',
1373       @{ $export_formats{'default'} }[2..5],
1374     ];
1375   my @default = @{ $export_formats{'default'} };
1376   $export_formats{'description_default'} = 
1377     [ $src_sub, @default[0..2], 
1378       sub { my($cdr, %opt) = @_; $cdr->description },
1379       @default[4,5] ];
1380
1381   return %export_formats;
1382 }
1383
1384 =item downstream_csv OPTION => VALUE ...
1385
1386 Returns a string of formatted call details for display on an invoice.
1387
1388 Options:
1389
1390 format
1391
1392 charge - override the 'rated_price' field of the CDR
1393
1394 seconds - override the 'billsec' field of the CDR
1395
1396 count - number of usage events included in this record, for summary formats
1397
1398 ratename - name of the rate table used to rate this call
1399
1400 granularity
1401
1402 =cut
1403
1404 sub downstream_csv {
1405   my( $self, %opt ) = @_;
1406
1407   my $format = $opt{'format'};
1408   my %formats = $self->export_formats;
1409   return "Unknown format $format" unless exists $formats{$format};
1410
1411   #my $conf = new FS::Conf;
1412   #$opt{'money_char'} ||= $conf->config('money_char') || '$';
1413   $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
1414
1415   my $csv = new Text::CSV_XS;
1416
1417   my @columns =
1418     map {
1419           ref($_) ? &{$_}($self, %opt) : $self->$_();
1420         }
1421     @{ $formats{$format} };
1422
1423   return @columns if defined $opt{'keeparray'};
1424
1425   my $status = $csv->combine(@columns);
1426   die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
1427     unless $status;
1428
1429   $csv->string;
1430
1431 }
1432
1433 =back
1434
1435 =head1 CLASS METHODS
1436
1437 =over 4
1438
1439 =item invoice_formats
1440
1441 Returns an ordered list of key value pairs containing invoice format names
1442 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
1443
1444 =cut
1445
1446 # in the future, load this dynamically from detail_format classes
1447
1448 sub invoice_formats {
1449   map { ($_ => $export_names{$_}->{'name'}) }
1450     grep { $export_names{$_}->{'invoice_header'} }
1451     keys %export_names;
1452 }
1453
1454 =item invoice_header FORMAT
1455
1456 Returns a scalar containing the CSV column header for invoice format FORMAT.
1457
1458 =cut
1459
1460 sub invoice_header {
1461   my $format = shift;
1462   $export_names{$format}->{'invoice_header'};
1463 }
1464
1465 =item clear_status 
1466
1467 Clears cdr and any associated cdr_termination statuses - used for 
1468 CDR reprocessing.
1469
1470 =cut
1471
1472 sub clear_status {
1473   my $self = shift;
1474   my %opt = @_;
1475
1476   local $SIG{HUP} = 'IGNORE';
1477   local $SIG{INT} = 'IGNORE';
1478   local $SIG{QUIT} = 'IGNORE';
1479   local $SIG{TERM} = 'IGNORE';
1480   local $SIG{TSTP} = 'IGNORE';
1481   local $SIG{PIPE} = 'IGNORE';
1482
1483   my $oldAutoCommit = $FS::UID::AutoCommit;
1484   local $FS::UID::AutoCommit = 0;
1485   my $dbh = dbh;
1486
1487   if ( $cdr_prerate && $cdr_prerate_cdrtypenums{$self->cdrtypenum}
1488        && $self->rated_ratedetailnum #avoid putting old CDRs back in "rated"
1489        && $self->freesidestatus eq 'done'
1490        && ! $opt{'rerate'}
1491      )
1492   { #special case
1493     $self->freesidestatus('rated');
1494   } else {
1495     $self->freesidestatus('');
1496   }
1497
1498   my $error = $self->replace;
1499   if ( $error ) {
1500     $dbh->rollback if $oldAutoCommit;
1501     return $error;
1502   } 
1503
1504   foreach my $cdr_termination ( $self->cdr_termination ) {
1505       #$cdr_termination->status('');
1506       #$error = $cdr_termination->replace;
1507       $error = $cdr_termination->delete;
1508       if ( $error ) {
1509         $dbh->rollback if $oldAutoCommit;
1510         return $error;
1511       } 
1512   }
1513   
1514   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1515
1516   '';
1517 }
1518
1519 =item import_formats
1520
1521 Returns an ordered list of key value pairs containing import format names
1522 as keys (for use with batch_import) and "pretty" format names as values.
1523
1524 =cut
1525
1526 #false laziness w/part_pkg & part_export
1527
1528 my %cdr_info;
1529 foreach my $INC ( @INC ) {
1530   warn "globbing $INC/FS/cdr/[a-z]*.pm\n" if $DEBUG;
1531   foreach my $file ( glob("$INC/FS/cdr/[a-z]*.pm") ) {
1532     warn "attempting to load CDR format info from $file\n" if $DEBUG;
1533     $file =~ /\/(\w+)\.pm$/ or do {
1534       warn "unrecognized file in $INC/FS/cdr/: $file\n";
1535       next;
1536     };
1537     my $mod = $1;
1538     my $info = eval "use FS::cdr::$mod; ".
1539                     "\\%FS::cdr::$mod\::info;";
1540     if ( $@ ) {
1541       die "error using FS::cdr::$mod (skipping): $@\n" if $@;
1542       next;
1543     }
1544     unless ( keys %$info ) {
1545       warn "no %info hash found in FS::cdr::$mod, skipping\n";
1546       next;
1547     }
1548     warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
1549     if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1550       warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
1551       next;
1552     }
1553     $cdr_info{$mod} = $info;
1554   }
1555 }
1556
1557 tie my %import_formats, 'Tie::IxHash',
1558   map  { $_ => $cdr_info{$_}->{'name'} }
1559   sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
1560   grep { exists($cdr_info{$_}->{'import_fields'}) }
1561   keys %cdr_info;
1562
1563 sub import_formats {
1564   %import_formats;
1565 }
1566
1567 sub _cdr_min_parser_maker {
1568   my $field = shift;
1569   my @fields = ref($field) ? @$field : ($field);
1570   @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
1571   return sub {
1572     my( $cdr, $min ) = @_;
1573     my $sec = eval { _cdr_min_parse($min) };
1574     die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
1575     $cdr->$_($sec) foreach @fields;
1576   };
1577 }
1578
1579 sub _cdr_min_parse {
1580   my $min = shift;
1581   sprintf('%.0f', $min * 60 );
1582 }
1583
1584 sub _cdr_date_parser_maker {
1585   my $field = shift;
1586   my %options = @_;
1587   my @fields = ref($field) ? @$field : ($field);
1588   return sub {
1589     my( $cdr, $datestring ) = @_;
1590     my $unixdate = eval { _cdr_date_parse($datestring, %options) };
1591     die "error parsing date for @fields from $datestring: $@\n" if $@;
1592     $cdr->$_($unixdate) foreach @fields;
1593   };
1594 }
1595
1596 sub _cdr_date_parse {
1597   my $date = shift;
1598   my %options = @_;
1599
1600   return '' unless length($date); #that's okay, it becomes NULL
1601   return '' if $date eq 'NA'; #sansay
1602
1603   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 ) {
1604     my $time = str2time($date);
1605     return $time if $time > 100000; #just in case
1606   }
1607
1608   my($year, $mon, $day, $hour, $min, $sec);
1609
1610   #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
1611   #taqua  #2007-10-31 08:57:24.113000000
1612
1613   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|$)/ ) {
1614     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1615   } 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|$)/ ) {
1616     # 8/26/2010 12:20:01
1617     # optionally without seconds
1618     ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1619     $sec = 0 if !defined($sec);
1620   } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d+\.\d+)(\D|$)/ ) {
1621     # broadsoft: 20081223201938.314
1622     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1623   } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\d+(\D|$)/ ) {
1624     # Taqua OM:  20050422203450943
1625     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1626   } elsif ( $date  =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) {
1627     # WIP: 20100329121420
1628     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1629   } elsif ( $date =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z$/) {
1630     # Telos
1631     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1632     $options{gmt} = 1;
1633   } else {
1634      die "unparsable date: $date"; #maybe we shouldn't die...
1635   }
1636
1637   return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
1638             && $hour == 0 && $min == 0 && $sec == 0;
1639
1640   if ($options{gmt}) {
1641     timegm($sec, $min, $hour, $day, $mon-1, $year);
1642   } else {
1643     timelocal($sec, $min, $hour, $day, $mon-1, $year);
1644   }
1645 }
1646
1647 =item batch_import HASHREF
1648
1649 Imports CDR records.  Available options are:
1650
1651 =over 4
1652
1653 =item file
1654
1655 Filename
1656
1657 =item format
1658
1659 =item params
1660
1661 Hash reference of preset fields, typically cdrbatch
1662
1663 =item empty_ok
1664
1665 Set true to prevent throwing an error on empty imports
1666
1667 =back
1668
1669 =cut
1670
1671 my %import_options = (
1672   'table'         => 'cdr',
1673
1674   'batch_keycol'  => 'cdrbatchnum',
1675   'batch_table'   => 'cdr_batch',
1676   'batch_namecol' => 'cdrbatch',
1677
1678   'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
1679                      keys %cdr_info
1680                },
1681
1682                           #drop the || 'csv' to allow auto xls for csv types?
1683   'format_types' => { map { $_ => lc($cdr_info{$_}->{'type'} || 'csv'); }
1684                           keys %cdr_info
1685                     },
1686
1687   'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
1688                             keys %cdr_info
1689                       },
1690
1691   'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
1692                               keys %cdr_info
1693                         },
1694
1695   'format_fixedlength_formats' =>
1696     { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
1697           keys %cdr_info
1698     },
1699
1700   'format_xml_formats' =>
1701     { map { $_ => $cdr_info{$_}->{'xml_format'}; }
1702           keys %cdr_info
1703     },
1704
1705   'format_asn_formats' =>
1706     { map { $_ => $cdr_info{$_}->{'asn_format'}; }
1707           keys %cdr_info
1708     },
1709
1710   'format_row_callbacks' =>
1711     { map { $_ => $cdr_info{$_}->{'row_callback'}; }
1712           keys %cdr_info
1713     },
1714
1715   'format_parser_opts' =>
1716     { map { $_ => $cdr_info{$_}->{'parser_opt'}; }
1717           keys %cdr_info
1718     },
1719 );
1720
1721 sub _import_options {
1722   \%import_options;
1723 }
1724
1725 sub batch_import {
1726   my $opt = shift;
1727
1728   my $iopt = _import_options;
1729   $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
1730
1731   if ( defined $opt->{'cdrtypenum'} ) {
1732         $opt->{'preinsert_callback'} = sub {
1733                 my($record,$param) = (shift,shift);
1734                 $record->cdrtypenum($opt->{'cdrtypenum'});
1735                 '';
1736         };
1737   }
1738
1739   FS::Record::batch_import( $opt );
1740
1741 }
1742
1743 =item process_batch_import
1744
1745 =cut
1746
1747 sub process_batch_import {
1748   my $job = shift;
1749
1750   my $opt = _import_options;
1751 #  $opt->{'params'} = [ 'format', 'cdrbatch' ];
1752
1753   FS::Record::process_batch_import( $job, $opt, @_ );
1754
1755 }
1756 #  if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
1757 #    @columns = map { s/^ +//; $_; } @columns;
1758 #  }
1759
1760 # _ upgrade_data
1761 #
1762 # Used by FS::Upgrade to migrate to a new database.
1763
1764 sub _upgrade_data {
1765   my ($class, %opts) = @_;
1766
1767   warn "$me upgrading $class\n" if $DEBUG;
1768
1769   my $sth = dbh->prepare(
1770     'SELECT DISTINCT(cdrbatch) FROM cdr WHERE cdrbatch IS NOT NULL'
1771   ) or die dbh->errstr;
1772
1773   $sth->execute or die $sth->errstr;
1774
1775   my %cdrbatchnum = ();
1776   while (my $row = $sth->fetchrow_arrayref) {
1777
1778     my $cdr_batch = qsearchs( 'cdr_batch', { 'cdrbatch' => $row->[0] } );
1779     unless ( $cdr_batch ) {
1780       $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] };
1781       my $error = $cdr_batch->insert;
1782       die $error if $error;
1783     }
1784
1785     $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum;
1786   }
1787
1788   $sth = dbh->prepare('UPDATE cdr SET cdrbatch = NULL, cdrbatchnum = ? WHERE cdrbatch IS NOT NULL AND cdrbatch = ?') or die dbh->errstr;
1789
1790   foreach my $cdrbatch (keys %cdrbatchnum) {
1791     $sth->execute($cdrbatchnum{$cdrbatch}, $cdrbatch) or die $sth->errstr;
1792   }
1793
1794 }
1795
1796 =item ip_addr_sql FIELD RANGE
1797
1798 Returns an SQL condition to search for CDRs with an IP address 
1799 within RANGE.  FIELD is either 'src_ip_addr' or 'dst_ip_addr'.  RANGE 
1800 should be in the form "a.b.c.d-e.f.g.h' (dotted quads), where any of 
1801 the leftmost octets of the second address can be omitted if they're 
1802 the same as the first address.
1803
1804 =cut
1805
1806 sub ip_addr_sql {
1807   my $class = shift;
1808   my ($field, $range) = @_;
1809   $range =~ /^[\d\.-]+$/ or die "bad ip address range '$range'";
1810   my @r = split('-', $range);
1811   my @saddr = split('\.', $r[0] || '');
1812   my @eaddr = split('\.', $r[1] || '');
1813   unshift @eaddr, (undef) x (4 - scalar @eaddr);
1814   for(0..3) {
1815     $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
1816   }
1817   "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
1818   "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
1819 }
1820
1821 =back
1822
1823 =head1 BUGS
1824
1825 =head1 SEE ALSO
1826
1827 L<FS::Record>, schema.html from the base documentation.
1828
1829 =cut
1830
1831 1;
1832