4 use vars qw( @ISA @EXPORT_OK $DEBUG $me
5 $conf $cdr_prerate %cdr_prerate_cdrtypenums
9 use List::Util qw(first min);
14 use List::Util qw( first min );
16 use FS::UID qw( dbh );
18 use FS::Record qw( qsearch qsearchs );
23 use FS::cdr_termination;
30 use HTTP::Request::Common qw(POST);
31 use Cpanel::JSON::XS qw(decode_json);
33 @ISA = qw(FS::Record);
34 @EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker );
39 #ask FS::UID to run this stuff for us later
40 FS::UID->install_callback( sub {
43 my @cdr_prerate_cdrtypenums;
44 $cdr_prerate = $conf->exists('cdr-prerate');
45 @cdr_prerate_cdrtypenums = $conf->config('cdr-prerate-cdrtypenums')
47 %cdr_prerate_cdrtypenums = map { $_=>1 } @cdr_prerate_cdrtypenums;
49 $support_key = $conf->config('support-key');
50 $use_lrn = $conf->exists('cdr-lrn_lookup');
56 FS::cdr - Object methods for cdr records
62 $record = new FS::cdr \%hash;
63 $record = new FS::cdr { 'column' => 'value' };
65 $error = $record->insert;
67 $error = $new_record->replace($old_record);
69 $error = $record->delete;
71 $error = $record->check;
75 An FS::cdr object represents an Call Data Record, typically from a telephony
76 system or provider of some sort. FS::cdr inherits from FS::Record. The
77 following fields are currently supported:
81 =item acctid - primary key
83 =item calldate - Call timestamp (SQL timestamp)
85 =item clid - Caller*ID with text
87 =item src - Caller*ID number / Source number
89 =item dst - Destination extension
91 =item dcontext - Destination context
93 =item channel - Channel used
95 =item dstchannel - Destination channel if appropriate
97 =item lastapp - Last application if appropriate
99 =item lastdata - Last application data
101 =item src_ip_addr - Source IP address (dotted quad, zero-filled)
103 =item dst_ip_addr - Destination IP address (same)
105 =item dst_term - Terminating destination number (if different from dst)
107 =item startdate - Start of call (UNIX-style integer timestamp)
109 =item answerdate - Answer time of call (UNIX-style integer timestamp)
111 =item enddate - End time of call (UNIX-style integer timestamp)
113 =item duration - Total time in system, in seconds
115 =item billsec - Total time call is up, in seconds
117 =item disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
119 =item amaflags - What flags to use: BILL, IGNORE etc, specified on a per channel basis like accountcode.
123 #ignore the "omit" and "documentation" AMAs??
124 #AMA = Automated Message Accounting.
125 #default: Sets the system default.
126 #omit: Do not record calls.
127 #billing: Mark the entry for billing
128 #documentation: Mark the entry for documentation.
130 =item accountcode - CDR account number to use: account
132 =item uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
134 =item userfield - CDR user-defined field
136 =item cdr_type - CDR type - see L<FS::cdr_type> (Usage = 1, S&E = 7, OC&C = 8)
138 =item charged_party - Service number to be billed
140 =item upstream_currency - Wholesale currency from upstream
142 =item upstream_price - Wholesale price from upstream
144 =item upstream_rateplanid - Upstream rate plan ID
146 =item rated_price - Rated (or re-rated) price
148 =item distance - km (need units field?)
150 =item islocal - Local - 1, Non Local = 0
152 =item calltypenum - Type of call - see L<FS::cdr_calltype>
154 =item description - Description (cdr_type 7&8 only) (used for cust_bill_pkg.itemdesc)
156 =item quantity - Number of items (cdr_type 7&8 only)
158 =item carrierid - Upstream Carrier ID (see L<FS::cdr_carrier>)
162 #Telstra =1, Optus = 2, RSL COM = 3
164 =item upstream_rateid - Upstream Rate ID
166 =item svcnum - Link to customer service (see L<FS::cust_svc>)
168 =item freesidestatus - NULL, processing-tiered, rated, done, skipped, no-charge, failed
170 =item freesiderewritestatus - NULL, done, skipped
174 =item detailnum - Link to invoice detail (L<FS::cust_bill_pkg_detail>)
184 Creates a new CDR. To add the CDR to the database, see L<"insert">.
186 Note that this stores the hash reference, not a distinct copy of the hash it
187 points to. You can ask the object for a copy with the I<hash> method.
191 # the new method can be inherited from FS::Record, if a table method is defined
198 #XXX fill in some (more) nice names
200 'calldate' => 'Call date',
201 'clid' => 'Caller ID',
203 'dst' => 'Destination',
204 'dcontext' => 'Dest. context',
205 'channel' => 'Channel',
206 'dstchannel' => 'Destination channel',
209 'src_ip_addr' => 'Source IP',
210 'dst_ip_addr' => 'Dest. IP',
211 'dst_term' => 'Termination dest.',
212 'startdate' => 'Start date',
213 'answerdate' => 'Answer date',
214 'enddate' => 'End date',
215 'duration' => 'Duration',
216 'billsec' => 'Billable seconds',
217 'disposition' => 'Disposition',
218 'amaflags' => 'AMA flags',
219 'accountcode' => 'Account code',
221 'userfield' => 'User field',
223 'charged_party' => 'Charged party',
224 #'upstream_currency' => '',
225 'upstream_price' => 'Upstream price',
226 #'upstream_rateplanid' => '',
227 #'ratedetailnum' => '',
228 'src_lrn' => 'Source LRN',
229 'dst_lrn' => 'Dest. LRN',
230 'rated_price' => 'Rated price',
231 'rated_cost' => 'Rated cost',
234 #'calltypenum' => '',
235 #'description' => '',
237 'carrierid' => 'Carrier ID',
238 #'upstream_rateid' => '',
239 'svcnum' => 'Freeside service',
240 'freesidestatus' => 'Freeside status',
241 'freesiderewritestatus' => 'Freeside rewrite status',
242 'cdrbatch' => 'Legacy batch',
243 'cdrbatchnum' => 'Batch',
244 'detailnum' => 'Freeside invoice detail line',
253 Adds this record to the database. If there is an error, returns the error,
254 otherwise returns false.
258 # the insert method can be inherited from FS::Record
262 Delete this record from the database.
266 # the delete method can be inherited from FS::Record
268 =item replace OLD_RECORD
270 Replaces the OLD_RECORD with this one in the database. If there is an error,
271 returns the error, otherwise returns false.
275 # the replace method can be inherited from FS::Record
279 Checks all fields to make sure this is a valid CDR. If there is
280 an error, returns the error, otherwise returns false. Called by the insert
283 Note: Unlike most types of records, we don't want to "reject" a CDR and we want
284 to process them as quickly as possible, so we allow the database to check most
292 # we don't want to "reject" a CDR like other sorts of input...
294 # $self->ut_numbern('acctid')
295 ## || $self->ut_('calldate')
296 # || $self->ut_text('clid')
297 # || $self->ut_text('src')
298 # || $self->ut_text('dst')
299 # || $self->ut_text('dcontext')
300 # || $self->ut_text('channel')
301 # || $self->ut_text('dstchannel')
302 # || $self->ut_text('lastapp')
303 # || $self->ut_text('lastdata')
304 # || $self->ut_numbern('startdate')
305 # || $self->ut_numbern('answerdate')
306 # || $self->ut_numbern('enddate')
307 # || $self->ut_number('duration')
308 # || $self->ut_number('billsec')
309 # || $self->ut_text('disposition')
310 # || $self->ut_number('amaflags')
311 # || $self->ut_text('accountcode')
312 # || $self->ut_text('uniqueid')
313 # || $self->ut_text('userfield')
314 # || $self->ut_numbern('cdrtypenum')
315 # || $self->ut_textn('charged_party')
316 ## || $self->ut_n('upstream_currency')
317 ## || $self->ut_n('upstream_price')
318 # || $self->ut_numbern('upstream_rateplanid')
319 ## || $self->ut_n('distance')
320 # || $self->ut_numbern('islocal')
321 # || $self->ut_numbern('calltypenum')
322 # || $self->ut_textn('description')
323 # || $self->ut_numbern('quantity')
324 # || $self->ut_numbern('carrierid')
325 # || $self->ut_numbern('upstream_rateid')
326 # || $self->ut_numbern('svcnum')
327 # || $self->ut_textn('freesidestatus')
328 # || $self->ut_textn('freesiderewritestatus')
330 # return $error if $error;
332 for my $f ( grep { $self->$_ =~ /\D/ } qw(startdate answerdate enddate)){
333 $self->$f( str2time($self->$f) );
336 $self->calldate( $self->startdate_sql )
337 if !$self->calldate && $self->startdate;
339 #was just for $format eq 'taqua' but can't see the harm... add something to
340 #disable if it becomes a problem
341 if ( $self->duration eq '' && $self->enddate && $self->startdate ) {
342 $self->duration( $self->enddate - $self->startdate );
344 if ( $self->billsec eq '' && $self->enddate && $self->answerdate ) {
345 $self->billsec( $self->enddate - $self->answerdate );
348 if ( ! $self->enddate && $self->startdate && $self->duration ) {
349 $self->enddate( $self->startdate + $self->duration );
352 $self->set_charged_party;
354 #check the foreign keys even?
355 #do we want to outright *reject* the CDR?
356 my $error = $self->ut_numbern('acctid');
357 return $error if $error;
359 if ( $self->freesidestatus ne 'done' ) {
360 $self->set('detailnum', ''); # can't have this on an unbilled call
363 #add a config option to turn these back on if someone needs 'em
365 # #Usage = 1, S&E = 7, OC&C = 8
366 # || $self->ut_foreign_keyn('cdrtypenum', 'cdr_type', 'cdrtypenum' )
368 # #the big list in appendix 2
369 # || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
371 # # Telstra =1, Optus = 2, RSL COM = 3
372 # || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
377 =item is_tollfree [ COLUMN ]
379 Returns true when the cdr represents a toll free number and false otherwise.
381 By default, inspects the dst field, but an optional column name can be passed
382 to inspect other field.
388 my $field = scalar(@_) ? shift : 'dst';
389 my $country = $conf->config('tollfree-country') || '';
390 if ( $country eq 'AU' ) {
391 ( $self->$field() =~ /^(\+?61)?(1800|1300)/ ) ? 1 : 0;
392 } elsif ( $country eq 'NZ' ) {
393 ( $self->$field() =~ /^(\+?64)?(800|508)/ ) ? 1 : 0;
394 } else { #NANPA (US/Canaada)
395 ( $self->$field() =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0;
399 =item set_charged_party
401 If the charged_party field is already set, does nothing. Otherwise:
403 If the cdr-charged_party-accountcode config option is enabled, sets the
404 charged_party to the accountcode.
406 Otherwise sets the charged_party normally: to the src field in most cases,
407 or to the dst field if it is a toll free number.
411 sub set_charged_party {
414 my $conf = new FS::Conf;
416 unless ( $self->charged_party ) {
418 if ( $conf->exists('cdr-charged_party-accountcode') && $self->accountcode ){
420 my $charged_party = $self->accountcode;
421 $charged_party =~ s/^0+//
422 if $conf->exists('cdr-charged_party-accountcode-trim_leading_0s');
423 $self->charged_party( $charged_party );
425 } elsif ( $conf->exists('cdr-charged_party-field') ) {
427 my $field = $conf->config('cdr-charged_party-field');
428 $self->charged_party( $self->$field() );
432 if ( $self->is_tollfree ) {
433 $self->charged_party($self->dst);
435 $self->charged_party($self->src);
442 # my $prefix = $conf->config('cdr-charged_party-truncate_prefix');
443 # my $prefix_len = length($prefix);
444 # my $trunc_len = $conf->config('cdr-charged_party-truncate_length');
446 # $self->charged_party( substr($self->charged_party, 0, $trunc_len) )
447 # if $prefix_len && $trunc_len
448 # && substr($self->charged_party, 0, $prefix_len) eq $prefix;
452 =item set_status STATUS
454 Sets the status to the provided string. If there is an error, returns the
455 error, otherwise returns false.
457 If status is being changed from 'rated' to some other status, also removes
458 any usage allocations to this CDR.
463 my($self, $status) = @_;
464 my $old_status = $self->freesidestatus;
465 $self->freesidestatus($status);
466 my $error = $self->replace;
467 if ( $old_status eq 'rated' and $status ne 'done' ) {
468 # deallocate any usage
469 foreach (qsearch('cdr_cust_pkg_usage', {acctid => $self->acctid})) {
470 my $cust_pkg_usage = $_->cust_pkg_usage;
471 $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $_->minutes);
472 $error ||= $cust_pkg_usage->replace || $_->delete;
478 =item set_status_and_rated_price STATUS RATED_PRICE [ SVCNUM [ OPTION => VALUE ... ] ]
480 Sets the status and rated price.
482 Available options are: inbound, rated_pretty_dst, rated_regionname,
483 rated_seconds, rated_minutes, rated_granularity, rated_ratedetailnum,
484 rated_classnum, rated_ratename. If rated_ratedetailnum is provided,
485 will also set a recalculated L</rate_cost> in the rated_cost field
486 after the other fields are set (does not work with inbound.)
488 If there is an error, returns the error, otherwise returns false.
492 sub set_status_and_rated_price {
493 my($self, $status, $rated_price, $svcnum, %opt) = @_;
495 if ($opt{'inbound'}) {
497 my $term = $self->cdr_termination( 1 ); #1: inbound
500 warn "replacing existing cdr status (".$self->acctid.")\n" if $term;
501 $error = $term->delete;
502 return $error if $error;
504 $term = FS::cdr_termination->new({
505 acctid => $self->acctid,
507 rated_price => $rated_price,
510 $term->rated_seconds($opt{rated_seconds}) if exists($opt{rated_seconds});
511 $term->rated_minutes($opt{rated_minutes}) if exists($opt{rated_minutes});
512 $term->svcnum($svcnum) if $svcnum;
513 return $term->insert;
517 $self->freesidestatus($status);
518 $self->rated_price($rated_price);
520 foreach grep exists($opt{$_}), map "rated_$_",
521 qw( pretty_dst regionname seconds minutes granularity
522 ratedetailnum classnum ratename );
523 $self->svcnum($svcnum) if $svcnum;
524 $self->rated_cost($self->rate_cost) if $opt{'rated_ratedetailnum'};
526 return $self->replace();
531 =item parse_number [ OPTION => VALUE ... ]
533 Returns two scalars, the countrycode and the rest of the number.
535 Options are passed as name-value pairs. Currently available options are:
541 The column containing the number to be parsed. Defaults to dst.
543 =item international_prefix
545 The digits for international dialing. Defaults to '011' The value '+' is
548 =item domestic_prefix
550 The digits for domestic long distance dialing. Defaults to '1'
557 my ($self, %options) = @_;
559 my $field = $options{column} || 'dst';
560 my $intl = $options{international_prefix} || '011';
561 # Still, don't break anyone's CDR rating if they have an empty string in
562 # there. Require an explicit statement that there's no prefix.
563 $intl = '' if lc($intl) eq 'none';
564 my $countrycode = '';
565 my $number = $self->$field();
567 my $to_or_from = 'concerning';
568 $to_or_from = 'from' if $field eq 'src';
569 $to_or_from = 'to' if $field eq 'dst';
570 warn "parsing call $to_or_from $number\n" if $DEBUG;
572 #remove non-phone# stuff and whitespace
575 # $dest =~ s/^(\w+):// and $proto = $1; #sip:
577 # $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
579 if ( $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
580 || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
584 my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 );
585 #first look for 1 digit country code
586 if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) {
588 $number = $u1.$u2.$rest;
589 } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
592 } else { #3 digit country code
593 $countrycode = $three;
598 my $domestic_prefix =
599 exists($options{domestic_prefix}) ? $options{domestic_prefix} : '';
600 $countrycode = length($domestic_prefix) ? $domestic_prefix : '1';
601 $number =~ s/^$countrycode//;# if length($number) > 10;
604 return($countrycode, $number);
608 =item rate [ OPTION => VALUE ... ]
610 Rates this CDR according and sets the status to 'rated'.
612 Available options are: part_pkg, svcnum, plan_included_min,
613 detail_included_min_hashref.
615 part_pkg is required.
617 If svcnum is specified, will also associate this CDR with the specified svcnum.
619 plan_included_min should be set to a scalar reference of the number of
620 included minutes and will be decremented by the rated minutes of this
623 detail_included_min_hashref should be set to an empty hashref at the
624 start of a month's rating and then preserved across CDRs.
629 my( $self, %opt ) = @_;
630 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
633 warn "rating CDR $self\n".
634 join('', map { " $_ => ". $self->{$_}. "\n" } keys %$self );
637 my $rating_method = $part_pkg->option_cacheable('rating_method') || 'prefix';
638 my $method = "rate_$rating_method";
639 $self->$method(%opt);
643 our %interval_cache = (); # for timed rates
646 my( $self, %opt ) = @_;
647 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
648 my $cust_pkg = $opt{'cust_pkg'};
651 # this will result in those CDRs being marked as done... is that
654 if ( $part_pkg->option_cacheable('411_rewrite') ) {
655 my $dirass = $part_pkg->option_cacheable('411_rewrite');
657 @dirass = split(',', $dirass);
660 if ( length($self->dst) && grep { $self->dst eq $_ } @dirass ) {
665 my $reason = $part_pkg->check_chargable( $self,
666 'da_rewrote' => $da_rewrote,
669 warn "not charging for CDR ($reason)\n" if $DEBUG;
670 return $self->set_status_and_rated_price( 'skipped',
676 if ( $part_pkg->option_cacheable('skip_same_customer')
677 and ! $self->is_tollfree ) {
678 my ($dst_countrycode, $dst_number) = $self->parse_number(
680 international_prefix => $part_pkg->option_cacheable('international_prefix'),
681 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
683 my $dst_same_cust = FS::Record->scalar_sql(
684 'SELECT COUNT(svc_phone.svcnum) AS count '.
686 'JOIN cust_svc USING (pkgnum) ' .
687 'JOIN svc_phone USING (svcnum) ' .
688 'WHERE svc_phone.countrycode = ' . dbh->quote($dst_countrycode) .
689 ' AND svc_phone.phonenum = ' . dbh->quote($dst_number) .
690 ' AND cust_pkg.custnum = ' . $cust_pkg->custnum,
692 if ( $dst_same_cust > 0 ) {
693 warn "not charging for CDR (same source and destination customer)\n" if $DEBUG;
694 return $self->set_status_and_rated_price( 'skipped',
702 # look up rate details based on called station id
703 # (or calling station id for toll free calls)
706 my $eff_ratenum = $self->is_tollfree('accountcode')
707 ? $part_pkg->option_cacheable('accountcode_tollfree_ratenum')
710 my( $to_or_from, $column );
713 && ! $part_pkg->option_cacheable('disable_tollfree')
716 && $part_pkg->option_cacheable('accountcode_tollfree_field') eq 'src'
720 $to_or_from = 'from';
722 } else { #regular call
727 #determine the country code
728 my ($countrycode, $number) = $self->parse_number(
730 international_prefix => $part_pkg->option_cacheable('international_prefix'),
731 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
735 my $intrastate_ratenum = $part_pkg->option_cacheable('intrastate_ratenum');
737 if ( $use_lrn and $countrycode eq '1' ) {
739 # then ask about the number
740 foreach my $field ('src', 'dst') {
742 $self->get_lrn($field);
743 if ( $field eq $column ) {
744 # then we are rating on this number
745 $number = $self->get($field.'_lrn');
747 # is this ever meaningful? can the LRN be outside NANP space?
754 warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG;
755 my $pretty_dst = "+$countrycode $number";
756 #asterisks here causes inserting the detail to barf, so:
757 $pretty_dst =~ s/\*//g;
759 # should check $countrycode eq '1' here?
760 if ( $intrastate_ratenum && !$self->is_tollfree ) {
761 $ratename = 'Interstate'; #until proven otherwise
762 # this is relatively easy only because:
763 # -assume all numbers are valid NANP numbers NOT in a fully-qualified format
764 # -disregard toll-free
765 # -disregard private or unknown numbers
766 # -there is exactly one record in rate_prefix for a given NPANXX
767 # -default to interstate if we can't find one or both of the prefixes
768 my $dst_col = $use_lrn ? 'dst_lrn' : 'dst';
769 my $src_col = $use_lrn ? 'src_lrn' : 'src';
770 my (undef, $dstprefix) = $self->parse_number(
772 international_prefix => $part_pkg->option_cacheable('international_prefix'),
773 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
775 $dstprefix =~ /^(\d{6})/;
776 $dstprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
779 my (undef, $srcprefix) = $self->parse_number(
781 international_prefix => $part_pkg->option_cacheable('international_prefix'),
782 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
784 $srcprefix =~ /^(\d{6})/;
785 $srcprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
788 if ($srcprefix && $dstprefix
789 && $srcprefix->state && $dstprefix->state
790 && $srcprefix->state eq $dstprefix->state) {
791 $eff_ratenum = $intrastate_ratenum;
792 $ratename = 'Intrastate'; # XXX possibly just use the ratename?
796 $eff_ratenum ||= $part_pkg->option_cacheable('ratenum');
797 my $rate = qsearchs('rate', { 'ratenum' => $eff_ratenum })
798 or die "ratenum $eff_ratenum not found!";
800 my @ltime = localtime($self->startdate);
801 my $weektime = $ltime[0] +
802 $ltime[1]*60 + #minutes
803 $ltime[2]*3600 + #hours
804 $ltime[6]*86400; #days since sunday
805 # if there's no timed rate_detail for this time/region combination,
806 # dest_detail returns the default. There may still be a timed rate
807 # that applies after the starttime of the call, so be careful...
808 my $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
809 'phonenum' => $number,
810 'weektime' => $weektime,
811 'cdrtypenum' => $self->cdrtypenum,
814 unless ( $rate_detail ) {
816 if ( $part_pkg->option_cacheable('ignore_unrateable') ) {
818 if ( $part_pkg->option_cacheable('ignore_unrateable') == 2 ) {
819 # mark the CDR as unrateable
820 return $self->set_status_and_rated_price(
825 } elsif ( $part_pkg->option_cacheable('ignore_unrateable') == 1 ) {
827 warn "no rate_detail found for CDR.acctid: ". $self->acctid.
832 die "unknown ignore_unrateable, pkgpart ". $part_pkg->pkgpart;
837 die "FATAL: no rate_detail found in ".
838 $rate->ratenum. ":". $rate->ratename. " rate plan ".
839 "for +$countrycode $number (CDR acctid ". $self->acctid. "); ".
840 "add a rate or set ignore_unrateable flag on the package def\n";
845 my $regionnum = $rate_detail->dest_regionnum;
846 my $rate_region = $rate_detail->dest_region;
847 warn " found rate for regionnum $regionnum ".
848 "and rate detail $rate_detail\n"
851 if ( !exists($interval_cache{$regionnum}) ) {
853 sort { $a->stime <=> $b->stime }
854 map { $_->rate_time->intervals }
855 qsearch({ 'table' => 'rate_detail',
856 'hashref' => { 'ratenum' => $rate->ratenum },
857 'extra_sql' => 'AND ratetimenum IS NOT NULL',
860 $interval_cache{$regionnum} = \@intervals;
861 warn " cached ".scalar(@intervals)." interval(s)\n"
866 # find the price and add detail to the invoice
869 # About this section:
870 # We don't round _anything_ (except granularizing)
871 # until the final $charge = sprintf("%.2f"...).
873 my $rated_seconds = $part_pkg->option_cacheable('use_duration')
876 my $seconds_left = $rated_seconds;
878 #no, do this later so it respects (group) included minutes
879 # # charge for the first (conn_sec) seconds
880 # my $seconds = min($seconds_left, $rate_detail->conn_sec);
881 # $seconds_left -= $seconds;
882 # $weektime += $seconds;
883 # my $charge = $rate_detail->conn_charge;
886 my $connection_charged = 0;
888 # before doing anything else, if there's an upstream multiplier and
889 # an upstream price, add that to the charge. (usually the rate detail
890 # will then have a minute charge of zero, but not necessarily.)
891 $charge += ($self->upstream_price || 0) * $rate_detail->upstream_mult_charge;
894 while($seconds_left) {
895 my $ratetimenum = $rate_detail->ratetimenum; # may be empty
897 # find the end of the current rate interval
898 if(@{ $interval_cache{$regionnum} } == 0) {
899 # There are no timed rates in this group, so just stay
900 # in the default rate_detail for the entire duration.
901 # Set an "end" of 1 past the end of the current call.
902 $etime = $weektime + $seconds_left + 1;
904 elsif($ratetimenum) {
905 # This is a timed rate, so go to the etime of this interval.
906 # If it's followed by another timed rate, the stime of that
907 # interval should match the etime of this one.
908 my $interval = $rate_detail->rate_time->contains($weektime);
909 $etime = $interval->etime;
912 # This is a default rate, so use the stime of the next
913 # interval in the sequence.
914 my $next_int = first { $_->stime > $weektime }
915 @{ $interval_cache{$regionnum} };
917 $etime = $next_int->stime;
920 # weektime is near the end of the week, so decrement
921 # it by a full week and use the stime of the first
923 $weektime -= (3600*24*7);
924 $etime = $interval_cache{$regionnum}->[0]->stime;
928 my $charge_sec = min($seconds_left, $etime - $weektime);
930 $seconds_left -= $charge_sec;
932 my $granularity = $rate_detail->sec_granularity;
935 if ( $granularity ) { # charge per minute
936 # Round up to the nearest $granularity
937 if ( $charge_sec and $charge_sec % $granularity ) {
938 $charge_sec += $granularity - ($charge_sec % $granularity);
940 $minutes = $charge_sec / 60; #don't round this
947 #$seconds += $charge_sec;
949 if ( $rate_detail->min_included ) {
950 # the old, kind of deprecated way to do this:
952 # The rate detail itself has included minutes. We MUST have a place
954 my $included_min = $opt{'detail_included_min_hashref'}
955 or return "unable to rate CDR: rate detail has included minutes, but ".
956 "no detail_included_min_hashref provided.\n";
958 # by default, set the included minutes for this region/time to
959 # what's in the rate_detail
960 if (!exists( $included_min->{$regionnum}{$ratetimenum} )) {
961 $included_min->{$regionnum}{$ratetimenum} =
962 ($rate_detail->min_included * $cust_pkg->quantity || 1);
965 if ( $included_min->{$regionnum}{$ratetimenum} >= $minutes ) {
967 $included_min->{$regionnum}{$ratetimenum} -= $minutes;
969 $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60);
970 $included_min->{$regionnum}{$ratetimenum} = 0;
972 } elsif ( $opt{plan_included_min} && ${ $opt{plan_included_min} } > 0 ) {
973 # The package definition has included minutes, but only for in-group
974 # rate details. Decrement them if this is an in-group call.
975 if ( $rate_detail->region_group ) {
976 if ( ${ $opt{'plan_included_min'} } >= $minutes ) {
978 ${ $opt{'plan_included_min'} } -= $minutes;
980 $charge_sec -= (${ $opt{'plan_included_min'} } * 60);
981 ${ $opt{'plan_included_min'} } = 0;
986 my $applied_min = $cust_pkg->apply_usage(
988 'rate_detail' => $rate_detail,
989 'minutes' => $minutes
991 # for now, usage pools deal only in whole minutes
992 $charge_sec -= $applied_min * 60;
995 if ( $charge_sec > 0 ) {
997 #NOW do connection charges here... right?
998 #my $conn_seconds = min($seconds_left, $rate_detail->conn_sec);
999 my $conn_seconds = 0;
1000 unless ( $connection_charged++ ) { #only one connection charge
1001 $conn_seconds = min($charge_sec, $rate_detail->conn_sec);
1002 $seconds_left -= $conn_seconds;
1003 $weektime += $conn_seconds;
1004 $charge += $rate_detail->conn_charge;
1007 #should preserve (display?) this
1008 if ( $granularity == 0 ) { # per call rate
1009 $charge += $rate_detail->min_charge;
1011 my $charge_min = ( $charge_sec - $conn_seconds ) / 60;
1012 $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
1017 # choose next rate_detail
1018 $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
1019 'phonenum' => $number,
1020 'weektime' => $etime,
1021 'cdrtypenum' => $self->cdrtypenum })
1023 # we have now moved forward to $etime
1026 } #while $seconds_left
1028 # this is why we need regionnum/rate_region....
1029 warn " (rate region $rate_region)\n" if $DEBUG;
1032 my $rounding = $part_pkg->option_cacheable('rounding') || 2;
1033 my $sprintformat = '%.'. $rounding. 'f';
1034 my $roundup = 10**(-3-$rounding);
1035 my $price = sprintf($sprintformat, $charge + $roundup);
1037 $self->set_status_and_rated_price(
1041 'rated_pretty_dst' => $pretty_dst,
1042 'rated_regionname' => ($rate_region ? $rate_region->regionname : ''),
1043 'rated_seconds' => $rated_seconds, #$seconds,
1044 'rated_granularity' => $rate_detail->sec_granularity, #$granularity
1045 'rated_ratedetailnum' => $rate_detail->ratedetailnum,
1046 'rated_classnum' => $rate_detail->classnum, #rated_ratedetailnum?
1047 'rated_ratename' => $ratename, #not rate_detail - Intrastate/Interstate
1052 sub rate_upstream_simple {
1053 my( $self, %opt ) = @_;
1055 $self->set_status_and_rated_price(
1057 sprintf('%.3f', $self->upstream_price),
1059 'rated_classnum' => $self->calltypenum,
1060 'rated_seconds' => $self->billsec,
1061 # others? upstream_*_regionname => rated_regionname is possible
1065 sub rate_single_price {
1066 my( $self, %opt ) = @_;
1067 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
1069 # a little false laziness w/abov
1070 # $rate_detail = new FS::rate_detail({sec_granularity => ... }) ?
1072 my $granularity = length($part_pkg->option_cacheable('sec_granularity'))
1073 ? $part_pkg->option_cacheable('sec_granularity')
1076 my $seconds = $part_pkg->option_cacheable('use_duration')
1080 $seconds += $granularity - ( $seconds % $granularity )
1081 if $seconds # don't granular-ize 0 billsec calls (bills them)
1082 && $granularity # 0 is per call
1083 && $seconds % $granularity;
1084 my $minutes = $granularity ? ($seconds / 60) : 1;
1086 my $charge_min = $minutes;
1088 ${$opt{plan_included_min}} -= $minutes;
1089 if ( ${$opt{plan_included_min}} > 0 ) {
1092 $charge_min = 0 - ${$opt{plan_included_min}};
1093 ${$opt{plan_included_min}} = 0;
1097 sprintf('%.4f', ( $part_pkg->option_cacheable('min_charge') * $charge_min )
1098 + 0.0000000001 ); #so 1.00005 rounds to 1.0001
1100 $self->set_status_and_rated_price(
1104 'rated_granularity' => $granularity,
1105 'rated_seconds' => $seconds,
1112 Rates an already-rated CDR according to the cost fields from the rate plan.
1121 return 0 unless $self->rated_ratedetailnum;
1124 qsearchs('rate_detail', { 'ratedetailnum' => $self->rated_ratedetailnum } );
1127 $charge += ($self->upstream_price || 0) * ($rate_detail->upstream_mult_cost);
1129 if ( $self->rated_granularity == 0 ) {
1130 $charge += $rate_detail->min_cost;
1132 my $minutes = $self->rated_seconds / 60;
1133 $charge += $rate_detail->conn_cost + $minutes * $rate_detail->min_cost;
1136 sprintf('%.2f', $charge + .00001 );
1140 =item cdr_termination [ TERMPART ]
1144 sub cdr_termination {
1147 if ( scalar(@_) && $_[0] ) {
1148 my $termpart = shift;
1150 qsearchs('cdr_termination', { acctid => $self->acctid,
1151 termpart => $termpart,
1157 qsearch('cdr_termination', { acctid => $self->acctid, } );
1165 Parses the calldate in SQL string format and returns a UNIX timestamp.
1170 str2time(shift->calldate);
1175 Parses the startdate in UNIX timestamp format and returns a string in SQL
1181 my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
1184 "$year-$mon-$mday $hour:$min:$sec";
1189 Returns the FS::cdr_carrier object associated with this CDR, or false if no
1190 carrierid is defined.
1194 my %carrier_cache = ();
1198 return '' unless $self->carrierid;
1199 $carrier_cache{$self->carrierid} ||=
1200 qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
1205 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
1206 no FS::cdr_carrier object is assocated with this CDR.
1212 my $cdr_carrier = $self->cdr_carrier;
1213 $cdr_carrier ? $cdr_carrier->carriername : '';
1218 Returns the FS::cdr_calltype object associated with this CDR, or false if no
1219 calltypenum is defined.
1223 my %calltype_cache = ();
1227 return '' unless $self->calltypenum;
1228 $calltype_cache{$self->calltypenum} ||=
1229 qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
1234 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
1235 no FS::cdr_calltype object is assocated with this CDR.
1241 my $cdr_calltype = $self->cdr_calltype;
1242 $cdr_calltype ? $cdr_calltype->calltypename : '';
1245 =item downstream_csv [ OPTION => VALUE, ... ]
1249 # in the future, load this dynamically from detail_format classes
1251 my %export_names = (
1254 'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
1257 'name' => 'Simple with source',
1258 'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
1259 #"Date,Time,Name,Called From,Destination,Duration,Price",
1261 'accountcode_simple' => {
1262 'name' => 'Simple with accountcode',
1263 'invoice_header' => "Date,Time,Called From,Account,Duration,Price",
1267 'invoice_header' => "Date/Time,Called Number,Min/Sec,Price",
1269 'basic_upstream_dst_regionname' => {
1270 'name' => 'Basic with upstream destination name',
1271 'invoice_header' => "Date/Time,Called Number,Destination,Min/Sec,Price",
1274 'name' => 'Default',
1275 'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
1277 'source_default' => {
1278 'name' => 'Default with source',
1279 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1281 'accountcode_default' => {
1282 'name' => 'Default plus accountcode',
1283 'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
1285 'description_default' => {
1286 'name' => 'Default with description field as destination',
1287 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1290 'name' => 'Summary, one line per service',
1291 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1294 'name' => 'Number of calls, one line per service',
1295 'invoice_header' => 'Caller,Rate,Messages,Price',
1298 'name' => 'Summary, one line per service',
1299 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1301 'sum_duration_prefix' => {
1302 'name' => 'Summary, one line per destination prefix',
1303 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1305 'sum_count_class' => {
1306 'name' => 'Summary, one line per usage class',
1307 'invoice_header' => 'Caller,Class,Calls,Price',
1309 'sum_duration_accountcode' => {
1310 'name' => 'Summary, one line per accountcode',
1311 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1315 my %export_formats = ();
1316 sub export_formats {
1319 return %export_formats if keys %export_formats;
1321 my $conf = new FS::Conf;
1322 my $date_format = $conf->config('date_format') || '%m/%d/%Y';
1324 # call duration in the largest units that accurately reflect the granularity
1325 my $duration_sub = sub {
1326 my($cdr, %opt) = @_;
1327 my $sec = $opt{seconds} || $cdr->billsec;
1328 if ( defined $opt{granularity} &&
1329 $opt{granularity} == 0 ) { #per call
1332 elsif ( defined $opt{granularity} && $opt{granularity} == 60 ) {#full minutes
1333 my $min = int($sec/60);
1337 else { #anything else
1338 return sprintf("%dm %ds", $sec/60, $sec%60);
1342 my $price_sub = sub {
1343 my ($cdr, %opt) = @_;
1345 if ( defined($opt{charge}) ) {
1346 $price = $opt{charge};
1348 elsif ( $opt{inbound} ) {
1349 my $term = $cdr->cdr_termination(1); # 1 = inbound
1350 $price = $term->rated_price if defined $term;
1353 $price = $cdr->rated_price;
1355 length($price) ? ($opt{money_char} . $price) : '';
1358 my $src_sub = sub { $_[0]->clid || $_[0]->src };
1362 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1363 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1365 'dst', #NUMBER_DIALED
1366 $duration_sub, #DURATION
1367 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1371 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1372 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1374 $src_sub, #called from
1375 'dst', #NUMBER_DIALED
1376 $duration_sub, #DURATION
1377 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1380 'accountcode_simple' => [
1381 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1382 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1383 $src_sub, #called from
1384 'accountcode', #NUMBER_DIALED
1385 $duration_sub, #DURATION
1389 # for summary formats, the CDR is a fictitious object containing the
1390 # total billsec and the phone number of the service
1392 sub { my($cdr, %opt) = @_; $opt{ratename} },
1393 sub { my($cdr, %opt) = @_; $opt{count} },
1394 sub { my($cdr, %opt) = @_; int($opt{seconds}/60).'m' },
1399 sub { my($cdr, %opt) = @_; $opt{ratename} },
1400 sub { my($cdr, %opt) = @_; $opt{count} },
1404 sub { time2str('%d %b - %I:%M %p', shift->calldate_unix) },
1412 sub { time2str($date_format, shift->calldate_unix ) },
1413 # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
1416 sub { time2str('%r', shift->calldate_unix ) },
1417 # 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 sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
1422 #REGIONNAME ("Destination")
1423 sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
1432 $export_formats{'source_default'} = [ $src_sub, @{ $export_formats{'default'} }, ];
1433 $export_formats{'accountcode_default'} =
1434 [ @{ $export_formats{'default'} }[0,1],
1436 @{ $export_formats{'default'} }[2..5],
1438 my @default = @{ $export_formats{'default'} };
1439 $export_formats{'description_default'} =
1440 [ $src_sub, @default[0..2],
1441 sub { my($cdr, %opt) = @_; $cdr->description },
1444 return %export_formats;
1447 =item downstream_csv OPTION => VALUE ...
1449 Returns a string of formatted call details for display on an invoice.
1455 charge - override the 'rated_price' field of the CDR
1457 seconds - override the 'billsec' field of the CDR
1459 count - number of usage events included in this record, for summary formats
1461 ratename - name of the rate table used to rate this call
1467 sub downstream_csv {
1468 my( $self, %opt ) = @_;
1470 my $format = $opt{'format'};
1471 my %formats = $self->export_formats;
1472 return "Unknown format $format" unless exists $formats{$format};
1474 #my $conf = new FS::Conf;
1475 #$opt{'money_char'} ||= $conf->config('money_char') || '$';
1476 $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
1478 my $csv = new Text::CSV_XS;
1482 ref($_) ? &{$_}($self, %opt) : $self->$_();
1484 @{ $formats{$format} };
1486 return @columns if defined $opt{'keeparray'};
1488 my $status = $csv->combine(@columns);
1489 die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
1500 my $ua = LWP::UserAgent->new;
1501 my $url = 'https://ws.freeside.biz/get_lrn';
1503 my %content = ( 'support-key' => $support_key,
1504 'tn' => $self->get($field),
1506 my $response = $ua->request( POST $url, \%content );
1508 die "LRN service error: ". $response->message. "\n"
1509 unless $response->is_success;
1512 my $data = eval { decode_json($response->content) };
1513 die "LRN service JSON error : $@\n" if $@;
1515 if ($data->{error}) {
1516 die "acctid ".$self->acctid." $field LRN lookup failed:\n$data->{error}";
1517 # for testing; later we should respect ignore_unrateable
1518 } elsif ($data->{lrn}) {
1520 $self->set($field.'_lrn', $data->{lrn});
1522 die "acctid ".$self->acctid." $field LRN lookup returned no number.\n";
1525 return $data; # in case it's interesting somehow
1530 =head1 CLASS METHODS
1534 =item invoice_formats
1536 Returns an ordered list of key value pairs containing invoice format names
1537 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
1541 # in the future, load this dynamically from detail_format classes
1543 sub invoice_formats {
1544 map { ($_ => $export_names{$_}->{'name'}) }
1545 grep { $export_names{$_}->{'invoice_header'} }
1546 sort keys %export_names;
1549 =item invoice_header FORMAT
1551 Returns a scalar containing the CSV column header for invoice format FORMAT.
1555 sub invoice_header {
1557 $export_names{$format}->{'invoice_header'};
1562 Clears cdr and any associated cdr_termination statuses - used for
1571 local $SIG{HUP} = 'IGNORE';
1572 local $SIG{INT} = 'IGNORE';
1573 local $SIG{QUIT} = 'IGNORE';
1574 local $SIG{TERM} = 'IGNORE';
1575 local $SIG{TSTP} = 'IGNORE';
1576 local $SIG{PIPE} = 'IGNORE';
1578 my $oldAutoCommit = $FS::UID::AutoCommit;
1579 local $FS::UID::AutoCommit = 0;
1582 if ( $cdr_prerate && $cdr_prerate_cdrtypenums{$self->cdrtypenum}
1583 && $self->rated_ratedetailnum #avoid putting old CDRs back in "rated"
1584 && $self->freesidestatus eq 'done'
1588 $self->freesidestatus('rated');
1590 $self->freesidestatus('');
1593 my $error = $self->replace;
1595 $dbh->rollback if $oldAutoCommit;
1599 foreach my $cdr_termination ( $self->cdr_termination ) {
1600 #$cdr_termination->status('');
1601 #$error = $cdr_termination->replace;
1602 $error = $cdr_termination->delete;
1604 $dbh->rollback if $oldAutoCommit;
1609 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1614 =item import_formats
1616 Returns an ordered list of key value pairs containing import format names
1617 as keys (for use with batch_import) and "pretty" format names as values.
1621 #false laziness w/part_pkg & part_export
1624 foreach my $INC ( @INC ) {
1625 warn "globbing $INC/FS/cdr/[a-z]*.pm\n" if $DEBUG;
1626 foreach my $file ( glob("$INC/FS/cdr/[a-z]*.pm") ) {
1627 warn "attempting to load CDR format info from $file\n" if $DEBUG;
1628 $file =~ /\/(\w+)\.pm$/ or do {
1629 warn "unrecognized file in $INC/FS/cdr/: $file\n";
1633 my $info = eval "use FS::cdr::$mod; ".
1634 "\\%FS::cdr::$mod\::info;";
1636 die "error using FS::cdr::$mod (skipping): $@\n" if $@;
1639 unless ( keys %$info ) {
1640 warn "no %info hash found in FS::cdr::$mod, skipping\n";
1643 warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
1644 if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1645 warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
1648 $cdr_info{$mod} = $info;
1652 tie my %import_formats, 'Tie::IxHash',
1653 map { $_ => $cdr_info{$_}->{'name'} }
1654 sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
1655 grep { exists($cdr_info{$_}->{'import_fields'}) }
1658 sub import_formats {
1662 sub _cdr_min_parser_maker {
1664 my @fields = ref($field) ? @$field : ($field);
1665 @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
1667 my( $cdr, $min ) = @_;
1668 my $sec = eval { _cdr_min_parse($min) };
1669 die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
1670 $cdr->$_($sec) foreach @fields;
1674 sub _cdr_min_parse {
1676 sprintf('%.0f', $min * 60 );
1679 sub _cdr_date_parser_maker {
1682 my @fields = ref($field) ? @$field : ($field);
1684 my( $cdr, $datestring ) = @_;
1685 my $unixdate = eval { _cdr_date_parse($datestring, %options) };
1686 die "error parsing date for @fields from $datestring: $@\n" if $@;
1687 $cdr->$_($unixdate) foreach @fields;
1691 sub _cdr_date_parse {
1695 return '' unless length($date); #that's okay, it becomes NULL
1696 return '' if $date eq 'NA'; #sansay
1698 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 ) {
1699 my $time = str2time($date);
1700 return $time if $time > 100000; #just in case
1703 my($year, $mon, $day, $hour, $min, $sec);
1705 #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
1706 #taqua #2007-10-31 08:57:24.113000000
1708 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|$)/ ) {
1709 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1710 } 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|$)/ ) {
1711 # 8/26/2010 12:20:01
1712 # optionally without seconds
1713 ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1714 $sec = 0 if !defined($sec);
1715 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\.\d+)$/ ) {
1716 # broadsoft: 20081223201938.314
1717 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1718 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\d+(\D|$)/ ) {
1719 # Taqua OM: 20050422203450943
1720 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1721 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) {
1722 # WIP: 20100329121420
1723 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1724 } elsif ( $date =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z$/) {
1725 # Telos 2014-10-10T05:30:33Z
1726 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1729 die "unparsable date: $date"; #maybe we shouldn't die...
1732 return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
1733 && $hour == 0 && $min == 0 && $sec == 0;
1735 if ($options{gmt}) {
1736 timegm($sec, $min, $hour, $day, $mon-1, $year);
1738 timelocal($sec, $min, $hour, $day, $mon-1, $year);
1742 =item batch_import HASHREF
1744 Imports CDR records. Available options are:
1756 Hash reference of preset fields, typically cdrbatch
1760 Set true to prevent throwing an error on empty imports
1766 my %import_options = (
1769 'batch_keycol' => 'cdrbatchnum',
1770 'batch_table' => 'cdr_batch',
1771 'batch_namecol' => 'cdrbatch',
1773 'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
1777 #drop the || 'csv' to allow auto xls for csv types?
1778 'format_types' => { map { $_ => lc($cdr_info{$_}->{'type'} || 'csv'); }
1782 'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
1786 'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
1790 'format_fixedlength_formats' =>
1791 { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
1795 'format_xml_formats' =>
1796 { map { $_ => $cdr_info{$_}->{'xml_format'}; }
1800 'format_asn_formats' =>
1801 { map { $_ => $cdr_info{$_}->{'asn_format'}; }
1805 'format_row_callbacks' =>
1806 { map { $_ => $cdr_info{$_}->{'row_callback'}; }
1810 'format_parser_opts' =>
1811 { map { $_ => $cdr_info{$_}->{'parser_opt'}; }
1816 sub _import_options {
1823 my $iopt = _import_options;
1824 $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
1826 if ( defined $opt->{'cdrtypenum'} ) {
1827 $opt->{'preinsert_callback'} = sub {
1828 my($record,$param) = (shift,shift);
1829 $record->cdrtypenum($opt->{'cdrtypenum'});
1834 FS::Record::batch_import( $opt );
1838 =item process_batch_import
1842 sub process_batch_import {
1845 my $opt = _import_options;
1846 # $opt->{'params'} = [ 'format', 'cdrbatch' ];
1848 FS::Record::process_batch_import( $job, $opt, @_ );
1851 # if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
1852 # @columns = map { s/^ +//; $_; } @columns;
1857 # Used by FS::Upgrade to migrate to a new database.
1860 my ($class, %opts) = @_;
1862 warn "$me upgrading $class\n" if $DEBUG;
1864 my $sth = dbh->prepare(
1865 'SELECT DISTINCT(cdrbatch) FROM cdr WHERE cdrbatch IS NOT NULL'
1866 ) or die dbh->errstr;
1868 $sth->execute or die $sth->errstr;
1870 my %cdrbatchnum = ();
1871 while (my $row = $sth->fetchrow_arrayref) {
1873 my $cdr_batch = qsearchs( 'cdr_batch', { 'cdrbatch' => $row->[0] } );
1874 unless ( $cdr_batch ) {
1875 $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] };
1876 my $error = $cdr_batch->insert;
1877 die $error if $error;
1880 $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum;
1883 $sth = dbh->prepare('UPDATE cdr SET cdrbatch = NULL, cdrbatchnum = ? WHERE cdrbatch IS NOT NULL AND cdrbatch = ?') or die dbh->errstr;
1885 foreach my $cdrbatch (keys %cdrbatchnum) {
1886 $sth->execute($cdrbatchnum{$cdrbatch}, $cdrbatch) or die $sth->errstr;
1891 =item ip_addr_sql FIELD RANGE
1893 Returns an SQL condition to search for CDRs with an IP address
1894 within RANGE. FIELD is either 'src_ip_addr' or 'dst_ip_addr'. RANGE
1895 should be in the form "a.b.c.d-e.f.g.h' (dotted quads), where any of
1896 the leftmost octets of the second address can be omitted if they're
1897 the same as the first address.
1903 my ($field, $range) = @_;
1904 $range =~ /^[\d\.-]+$/ or die "bad ip address range '$range'";
1905 my @r = split('-', $range);
1906 my @saddr = split('\.', $r[0] || '');
1907 my @eaddr = split('\.', $r[1] || '');
1908 unshift @eaddr, (undef) x (4 - scalar @eaddr);
1910 $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
1912 "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
1913 "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
1922 L<FS::Record>, schema.html from the base documentation.