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