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);
32 use JSON::XS qw(decode_json);
34 @ISA = qw(FS::Record);
35 @EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker _cdr_date_parse );
40 #ask FS::UID to run this stuff for us later
41 FS::UID->install_callback( sub {
44 my @cdr_prerate_cdrtypenums;
45 $cdr_prerate = $conf->exists('cdr-prerate');
46 @cdr_prerate_cdrtypenums = $conf->config('cdr-prerate-cdrtypenums')
48 %cdr_prerate_cdrtypenums = map { $_=>1 } @cdr_prerate_cdrtypenums;
50 $support_key = $conf->config('support-key');
51 $use_lrn = $conf->exists('cdr-lrn_lookup');
57 FS::cdr - Object methods for cdr records
63 $record = new FS::cdr \%hash;
64 $record = new FS::cdr { 'column' => 'value' };
66 $error = $record->insert;
68 $error = $new_record->replace($old_record);
70 $error = $record->delete;
72 $error = $record->check;
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:
82 =item acctid - primary key
84 =item calldate - Call timestamp (SQL timestamp)
86 =item clid - Caller*ID with text
88 =item src - Caller*ID number / Source number
90 =item dst - Destination extension
92 =item dcontext - Destination context
94 =item channel - Channel used
96 =item dstchannel - Destination channel if appropriate
98 =item lastapp - Last application if appropriate
100 =item lastdata - Last application data
102 =item src_ip_addr - Source IP address (dotted quad, zero-filled)
104 =item dst_ip_addr - Destination IP address (same)
106 =item dst_term - Terminating destination number (if different from dst)
108 =item startdate - Start of call (UNIX-style integer timestamp)
110 =item answerdate - Answer time of call (UNIX-style integer timestamp)
112 =item enddate - End time of call (UNIX-style integer timestamp)
114 =item duration - Total time in system, in seconds
116 =item billsec - Total time call is up, in seconds
118 =item disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
120 =item amaflags - What flags to use: BILL, IGNORE etc, specified on a per channel basis like accountcode.
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.
131 =item accountcode - CDR account number to use: account
133 =item uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
135 =item userfield - CDR user-defined field
137 =item cdr_type - CDR type - see L<FS::cdr_type> (Usage = 1, S&E = 7, OC&C = 8)
139 =item charged_party - Service number to be billed
141 =item upstream_currency - Wholesale currency from upstream
143 =item upstream_price - Wholesale price from upstream
145 =item upstream_rateplanid - Upstream rate plan ID
147 =item rated_price - Rated (or re-rated) price
149 =item distance - km (need units field?)
151 =item islocal - Local - 1, Non Local = 0
153 =item calltypenum - Type of call - see L<FS::cdr_calltype>
155 =item description - Description (cdr_type 7&8 only) (used for cust_bill_pkg.itemdesc)
157 =item quantity - Number of items (cdr_type 7&8 only)
159 =item carrierid - Upstream Carrier ID (see L<FS::cdr_carrier>)
163 #Telstra =1, Optus = 2, RSL COM = 3
165 =item upstream_rateid - Upstream Rate ID
167 =item svcnum - Link to customer service (see L<FS::cust_svc>)
169 =item freesidestatus - NULL, processing-tiered, rated, done, skipped, no-charge, failed
171 =item freesiderewritestatus - NULL, done, skipped
175 =item detailnum - Link to invoice detail (L<FS::cust_bill_pkg_detail>)
185 Creates a new CDR. To add the CDR to the database, see L<"insert">.
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.
192 # the new method can be inherited from FS::Record, if a table method is defined
199 #XXX fill in some (more) nice names
201 'calldate' => 'Call date',
202 'clid' => 'Caller ID',
204 'dst' => 'Destination',
205 'dcontext' => 'Dest. context',
206 'channel' => 'Channel',
207 'dstchannel' => 'Destination channel',
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',
222 'userfield' => 'User field',
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',
235 #'calltypenum' => '',
236 #'description' => '',
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',
254 Adds this record to the database. If there is an error, returns the error,
255 otherwise returns false.
259 # the insert method can be inherited from FS::Record
263 Delete this record from the database.
267 # the delete method can be inherited from FS::Record
269 =item replace OLD_RECORD
271 Replaces the OLD_RECORD with this one in the database. If there is an error,
272 returns the error, otherwise returns false.
276 # the replace method can be inherited from FS::Record
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
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
293 # we don't want to "reject" a CDR like other sorts of input...
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')
331 # return $error if $error;
333 for my $f ( grep { $self->$_ =~ /\D/ } qw(startdate answerdate enddate)){
334 $self->$f( str2time($self->$f) );
337 $self->calldate( $self->startdate_sql )
338 if !$self->calldate && $self->startdate;
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 );
345 if ( $self->billsec eq '' && $self->enddate && $self->answerdate ) {
346 $self->billsec( $self->enddate - $self->answerdate );
349 if ( ! $self->enddate && $self->startdate && $self->duration ) {
350 $self->enddate( $self->startdate + $self->duration );
353 $self->set_charged_party;
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;
360 if ( $self->freesidestatus ne 'done' ) {
361 $self->set('detailnum', ''); # can't have this on an unbilled call
364 #add a config option to turn these back on if someone needs 'em
366 # #Usage = 1, S&E = 7, OC&C = 8
367 # || $self->ut_foreign_keyn('cdrtypenum', 'cdr_type', 'cdrtypenum' )
369 # #the big list in appendix 2
370 # || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
372 # # Telstra =1, Optus = 2, RSL COM = 3
373 # || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
378 =item is_tollfree [ COLUMN ]
380 Returns true when the cdr represents a toll free number and false otherwise.
382 By default, inspects the dst field, but an optional column name can be passed
383 to inspect other field.
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;
400 =item set_charged_party
402 If the charged_party field is already set, does nothing. Otherwise:
404 If the cdr-charged_party-accountcode config option is enabled, sets the
405 charged_party to the accountcode.
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.
412 sub set_charged_party {
415 my $conf = new FS::Conf;
417 unless ( $self->charged_party ) {
419 if ( $conf->exists('cdr-charged_party-accountcode') && $self->accountcode ){
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 );
426 } elsif ( $conf->exists('cdr-charged_party-field') ) {
428 my $field = $conf->config('cdr-charged_party-field');
429 $self->charged_party( $self->$field() );
433 if ( $self->is_tollfree ) {
434 $self->charged_party($self->dst);
436 $self->charged_party($self->src);
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');
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;
453 =item set_status STATUS
455 Sets the status to the provided string. If there is an error, returns the
456 error, otherwise returns false.
458 If status is being changed from 'rated' to some other status, also removes
459 any usage allocations to this CDR.
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;
479 =item set_status_and_rated_price STATUS RATED_PRICE [ SVCNUM [ OPTION => VALUE ... ] ]
481 Sets the status and rated price.
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.)
489 If there is an error, returns the error, otherwise returns false.
493 sub set_status_and_rated_price {
494 my($self, $status, $rated_price, $svcnum, %opt) = @_;
496 if ($opt{'inbound'}) {
498 my $term = $self->cdr_termination( 1 ); #1: inbound
501 warn "replacing existing cdr status (".$self->acctid.")\n" if $term;
502 $error = $term->delete;
503 return $error if $error;
505 $term = FS::cdr_termination->new({
506 acctid => $self->acctid,
508 rated_price => $rated_price,
511 foreach (qw(rated_seconds rated_minutes rated_granularity)) {
512 $term->set($_, $opt{$_}) if exists($opt{$_});
514 $term->svcnum($svcnum) if $svcnum;
515 return $term->insert;
519 $self->freesidestatus($status);
520 $self->rated_price($rated_price);
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'};
528 return $self->replace();
533 =item parse_number [ OPTION => VALUE ... ]
535 Returns two scalars, the countrycode and the rest of the number.
537 Options are passed as name-value pairs. Currently available options are:
543 The column containing the number to be parsed. Defaults to dst.
545 =item international_prefix
547 The digits for international dialing. Defaults to '011' The value '+' is
550 =item domestic_prefix
552 The digits for domestic long distance dialing. Defaults to '1'
559 my ($self, %options) = @_;
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();
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;
574 #remove non-phone# stuff and whitespace
577 # $dest =~ s/^(\w+):// and $proto = $1; #sip:
579 # $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
581 if ( $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
582 || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
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 } ) ) {
590 $number = $u1.$u2.$rest;
591 } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
594 } else { #3 digit country code
595 $countrycode = $three;
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;
606 return($countrycode, $number);
610 =item rate [ OPTION => VALUE ... ]
612 Rates this CDR according and sets the status to 'rated'.
614 Available options are: part_pkg, svcnum, plan_included_min,
615 detail_included_min_hashref.
617 part_pkg is required.
619 If svcnum is specified, will also associate this CDR with the specified svcnum.
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
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.
631 my( $self, %opt ) = @_;
632 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
635 warn "rating CDR $self\n".
636 join('', map { " $_ => ". $self->{$_}. "\n" } keys %$self );
639 my $rating_method = $part_pkg->option_cacheable('rating_method') || 'prefix';
640 my $method = "rate_$rating_method";
641 $self->$method(%opt);
645 our %interval_cache = (); # for timed rates
648 my( $self, %opt ) = @_;
649 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
650 my $cust_pkg = $opt{'cust_pkg'};
653 # this will result in those CDRs being marked as done... is that
656 if ( $part_pkg->option_cacheable('411_rewrite') ) {
657 my $dirass = $part_pkg->option_cacheable('411_rewrite');
659 @dirass = split(',', $dirass);
662 if ( length($self->dst) && grep { $self->dst eq $_ } @dirass ) {
667 my $reason = $part_pkg->check_chargable( $self,
668 'da_rewrote' => $da_rewrote,
671 warn "not charging for CDR ($reason)\n" if $DEBUG;
672 return $self->set_status_and_rated_price( 'skipped',
678 if ( $part_pkg->option_cacheable('skip_same_customer')
679 and ! $self->is_tollfree ) {
680 my ($dst_countrycode, $dst_number) = $self->parse_number(
682 international_prefix => $part_pkg->option_cacheable('international_prefix'),
683 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
685 my $dst_same_cust = FS::Record->scalar_sql(
686 'SELECT COUNT(svc_phone.svcnum) AS count '.
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,
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',
704 # look up rate details based on called station id
705 # (or calling station id for toll free calls)
708 my $eff_ratenum = $self->is_tollfree('accountcode')
709 ? $part_pkg->option_cacheable('accountcode_tollfree_ratenum')
712 my( $to_or_from, $column );
715 && ! $part_pkg->option_cacheable('disable_tollfree')
718 && $part_pkg->option_cacheable('accountcode_tollfree_field') eq 'src'
722 $to_or_from = 'from';
724 } else { #regular call
729 #determine the country code
730 my ($countrycode, $number) = $self->parse_number(
732 international_prefix => $part_pkg->option_cacheable('international_prefix'),
733 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
737 my $intrastate_ratenum = $part_pkg->option_cacheable('intrastate_ratenum');
739 if ( $use_lrn and $countrycode eq '1' ) {
741 # then ask about the number
742 foreach my $field ('src', 'dst') {
744 $self->get_lrn($field);
745 if ( $field eq $column ) {
746 # then we are rating on this number
747 $number = $self->get($field.'_lrn');
749 # is this ever meaningful? can the LRN be outside NANP space?
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;
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(
774 international_prefix => $part_pkg->option_cacheable('international_prefix'),
775 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
777 $dstprefix =~ /^(\d{6})/;
778 $dstprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
781 my (undef, $srcprefix) = $self->parse_number(
783 international_prefix => $part_pkg->option_cacheable('international_prefix'),
784 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
786 $srcprefix =~ /^(\d{6})/;
787 $srcprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
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?
798 $eff_ratenum ||= $part_pkg->option_cacheable('ratenum');
799 my $rate = qsearchs('rate', { 'ratenum' => $eff_ratenum })
800 or die "ratenum $eff_ratenum not found!";
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,
816 unless ( $rate_detail ) {
818 if ( $part_pkg->option_cacheable('ignore_unrateable') ) {
820 if ( $part_pkg->option_cacheable('ignore_unrateable') == 2 ) {
821 # mark the CDR as unrateable
822 return $self->set_status_and_rated_price(
827 } elsif ( $part_pkg->option_cacheable('ignore_unrateable') == 1 ) {
829 warn "no rate_detail found for CDR.acctid: ". $self->acctid.
834 die "unknown ignore_unrateable, pkgpart ". $part_pkg->pkgpart;
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";
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"
853 if ( !exists($interval_cache{$regionnum}) ) {
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',
862 $interval_cache{$regionnum} = \@intervals;
863 warn " cached ".scalar(@intervals)." interval(s)\n"
868 # find the price and add detail to the invoice
871 # About this section:
872 # We don't round _anything_ (except granularizing)
873 # until the final $charge = sprintf("%.2f"...).
875 my $rated_seconds = $part_pkg->option_cacheable('use_duration')
878 my $seconds_left = $rated_seconds;
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;
888 my $connection_charged = 0;
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;
896 while($seconds_left) {
897 my $ratetimenum = $rate_detail->ratetimenum; # may be empty
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;
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;
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} };
919 $etime = $next_int->stime;
922 # weektime is near the end of the week, so decrement
923 # it by a full week and use the stime of the first
925 $weektime -= (3600*24*7);
926 $etime = $interval_cache{$regionnum}->[0]->stime;
930 my $charge_sec = min($seconds_left, $etime - $weektime);
932 $seconds_left -= $charge_sec;
934 my $granularity = $rate_detail->sec_granularity;
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);
942 $minutes = $charge_sec / 60; #don't round this
949 #$seconds += $charge_sec;
951 if ( $rate_detail->min_included ) {
952 # the old, kind of deprecated way to do this:
954 # The rate detail itself has included minutes. We MUST have a place
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";
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);
967 if ( $included_min->{$regionnum}{$ratetimenum} >= $minutes ) {
969 $included_min->{$regionnum}{$ratetimenum} -= $minutes;
971 $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60);
972 $included_min->{$regionnum}{$ratetimenum} = 0;
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 ) {
980 ${ $opt{'plan_included_min'} } -= $minutes;
982 $charge_sec -= (${ $opt{'plan_included_min'} } * 60);
983 ${ $opt{'plan_included_min'} } = 0;
988 my $applied_min = $cust_pkg->apply_usage(
990 'rate_detail' => $rate_detail,
991 'minutes' => $minutes
993 # for now, usage pools deal only in whole minutes
994 $charge_sec -= $applied_min * 60;
997 if ( $charge_sec > 0 ) {
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;
1009 #should preserve (display?) this
1010 if ( $granularity == 0 ) { # per call rate
1011 $charge += $rate_detail->min_charge;
1013 my $charge_min = ( $charge_sec - $conn_seconds ) / 60;
1014 $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
1019 # choose next rate_detail
1020 $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
1021 'phonenum' => $number,
1022 'weektime' => $etime,
1023 'cdrtypenum' => $self->cdrtypenum })
1025 # we have now moved forward to $etime
1028 } #while $seconds_left
1030 # this is why we need regionnum/rate_region....
1031 warn " (rate region $rate_region)\n" if $DEBUG;
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);
1039 $self->set_status_and_rated_price(
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
1054 sub rate_upstream_simple {
1055 my( $self, %opt ) = @_;
1057 $self->set_status_and_rated_price(
1059 sprintf('%.3f', $self->upstream_price),
1061 'rated_classnum' => $self->calltypenum,
1062 'rated_seconds' => $self->billsec,
1063 # others? upstream_*_regionname => rated_regionname is possible
1067 sub rate_single_price {
1068 my( $self, %opt ) = @_;
1069 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
1071 # a little false laziness w/abov
1072 # $rate_detail = new FS::rate_detail({sec_granularity => ... }) ?
1074 my $granularity = length($part_pkg->option_cacheable('sec_granularity'))
1075 ? $part_pkg->option_cacheable('sec_granularity')
1078 my $seconds = $part_pkg->option_cacheable('use_duration')
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;
1088 my $charge_min = $minutes;
1090 ${$opt{plan_included_min}} -= $minutes;
1091 if ( ${$opt{plan_included_min}} > 0 ) {
1094 $charge_min = 0 - ${$opt{plan_included_min}};
1095 ${$opt{plan_included_min}} = 0;
1099 sprintf('%.4f', ( $part_pkg->option_cacheable('min_charge') * $charge_min )
1100 + 0.0000000001 ); #so 1.00005 rounds to 1.0001
1102 $self->set_status_and_rated_price(
1106 'rated_granularity' => $granularity,
1107 'rated_seconds' => $seconds,
1114 Rates an already-rated CDR according to the cost fields from the rate plan.
1123 return 0 unless $self->rated_ratedetailnum;
1126 qsearchs('rate_detail', { 'ratedetailnum' => $self->rated_ratedetailnum } );
1129 $charge += ($self->upstream_price || 0) * ($rate_detail->upstream_mult_cost);
1131 if ( $self->rated_granularity == 0 ) {
1132 $charge += $rate_detail->min_cost;
1134 my $minutes = $self->rated_seconds / 60;
1135 $charge += $rate_detail->conn_cost + $minutes * $rate_detail->min_cost;
1138 sprintf('%.2f', $charge + .00001 );
1142 =item cdr_termination [ TERMPART ]
1146 sub cdr_termination {
1149 if ( scalar(@_) && $_[0] ) {
1150 my $termpart = shift;
1152 qsearchs('cdr_termination', { acctid => $self->acctid,
1153 termpart => $termpart,
1159 qsearch('cdr_termination', { acctid => $self->acctid, } );
1167 Parses the calldate in SQL string format and returns a UNIX timestamp.
1172 str2time(shift->calldate);
1177 Parses the startdate in UNIX timestamp format and returns a string in SQL
1183 my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
1186 "$year-$mon-$mday $hour:$min:$sec";
1191 Returns the FS::cdr_carrier object associated with this CDR, or false if no
1192 carrierid is defined.
1196 my %carrier_cache = ();
1200 return '' unless $self->carrierid;
1201 $carrier_cache{$self->carrierid} ||=
1202 qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
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.
1214 my $cdr_carrier = $self->cdr_carrier;
1215 $cdr_carrier ? $cdr_carrier->carriername : '';
1220 Returns the FS::cdr_calltype object associated with this CDR, or false if no
1221 calltypenum is defined.
1225 my %calltype_cache = ();
1229 return '' unless $self->calltypenum;
1230 $calltype_cache{$self->calltypenum} ||=
1231 qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
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.
1243 my $cdr_calltype = $self->cdr_calltype;
1244 $cdr_calltype ? $cdr_calltype->calltypename : '';
1247 =item downstream_csv [ OPTION => VALUE, ... ]
1251 # in the future, load this dynamically from detail_format classes
1253 my %export_names = (
1256 'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
1259 'name' => 'Simple with source',
1260 'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
1261 #"Date,Time,Name,Called From,Destination,Duration,Price",
1263 'accountcode_simple' => {
1264 'name' => 'Simple with accountcode',
1265 'invoice_header' => "Date,Time,Called From,Account,Duration,Price",
1269 'invoice_header' => "Date/Time,Called Number,Min/Sec,Price",
1271 'basic_upstream_dst_regionname' => {
1272 'name' => 'Basic with upstream destination name',
1273 'invoice_header' => "Date/Time,Called Number,Destination,Min/Sec,Price",
1276 'name' => 'Default',
1277 'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
1279 'source_default' => {
1280 'name' => 'Default with source',
1281 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1283 'accountcode_default' => {
1284 'name' => 'Default plus accountcode',
1285 'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
1287 'description_default' => {
1288 'name' => 'Default with description field as destination',
1289 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1292 'name' => 'Summary, one line per service',
1293 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1296 'name' => 'Number of calls, one line per service',
1297 'invoice_header' => 'Caller,Rate,Messages,Price',
1300 'name' => 'Summary, one line per service',
1301 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1303 'sum_duration_prefix' => {
1304 'name' => 'Summary, one line per destination prefix',
1305 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1307 'sum_count_class' => {
1308 'name' => 'Summary, one line per usage class',
1309 'invoice_header' => 'Caller,Class,Calls,Price',
1311 'sum_duration_accountcode' => {
1312 'name' => 'Summary, one line per accountcode',
1313 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1317 my %export_formats = ();
1318 sub export_formats {
1321 return %export_formats if keys %export_formats;
1323 my $conf = new FS::Conf;
1324 my $date_format = $conf->config('date_format') || '%m/%d/%Y';
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
1334 elsif ( defined $opt{granularity} && $opt{granularity} == 60 ) {#full minutes
1335 my $min = int($sec/60);
1339 else { #anything else
1340 return sprintf("%dm %ds", $sec/60, $sec%60);
1344 my $price_sub = sub {
1345 my ($cdr, %opt) = @_;
1347 if ( defined($opt{charge}) ) {
1348 $price = $opt{charge};
1350 elsif ( $opt{inbound} ) {
1351 my $term = $cdr->cdr_termination(1); # 1 = inbound
1352 $price = $term->rated_price if defined $term;
1355 $price = $cdr->rated_price;
1357 length($price) ? ($opt{money_char} . $price) : '';
1360 my $src_sub = sub { $_[0]->clid || $_[0]->src };
1364 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1365 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1367 'dst', #NUMBER_DIALED
1368 $duration_sub, #DURATION
1369 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1373 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1374 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1376 $src_sub, #called from
1377 'dst', #NUMBER_DIALED
1378 $duration_sub, #DURATION
1379 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
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
1391 # for summary formats, the CDR is a fictitious object containing the
1392 # total billsec and the phone number of the service
1394 sub { my($cdr, %opt) = @_; $opt{ratename} },
1395 sub { my($cdr, %opt) = @_; $opt{count} },
1396 sub { my($cdr, %opt) = @_; int($opt{seconds}/60).'m' },
1401 sub { my($cdr, %opt) = @_; $opt{ratename} },
1402 sub { my($cdr, %opt) = @_; $opt{count} },
1406 sub { time2str('%d %b - %I:%M %p', shift->calldate_unix) },
1414 sub { time2str($date_format, shift->calldate_unix ) },
1415 # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
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
1422 sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
1424 #REGIONNAME ("Destination")
1425 sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
1434 $export_formats{'source_default'} = [ $src_sub, @{ $export_formats{'default'} }, ];
1435 $export_formats{'accountcode_default'} =
1436 [ @{ $export_formats{'default'} }[0,1],
1438 @{ $export_formats{'default'} }[2..5],
1440 my @default = @{ $export_formats{'default'} };
1441 $export_formats{'description_default'} =
1442 [ $src_sub, @default[0..2],
1443 sub { my($cdr, %opt) = @_; $cdr->description },
1446 return %export_formats;
1449 =item downstream_csv OPTION => VALUE ...
1451 Returns a string of formatted call details for display on an invoice.
1457 charge - override the 'rated_price' field of the CDR
1459 seconds - override the 'billsec' field of the CDR
1461 count - number of usage events included in this record, for summary formats
1463 ratename - name of the rate table used to rate this call
1469 sub downstream_csv {
1470 my( $self, %opt ) = @_;
1472 my $format = $opt{'format'};
1473 my %formats = $self->export_formats;
1474 return "Unknown format $format" unless exists $formats{$format};
1476 #my $conf = new FS::Conf;
1477 #$opt{'money_char'} ||= $conf->config('money_char') || '$';
1478 $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
1480 my $csv = new Text::CSV_XS;
1484 ref($_) ? &{$_}($self, %opt) : $self->$_();
1486 @{ $formats{$format} };
1488 return @columns if defined $opt{'keeparray'};
1490 my $status = $csv->combine(@columns);
1491 die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
1502 my $ua = LWP::UserAgent->new(
1504 verify_hostname => 0,
1505 SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
1509 my $url = 'https://ws.freeside.biz/get_lrn';
1511 my %content = ( 'support-key' => $support_key,
1512 'tn' => $self->get($field),
1514 my $response = $ua->request( POST $url, \%content );
1516 die "LRN service error: ". $response->message. "\n"
1517 unless $response->is_success;
1520 my $data = eval { decode_json($response->content) };
1521 die "LRN service JSON error : $@\n" if $@;
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}) {
1528 $self->set($field.'_lrn', $data->{lrn});
1530 die "acctid ".$self->acctid." $field LRN lookup returned no number.\n";
1533 return $data; # in case it's interesting somehow
1538 =head1 CLASS METHODS
1542 =item invoice_formats
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.
1549 # in the future, load this dynamically from detail_format classes
1551 sub invoice_formats {
1552 map { ($_ => $export_names{$_}->{'name'}) }
1553 grep { $export_names{$_}->{'invoice_header'} }
1554 sort keys %export_names;
1557 =item invoice_header FORMAT
1559 Returns a scalar containing the CSV column header for invoice format FORMAT.
1563 sub invoice_header {
1565 $export_names{$format}->{'invoice_header'};
1570 Clears cdr and any associated cdr_termination statuses - used for
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';
1586 my $oldAutoCommit = $FS::UID::AutoCommit;
1587 local $FS::UID::AutoCommit = 0;
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'
1596 $self->freesidestatus('rated');
1598 $self->freesidestatus('');
1601 my $error = $self->replace;
1603 $dbh->rollback if $oldAutoCommit;
1607 foreach my $cdr_termination ( $self->cdr_termination ) {
1608 #$cdr_termination->status('');
1609 #$error = $cdr_termination->replace;
1610 $error = $cdr_termination->delete;
1612 $dbh->rollback if $oldAutoCommit;
1617 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1622 =item import_formats
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.
1629 #false laziness w/part_pkg & part_export
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";
1641 my $info = eval "use FS::cdr::$mod; ".
1642 "\\%FS::cdr::$mod\::info;";
1644 die "error using FS::cdr::$mod (skipping): $@\n" if $@;
1647 unless ( keys %$info ) {
1648 warn "no %info hash found in FS::cdr::$mod, skipping\n";
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;
1656 $cdr_info{$mod} = $info;
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'}) }
1666 sub import_formats {
1670 sub _cdr_min_parser_maker {
1672 my @fields = ref($field) ? @$field : ($field);
1673 @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
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;
1682 sub _cdr_min_parse {
1684 sprintf('%.0f', $min * 60 );
1687 sub _cdr_date_parser_maker {
1690 my @fields = ref($field) ? @$field : ($field);
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;
1699 sub _cdr_date_parse {
1703 return '' unless length($date); #that's okay, it becomes NULL
1704 return '' if $date eq 'NA'; #sansay
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
1711 my($year, $mon, $day, $hour, $min, $sec);
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
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 );
1737 die "unparsable date: $date"; #maybe we shouldn't die...
1740 return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
1741 && $hour == 0 && $min == 0 && $sec == 0;
1743 if ($options{gmt}) {
1744 timegm($sec, $min, $hour, $day, $mon-1, $year);
1746 timelocal($sec, $min, $hour, $day, $mon-1, $year);
1750 =item batch_import HASHREF
1752 Imports CDR records. Available options are:
1764 Hash reference of preset fields, typically cdrbatch
1768 Set true to prevent throwing an error on empty imports
1774 my %import_options = (
1777 'batch_keycol' => 'cdrbatchnum',
1778 'batch_table' => 'cdr_batch',
1779 'batch_namecol' => 'cdrbatch',
1781 'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
1785 #drop the || 'csv' to allow auto xls for csv types?
1786 'format_types' => { map { $_ => lc($cdr_info{$_}->{'type'} || 'csv'); }
1790 'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
1794 'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
1798 'format_fixedlength_formats' =>
1799 { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
1803 'format_xml_formats' =>
1804 { map { $_ => $cdr_info{$_}->{'xml_format'}; }
1808 'format_asn_formats' =>
1809 { map { $_ => $cdr_info{$_}->{'asn_format'}; }
1813 'format_row_callbacks' =>
1814 { map { $_ => $cdr_info{$_}->{'row_callback'}; }
1818 'format_parser_opts' =>
1819 { map { $_ => $cdr_info{$_}->{'parser_opt'}; }
1824 sub _import_options {
1831 my $iopt = _import_options;
1832 $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
1834 if ( defined $opt->{'cdrtypenum'} ) {
1835 $opt->{'preinsert_callback'} = sub {
1836 my($record,$param) = (shift,shift);
1837 $record->cdrtypenum($opt->{'cdrtypenum'});
1842 FS::Record::batch_import( $opt );
1846 =item process_batch_import
1850 sub process_batch_import {
1853 my $opt = _import_options;
1854 # $opt->{'params'} = [ 'format', 'cdrbatch' ];
1856 FS::Record::process_batch_import( $job, $opt, @_ );
1859 # if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
1860 # @columns = map { s/^ +//; $_; } @columns;
1865 # Used by FS::Upgrade to migrate to a new database.
1868 my ($class, %opts) = @_;
1870 warn "$me upgrading $class\n" if $DEBUG;
1872 my $sth = dbh->prepare(
1873 'SELECT DISTINCT(cdrbatch) FROM cdr WHERE cdrbatch IS NOT NULL'
1874 ) or die dbh->errstr;
1876 $sth->execute or die $sth->errstr;
1878 my %cdrbatchnum = ();
1879 while (my $row = $sth->fetchrow_arrayref) {
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;
1888 $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum;
1891 $sth = dbh->prepare('UPDATE cdr SET cdrbatch = NULL, cdrbatchnum = ? WHERE cdrbatch IS NOT NULL AND cdrbatch = ?') or die dbh->errstr;
1893 foreach my $cdrbatch (keys %cdrbatchnum) {
1894 $sth->execute($cdrbatchnum{$cdrbatch}, $cdrbatch) or die $sth->errstr;
1899 =item ip_addr_sql FIELD RANGE
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.
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);
1918 $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
1920 "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
1921 "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
1930 L<FS::Record>, schema.html from the base documentation.