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