4 use vars qw( @ISA @EXPORT_OK $DEBUG $me
5 $conf $cdr_prerate %cdr_prerate_cdrtypenums
6 $use_lrn $support_key $max_duration
7 $cp_accountcode $cp_accountcode_trim0s $cp_field
11 use List::Util qw(first min);
16 use List::Util qw( first min );
18 use FS::UID qw( dbh );
20 use FS::Record qw( qsearch qsearchs );
25 use FS::cdr_termination;
32 use HTTP::Request::Common qw(POST);
34 use Cpanel::JSON::XS qw(decode_json);
36 @ISA = qw(FS::Record);
37 @EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker _cdr_date_parse );
42 #ask FS::UID to run this stuff for us later
43 FS::UID->install_callback( sub {
46 my @cdr_prerate_cdrtypenums;
47 $cdr_prerate = $conf->exists('cdr-prerate');
48 @cdr_prerate_cdrtypenums = $conf->config('cdr-prerate-cdrtypenums')
50 %cdr_prerate_cdrtypenums = map { $_=>1 } @cdr_prerate_cdrtypenums;
52 $support_key = $conf->config('support-key');
53 $use_lrn = $conf->exists('cdr-lrn_lookup');
55 $max_duration = $conf->config('cdr-max_duration') || 0;
57 $cp_accountcode = $conf->exists('cdr-charged_party-accountcode');
58 $cp_accountcode_trim0s = $conf->exists('cdr-charged_party-accountcode-trim_leading_0s');
60 $cp_field = $conf->config('cdr-charged_party-field');
62 $tollfree_country = $conf->config('tollfree-country') || '';
68 FS::cdr - Object methods for cdr records
74 $record = new FS::cdr \%hash;
75 $record = new FS::cdr { 'column' => 'value' };
77 $error = $record->insert;
79 $error = $new_record->replace($old_record);
81 $error = $record->delete;
83 $error = $record->check;
87 An FS::cdr object represents an Call Data Record, typically from a telephony
88 system or provider of some sort. FS::cdr inherits from FS::Record. The
89 following fields are currently supported:
93 =item acctid - primary key
95 =item calldate - Call timestamp (SQL timestamp)
97 =item clid - Caller*ID with text
99 =item src - Caller*ID number / Source number
101 =item dst - Destination extension
103 =item dcontext - Destination context
105 =item channel - Channel used
107 =item dstchannel - Destination channel if appropriate
109 =item lastapp - Last application if appropriate
111 =item lastdata - Last application data
113 =item src_ip_addr - Source IP address (dotted quad, zero-filled)
115 =item dst_ip_addr - Destination IP address (same)
117 =item dst_term - Terminating destination number (if different from dst)
119 =item startdate - Start of call (UNIX-style integer timestamp)
121 =item answerdate - Answer time of call (UNIX-style integer timestamp)
123 =item enddate - End time of call (UNIX-style integer timestamp)
125 =item duration - Total time in system, in seconds
127 =item billsec - Total time call is up, in seconds
129 =item disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
131 =item amaflags - What flags to use: BILL, IGNORE etc, specified on a per channel basis like accountcode.
135 #ignore the "omit" and "documentation" AMAs??
136 #AMA = Automated Message Accounting.
137 #default: Sets the system default.
138 #omit: Do not record calls.
139 #billing: Mark the entry for billing
140 #documentation: Mark the entry for documentation.
142 =item accountcode - CDR account number to use: account
144 =item uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
146 =item userfield - CDR user-defined field
148 =item cdr_type - CDR type - see L<FS::cdr_type> (Usage = 1, S&E = 7, OC&C = 8)
150 =item charged_party - Service number to be billed
152 =item upstream_currency - Wholesale currency from upstream
154 =item upstream_price - Wholesale price from upstream
156 =item upstream_rateplanid - Upstream rate plan ID
158 =item rated_price - Rated (or re-rated) price
160 =item distance - km (need units field?)
162 =item islocal - Local - 1, Non Local = 0
164 =item calltypenum - Type of call - see L<FS::cdr_calltype>
166 =item description - Description (cdr_type 7&8 only) (used for cust_bill_pkg.itemdesc)
168 =item quantity - Number of items (cdr_type 7&8 only)
170 =item carrierid - Upstream Carrier ID (see L<FS::cdr_carrier>)
174 #Telstra =1, Optus = 2, RSL COM = 3
176 =item upstream_rateid - Upstream Rate ID
178 =item svcnum - Link to customer service (see L<FS::cust_svc>)
180 =item freesidestatus - NULL, processing-tiered, rated, done, skipped, no-charge, failed
182 =item freesiderewritestatus - NULL, done, skipped
186 =item detailnum - Link to invoice detail (L<FS::cust_bill_pkg_detail>)
196 Creates a new CDR. To add the CDR to the database, see L<"insert">.
198 Note that this stores the hash reference, not a distinct copy of the hash it
199 points to. You can ask the object for a copy with the I<hash> method.
203 # the new method can be inherited from FS::Record, if a table method is defined
210 #XXX fill in some (more) nice names
212 'calldate' => 'Call date',
213 'clid' => 'Caller ID',
215 'dst' => 'Destination',
216 'dcontext' => 'Dest. context',
217 'channel' => 'Channel',
218 'dstchannel' => 'Destination channel',
221 'src_ip_addr' => 'Source IP',
222 'dst_ip_addr' => 'Dest. IP',
223 'dst_term' => 'Termination dest.',
224 'startdate' => 'Start date',
225 'answerdate' => 'Answer date',
226 'enddate' => 'End date',
227 'duration' => 'Duration',
228 'billsec' => 'Billable seconds',
229 'disposition' => 'Disposition',
230 'amaflags' => 'AMA flags',
231 'accountcode' => 'Account code',
233 'userfield' => 'User field',
235 'charged_party' => 'Charged party',
236 #'upstream_currency' => '',
237 'upstream_price' => 'Upstream price',
238 #'upstream_rateplanid' => '',
239 #'ratedetailnum' => '',
240 'src_lrn' => 'Source LRN',
241 'dst_lrn' => 'Dest. LRN',
242 'rated_price' => 'Rated price',
243 'rated_cost' => 'Rated cost',
246 #'calltypenum' => '',
247 #'description' => '',
249 'carrierid' => 'Carrier ID',
250 #'upstream_rateid' => '',
251 'svcnum' => 'Freeside service',
252 'freesidestatus' => 'Freeside status',
253 'freesiderewritestatus' => 'Freeside rewrite status',
254 'cdrbatch' => 'Legacy batch',
255 'cdrbatchnum' => 'Batch',
256 'detailnum' => 'Freeside invoice detail line',
265 Adds this record to the database. If there is an error, returns the error,
266 otherwise returns false.
270 # the insert method can be inherited from FS::Record
274 Delete this record from the database.
278 # the delete method can be inherited from FS::Record
280 =item replace OLD_RECORD
282 Replaces the OLD_RECORD with this one in the database. If there is an error,
283 returns the error, otherwise returns false.
287 # the replace method can be inherited from FS::Record
291 Checks all fields to make sure this is a valid CDR. If there is
292 an error, returns the error, otherwise returns false. Called by the insert
295 Note: Unlike most types of records, we don't want to "reject" a CDR and we want
296 to process them as quickly as possible, so we allow the database to check most
304 # we don't want to "reject" a CDR like other sorts of input...
306 # $self->ut_numbern('acctid')
307 ## || $self->ut_('calldate')
308 # || $self->ut_text('clid')
309 # || $self->ut_text('src')
310 # || $self->ut_text('dst')
311 # || $self->ut_text('dcontext')
312 # || $self->ut_text('channel')
313 # || $self->ut_text('dstchannel')
314 # || $self->ut_text('lastapp')
315 # || $self->ut_text('lastdata')
316 # || $self->ut_numbern('startdate')
317 # || $self->ut_numbern('answerdate')
318 # || $self->ut_numbern('enddate')
319 # || $self->ut_number('duration')
320 # || $self->ut_number('billsec')
321 # || $self->ut_text('disposition')
322 # || $self->ut_number('amaflags')
323 # || $self->ut_text('accountcode')
324 # || $self->ut_text('uniqueid')
325 # || $self->ut_text('userfield')
326 # || $self->ut_numbern('cdrtypenum')
327 # || $self->ut_textn('charged_party')
328 ## || $self->ut_n('upstream_currency')
329 ## || $self->ut_n('upstream_price')
330 # || $self->ut_numbern('upstream_rateplanid')
331 ## || $self->ut_n('distance')
332 # || $self->ut_numbern('islocal')
333 # || $self->ut_numbern('calltypenum')
334 # || $self->ut_textn('description')
335 # || $self->ut_numbern('quantity')
336 # || $self->ut_numbern('carrierid')
337 # || $self->ut_numbern('upstream_rateid')
338 # || $self->ut_numbern('svcnum')
339 # || $self->ut_textn('freesidestatus')
340 # || $self->ut_textn('freesiderewritestatus')
342 # return $error if $error;
344 for my $f ( grep { $self->$_ =~ /\D/ } qw(startdate answerdate enddate)){
345 $self->$f( str2time($self->$f) );
348 $self->calldate( $self->startdate_sql )
349 if !$self->calldate && $self->startdate;
351 #was just for $format eq 'taqua' but can't see the harm... add something to
352 #disable if it becomes a problem
353 if ( $self->duration eq '' && $self->enddate && $self->startdate ) {
354 $self->duration( $self->enddate - $self->startdate );
356 if ( $self->billsec eq '' && $self->enddate && $self->answerdate ) {
357 $self->billsec( $self->enddate - $self->answerdate );
360 if ( ! $self->enddate && $self->startdate && $self->duration ) {
361 $self->enddate( $self->startdate + $self->duration );
364 $self->set_charged_party;
366 #check the foreign keys even?
367 #do we want to outright *reject* the CDR?
368 my $error = $self->ut_numbern('acctid');
369 return $error if $error;
371 if ( $self->freesidestatus ne 'done' ) {
372 $self->set('detailnum', ''); # can't have this on an unbilled call
375 #add a config option to turn these back on if someone needs 'em
377 # #Usage = 1, S&E = 7, OC&C = 8
378 # || $self->ut_foreign_keyn('cdrtypenum', 'cdr_type', 'cdrtypenum' )
380 # #the big list in appendix 2
381 # || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
383 # # Telstra =1, Optus = 2, RSL COM = 3
384 # || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
389 =item is_tollfree [ COLUMN ]
391 Returns true when the cdr represents a toll free number and false otherwise.
393 By default, inspects the dst field, but an optional column name can be passed
394 to inspect other field.
400 my $field = scalar(@_) ? shift : 'dst';
401 if ( $tollfree_country eq 'AU' ) {
402 ( $self->$field() =~ /^(\+?61)?(1800|1300)/ ) ? 1 : 0;
403 } elsif ( $tollfree_country eq 'NZ' ) {
404 ( $self->$field() =~ /^(\+?64)?(800|508)/ ) ? 1 : 0;
405 } else { #NANPA (US/Canaada)
406 ( $self->$field() =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0;
410 =item set_charged_party
412 If the charged_party field is already set, does nothing. Otherwise:
414 If the cdr-charged_party-accountcode config option is enabled, sets the
415 charged_party to the accountcode.
417 Otherwise sets the charged_party normally: to the src field in most cases,
418 or to the dst field if it is a toll free number.
422 sub set_charged_party {
425 my $conf = new FS::Conf;
427 unless ( $self->charged_party ) {
429 if ( $cp_accountcode && $self->accountcode ) {
431 my $charged_party = $self->accountcode;
432 $charged_party =~ s/^0+//
433 if $cp_accountcode_trim0s;
434 $self->charged_party( $charged_party );
436 } elsif ( $cp_field ) {
438 $self->charged_party( $self->$cp_field() );
442 if ( $self->is_tollfree ) {
443 $self->charged_party($self->dst);
445 $self->charged_party($self->src);
452 # my $prefix = $conf->config('cdr-charged_party-truncate_prefix');
453 # my $prefix_len = length($prefix);
454 # my $trunc_len = $conf->config('cdr-charged_party-truncate_length');
456 # $self->charged_party( substr($self->charged_party, 0, $trunc_len) )
457 # if $prefix_len && $trunc_len
458 # && substr($self->charged_party, 0, $prefix_len) eq $prefix;
462 =item set_status STATUS
464 Sets the status to the provided string. If there is an error, returns the
465 error, otherwise returns false.
467 If status is being changed from 'rated' to some other status, also removes
468 any usage allocations to this CDR.
473 my($self, $status) = @_;
474 my $old_status = $self->freesidestatus;
475 $self->freesidestatus($status);
476 my $error = $self->replace;
477 if ( $old_status eq 'rated' and $status ne 'done' ) {
478 # deallocate any usage
479 foreach (qsearch('cdr_cust_pkg_usage', {acctid => $self->acctid})) {
480 my $cust_pkg_usage = $_->cust_pkg_usage;
481 $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $_->minutes);
482 $error ||= $cust_pkg_usage->replace || $_->delete;
488 =item set_status_and_rated_price STATUS RATED_PRICE [ SVCNUM [ OPTION => VALUE ... ] ]
490 Sets the status and rated price.
492 Available options are: inbound, rated_pretty_dst, rated_regionname,
493 rated_seconds, rated_minutes, rated_granularity, rated_ratedetailnum,
494 rated_classnum, rated_ratename. If rated_ratedetailnum is provided,
495 will also set a recalculated L</rate_cost> in the rated_cost field
496 after the other fields are set (does not work with inbound.)
498 If there is an error, returns the error, otherwise returns false.
502 sub set_status_and_rated_price {
503 my($self, $status, $rated_price, $svcnum, %opt) = @_;
505 if ($opt{'inbound'}) {
507 my $term = $self->cdr_termination( 1 ); #1: inbound
510 warn "replacing existing cdr status (".$self->acctid.")\n" if $term;
511 $error = $term->delete;
512 return $error if $error;
514 $term = FS::cdr_termination->new({
515 acctid => $self->acctid,
517 rated_price => $rated_price,
520 foreach (qw(rated_seconds rated_minutes rated_granularity)) {
521 $term->set($_, $opt{$_}) if exists($opt{$_});
523 $term->svcnum($svcnum) if $svcnum;
524 return $term->insert;
528 $self->freesidestatus($status);
529 $self->freesidestatustext($opt{'statustext'}) if exists($opt{'statustext'});
530 $self->rated_price($rated_price);
532 foreach grep exists($opt{$_}), map "rated_$_",
533 qw( pretty_dst regionname seconds minutes granularity
534 ratedetailnum classnum ratename );
535 $self->svcnum($svcnum) if $svcnum;
536 $self->rated_cost($self->rate_cost) if $opt{'rated_ratedetailnum'};
538 return $self->replace();
543 =item parse_number [ OPTION => VALUE ... ]
545 Returns two scalars, the countrycode and the rest of the number.
547 Options are passed as name-value pairs. Currently available options are:
553 The column containing the number to be parsed. Defaults to dst.
555 =item international_prefix
557 The digits for international dialing. Defaults to '011' The value '+' is
560 =item domestic_prefix
562 The digits for domestic long distance dialing. Defaults to '1'
569 my ($self, %options) = @_;
571 my $field = $options{column} || 'dst';
572 my $intl = $options{international_prefix} || '011';
573 # Still, don't break anyone's CDR rating if they have an empty string in
574 # there. Require an explicit statement that there's no prefix.
575 $intl = '' if lc($intl) eq 'none';
576 my $countrycode = '';
577 my $number = $self->$field();
579 my $to_or_from = 'concerning';
580 $to_or_from = 'from' if $field eq 'src';
581 $to_or_from = 'to' if $field eq 'dst';
582 warn "parsing call $to_or_from $number\n" if $DEBUG;
584 #remove non-phone# stuff and whitespace
587 # $dest =~ s/^(\w+):// and $proto = $1; #sip:
589 # $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
591 if ( $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
592 || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
596 my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 );
597 #first look for 1 digit country code
598 if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) {
600 $number = $u1.$u2.$rest;
601 } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
604 } else { #3 digit country code
605 $countrycode = $three;
610 my $domestic_prefix =
611 exists($options{domestic_prefix}) ? $options{domestic_prefix} : '';
612 $countrycode = length($domestic_prefix) ? $domestic_prefix : '1';
613 $number =~ s/^$countrycode//;# if length($number) > 10;
616 return($countrycode, $number);
620 =item rate [ OPTION => VALUE ... ]
622 Rates this CDR according and sets the status to 'rated'.
624 Available options are: part_pkg, svcnum, plan_included_min,
625 detail_included_min_hashref.
627 part_pkg is required.
629 If svcnum is specified, will also associate this CDR with the specified svcnum.
631 plan_included_min should be set to a scalar reference of the number of
632 included minutes and will be decremented by the rated minutes of this
635 detail_included_min_hashref should be set to an empty hashref at the
636 start of a month's rating and then preserved across CDRs.
641 my( $self, %opt ) = @_;
642 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
645 warn "rating CDR $self\n".
646 join('', map { " $_ => ". $self->{$_}. "\n" } keys %$self );
649 my $rating_method = $part_pkg->option_cacheable('rating_method') || 'prefix';
650 my $method = "rate_$rating_method";
651 $self->$method(%opt);
655 our %interval_cache = (); # for timed rates
658 my( $self, %opt ) = @_;
659 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
660 my $cust_pkg = $opt{'cust_pkg'};
663 # (Directory assistance) rewriting
667 # this will result in those CDRs being marked as done... is that
670 if ( $part_pkg->option_cacheable('411_rewrite') ) {
671 my $dirass = $part_pkg->option_cacheable('411_rewrite');
673 @dirass = split(',', $dirass);
676 if ( length($self->dst) && grep { $self->dst eq $_ } @dirass ) {
682 # Checks to see if the CDR is chargeable
685 my $reason = $part_pkg->check_chargable( $self,
686 'da_rewrote' => $da_rewrote,
689 warn "not charging for CDR ($reason)\n" if $DEBUG;
690 return $self->set_status_and_rated_price( 'skipped',
693 'statustext' => $reason,
697 if ( $part_pkg->option_cacheable('skip_same_customer')
698 and ! $self->is_tollfree ) {
699 my ($dst_countrycode, $dst_number) = $self->parse_number(
701 international_prefix => $part_pkg->option_cacheable('international_prefix'),
702 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
704 my $dst_same_cust = FS::Record->scalar_sql(
705 'SELECT COUNT(svc_phone.svcnum) AS count '.
707 'JOIN cust_svc USING (pkgnum) ' .
708 'JOIN svc_phone USING (svcnum) ' .
709 'WHERE svc_phone.countrycode = ' . dbh->quote($dst_countrycode) .
710 ' AND svc_phone.phonenum = ' . dbh->quote($dst_number) .
711 ' AND cust_pkg.custnum = ' . $cust_pkg->custnum,
713 if ( $dst_same_cust > 0 ) {
714 warn "not charging for CDR (same source and destination customer)\n" if $DEBUG;
715 return $self->set_status_and_rated_price( 'skipped',
722 my $rated_seconds = $part_pkg->option_cacheable('use_duration')
725 if ( $max_duration > 0 && $rated_seconds > $max_duration ) {
726 return $self->set_status_and_rated_price(
734 # look up rate details based on called station id
735 # (or calling station id for toll free calls)
738 my $eff_ratenum = $self->is_tollfree('accountcode')
739 ? $part_pkg->option_cacheable('accountcode_tollfree_ratenum')
742 my( $to_or_from, $column );
745 && ! $part_pkg->option_cacheable('disable_tollfree')
748 && $part_pkg->option_cacheable('accountcode_tollfree_field') eq 'src'
752 $to_or_from = 'from';
754 } else { #regular call
759 #determine the country code
760 my ($countrycode, $number) = $self->parse_number(
762 international_prefix => $part_pkg->option_cacheable('international_prefix'),
763 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
767 my $intrastate_ratenum = $part_pkg->option_cacheable('intrastate_ratenum');
769 if ( $use_lrn and $countrycode eq '1' ) {
771 # then ask about the number
772 foreach my $field ('src', 'dst') {
774 $self->get_lrn($field);
775 if ( $field eq $column ) {
776 # then we are rating on this number
777 $number = $self->get($field.'_lrn');
779 # is this ever meaningful? can the LRN be outside NANP space?
786 warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG;
787 my $pretty_dst = "+$countrycode $number";
788 #asterisks here causes inserting the detail to barf, so:
789 $pretty_dst =~ s/\*//g;
791 # should check $countrycode eq '1' here?
792 if ( $intrastate_ratenum && !$self->is_tollfree ) {
793 $ratename = 'Interstate'; #until proven otherwise
794 # this is relatively easy only because:
795 # -assume all numbers are valid NANP numbers NOT in a fully-qualified format
796 # -disregard toll-free
797 # -disregard private or unknown numbers
798 # -there is exactly one record in rate_prefix for a given NPANXX
799 # -default to interstate if we can't find one or both of the prefixes
800 my $dst_col = $use_lrn ? 'dst_lrn' : 'dst';
801 my $src_col = $use_lrn ? 'src_lrn' : 'src';
802 my (undef, $dstprefix) = $self->parse_number(
804 international_prefix => $part_pkg->option_cacheable('international_prefix'),
805 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
807 $dstprefix =~ /^(\d{6})/;
808 $dstprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
811 my (undef, $srcprefix) = $self->parse_number(
813 international_prefix => $part_pkg->option_cacheable('international_prefix'),
814 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
816 $srcprefix =~ /^(\d{6})/;
817 $srcprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
820 if ($srcprefix && $dstprefix
821 && $srcprefix->state && $dstprefix->state
822 && $srcprefix->state eq $dstprefix->state) {
823 $eff_ratenum = $intrastate_ratenum;
824 $ratename = 'Intrastate'; # XXX possibly just use the ratename?
828 $eff_ratenum ||= $part_pkg->option_cacheable('ratenum');
829 my $rate = qsearchs('rate', { 'ratenum' => $eff_ratenum })
830 or die "ratenum $eff_ratenum not found!";
832 my @ltime = localtime($self->startdate);
833 my $weektime = $ltime[0] +
834 $ltime[1]*60 + #minutes
835 $ltime[2]*3600 + #hours
836 $ltime[6]*86400; #days since sunday
837 # if there's no timed rate_detail for this time/region combination,
838 # dest_detail returns the default. There may still be a timed rate
839 # that applies after the starttime of the call, so be careful...
840 my $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
841 'phonenum' => $number,
842 'weektime' => $weektime,
843 'cdrtypenum' => $self->cdrtypenum,
846 unless ( $rate_detail ) {
848 if ( $part_pkg->option_cacheable('ignore_unrateable') ) {
850 if ( $part_pkg->option_cacheable('ignore_unrateable') == 2 ) {
851 # mark the CDR as unrateable
852 return $self->set_status_and_rated_price(
857 } elsif ( $part_pkg->option_cacheable('ignore_unrateable') == 1 ) {
859 warn "no rate_detail found for CDR.acctid: ". $self->acctid.
864 die "unknown ignore_unrateable, pkgpart ". $part_pkg->pkgpart;
869 die "FATAL: no rate_detail found in ".
870 $rate->ratenum. ":". $rate->ratename. " rate plan ".
871 "for +$countrycode $number (CDR acctid ". $self->acctid. "); ".
872 "add a rate or set ignore_unrateable flag on the package def\n";
877 my $regionnum = $rate_detail->dest_regionnum;
878 my $rate_region = $rate_detail->dest_region;
879 warn " found rate for regionnum $regionnum ".
880 "and rate detail $rate_detail\n"
883 if ( !exists($interval_cache{$regionnum}) ) {
885 sort { $a->stime <=> $b->stime }
886 map { $_->rate_time->intervals }
887 qsearch({ 'table' => 'rate_detail',
888 'hashref' => { 'ratenum' => $rate->ratenum },
889 'extra_sql' => 'AND ratetimenum IS NOT NULL',
892 $interval_cache{$regionnum} = \@intervals;
893 warn " cached ".scalar(@intervals)." interval(s)\n"
898 # find the price and add detail to the invoice
901 # About this section:
902 # We don't round _anything_ (except granularizing)
903 # until the final $charge = sprintf("%.2f"...).
905 my $seconds_left = $rated_seconds;
907 #no, do this later so it respects (group) included minutes
908 # # charge for the first (conn_sec) seconds
909 # my $seconds = min($seconds_left, $rate_detail->conn_sec);
910 # $seconds_left -= $seconds;
911 # $weektime += $seconds;
912 # my $charge = $rate_detail->conn_charge;
915 my $connection_charged = 0;
917 # before doing anything else, if there's an upstream multiplier and
918 # an upstream price, add that to the charge. (usually the rate detail
919 # will then have a minute charge of zero, but not necessarily.)
920 $charge += ($self->upstream_price || 0) * $rate_detail->upstream_mult_charge;
923 while($seconds_left) {
924 my $ratetimenum = $rate_detail->ratetimenum; # may be empty
926 # find the end of the current rate interval
927 if(@{ $interval_cache{$regionnum} } == 0) {
928 # There are no timed rates in this group, so just stay
929 # in the default rate_detail for the entire duration.
930 # Set an "end" of 1 past the end of the current call.
931 $etime = $weektime + $seconds_left + 1;
933 elsif($ratetimenum) {
934 # This is a timed rate, so go to the etime of this interval.
935 # If it's followed by another timed rate, the stime of that
936 # interval should match the etime of this one.
937 my $interval = $rate_detail->rate_time->contains($weektime);
938 $etime = $interval->etime;
941 # This is a default rate, so use the stime of the next
942 # interval in the sequence.
943 my $next_int = first { $_->stime > $weektime }
944 @{ $interval_cache{$regionnum} };
946 $etime = $next_int->stime;
949 # weektime is near the end of the week, so decrement
950 # it by a full week and use the stime of the first
952 $weektime -= (3600*24*7);
953 $etime = $interval_cache{$regionnum}->[0]->stime;
957 my $charge_sec = min($seconds_left, $etime - $weektime);
959 $seconds_left -= $charge_sec;
961 my $granularity = $rate_detail->sec_granularity;
964 if ( $granularity ) { # charge per minute
965 # Round up to the nearest $granularity
966 if ( $charge_sec and $charge_sec % $granularity ) {
967 $charge_sec += $granularity - ($charge_sec % $granularity);
969 $minutes = $charge_sec / 60; #don't round this
976 #$seconds += $charge_sec;
978 if ( $rate_detail->min_included ) {
979 # the old, kind of deprecated way to do this:
981 # The rate detail itself has included minutes. We MUST have a place
983 my $included_min = $opt{'detail_included_min_hashref'}
984 or return "unable to rate CDR: rate detail has included minutes, but ".
985 "no detail_included_min_hashref provided.\n";
987 # by default, set the included minutes for this region/time to
988 # what's in the rate_detail
989 if (!exists( $included_min->{$regionnum}{$ratetimenum} )) {
990 $included_min->{$regionnum}{$ratetimenum} =
991 ($rate_detail->min_included * $cust_pkg->quantity || 1);
994 if ( $included_min->{$regionnum}{$ratetimenum} >= $minutes ) {
996 $included_min->{$regionnum}{$ratetimenum} -= $minutes;
998 $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60);
999 $included_min->{$regionnum}{$ratetimenum} = 0;
1001 } elsif ( $opt{plan_included_min} && ${ $opt{plan_included_min} } > 0 ) {
1002 # The package definition has included minutes, but only for in-group
1003 # rate details. Decrement them if this is an in-group call.
1004 if ( $rate_detail->region_group ) {
1005 if ( ${ $opt{'plan_included_min'} } >= $minutes ) {
1007 ${ $opt{'plan_included_min'} } -= $minutes;
1009 $charge_sec -= (${ $opt{'plan_included_min'} } * 60);
1010 ${ $opt{'plan_included_min'} } = 0;
1015 my $applied_min = $cust_pkg->apply_usage(
1017 'rate_detail' => $rate_detail,
1018 'minutes' => $minutes
1020 # for now, usage pools deal only in whole minutes
1021 $charge_sec -= $applied_min * 60;
1024 if ( $charge_sec > 0 ) {
1026 #NOW do connection charges here... right?
1027 #my $conn_seconds = min($seconds_left, $rate_detail->conn_sec);
1028 my $conn_seconds = 0;
1029 unless ( $connection_charged++ ) { #only one connection charge
1030 $conn_seconds = min($charge_sec, $rate_detail->conn_sec);
1031 $seconds_left -= $conn_seconds;
1032 $weektime += $conn_seconds;
1033 $charge += $rate_detail->conn_charge;
1036 #should preserve (display?) this
1037 if ( $granularity == 0 ) { # per call rate
1038 $charge += $rate_detail->min_charge;
1040 my $charge_min = ( $charge_sec - $conn_seconds ) / 60;
1041 $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
1046 # choose next rate_detail
1047 $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
1048 'phonenum' => $number,
1049 'weektime' => $etime,
1050 'cdrtypenum' => $self->cdrtypenum })
1052 # we have now moved forward to $etime
1055 } #while $seconds_left
1057 # this is why we need regionnum/rate_region....
1058 warn " (rate region $rate_region)\n" if $DEBUG;
1061 my $rounding = $part_pkg->option_cacheable('rounding') || 2;
1062 my $sprintformat = '%.'. $rounding. 'f';
1063 my $roundup = 10**(-3-$rounding);
1064 my $price = sprintf($sprintformat, $charge + $roundup);
1066 $self->set_status_and_rated_price(
1070 'rated_pretty_dst' => $pretty_dst,
1071 'rated_regionname' => ($rate_region ? $rate_region->regionname : ''),
1072 'rated_seconds' => $rated_seconds, #$seconds,
1073 'rated_granularity' => $rate_detail->sec_granularity, #$granularity
1074 'rated_ratedetailnum' => $rate_detail->ratedetailnum,
1075 'rated_classnum' => $rate_detail->classnum, #rated_ratedetailnum?
1076 'rated_ratename' => $ratename, #not rate_detail - Intrastate/Interstate
1081 sub rate_upstream_simple {
1082 my( $self, %opt ) = @_;
1084 $self->set_status_and_rated_price(
1086 sprintf('%.3f', $self->upstream_price),
1088 'rated_classnum' => $self->calltypenum,
1089 'rated_seconds' => $self->billsec,
1090 # others? upstream_*_regionname => rated_regionname is possible
1094 sub rate_single_price {
1095 my( $self, %opt ) = @_;
1096 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
1098 # a little false laziness w/abov
1099 # $rate_detail = new FS::rate_detail({sec_granularity => ... }) ?
1101 my $granularity = length($part_pkg->option_cacheable('sec_granularity'))
1102 ? $part_pkg->option_cacheable('sec_granularity')
1105 my $seconds = $part_pkg->option_cacheable('use_duration')
1109 $seconds += $granularity - ( $seconds % $granularity )
1110 if $seconds # don't granular-ize 0 billsec calls (bills them)
1111 && $granularity # 0 is per call
1112 && $seconds % $granularity;
1113 my $minutes = $granularity ? ($seconds / 60) : 1;
1115 my $charge_min = $minutes;
1117 ${$opt{plan_included_min}} -= $minutes;
1118 if ( ${$opt{plan_included_min}} > 0 ) {
1121 $charge_min = 0 - ${$opt{plan_included_min}};
1122 ${$opt{plan_included_min}} = 0;
1126 sprintf('%.4f', ( $part_pkg->option_cacheable('min_charge') * $charge_min )
1127 + 0.0000000001 ); #so 1.00005 rounds to 1.0001
1129 $self->set_status_and_rated_price(
1133 'rated_granularity' => $granularity,
1134 'rated_seconds' => $seconds,
1141 Rates an already-rated CDR according to the cost fields from the rate plan.
1150 return 0 unless $self->rated_ratedetailnum;
1153 qsearchs('rate_detail', { 'ratedetailnum' => $self->rated_ratedetailnum } );
1156 $charge += ($self->upstream_price || 0) * ($rate_detail->upstream_mult_cost);
1158 if ( $self->rated_granularity == 0 ) {
1159 $charge += $rate_detail->min_cost;
1161 my $minutes = $self->rated_seconds / 60;
1162 $charge += $rate_detail->conn_cost + $minutes * $rate_detail->min_cost;
1165 sprintf('%.2f', $charge + .00001 );
1169 =item cdr_termination [ TERMPART ]
1173 sub cdr_termination {
1176 if ( scalar(@_) && $_[0] ) {
1177 my $termpart = shift;
1179 qsearchs('cdr_termination', { acctid => $self->acctid,
1180 termpart => $termpart,
1186 qsearch('cdr_termination', { acctid => $self->acctid, } );
1194 Parses the calldate in SQL string format and returns a UNIX timestamp.
1199 str2time(shift->calldate);
1204 Parses the startdate in UNIX timestamp format and returns a string in SQL
1210 my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
1213 "$year-$mon-$mday $hour:$min:$sec";
1218 Returns the FS::cdr_carrier object associated with this CDR, or false if no
1219 carrierid is defined.
1223 my %carrier_cache = ();
1227 return '' unless $self->carrierid;
1228 $carrier_cache{$self->carrierid} ||=
1229 qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
1234 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
1235 no FS::cdr_carrier object is assocated with this CDR.
1241 my $cdr_carrier = $self->cdr_carrier;
1242 $cdr_carrier ? $cdr_carrier->carriername : '';
1247 Returns the FS::cdr_calltype object associated with this CDR, or false if no
1248 calltypenum is defined.
1252 my %calltype_cache = ();
1256 return '' unless $self->calltypenum;
1257 $calltype_cache{$self->calltypenum} ||=
1258 qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
1263 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
1264 no FS::cdr_calltype object is assocated with this CDR.
1270 my $cdr_calltype = $self->cdr_calltype;
1271 $cdr_calltype ? $cdr_calltype->calltypename : '';
1274 =item downstream_csv [ OPTION => VALUE, ... ]
1278 # in the future, load this dynamically from detail_format classes
1280 my %export_names = (
1283 'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
1286 'name' => 'Simple with source',
1287 'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
1288 #"Date,Time,Name,Called From,Destination,Duration,Price",
1290 'accountcode_simple' => {
1291 'name' => 'Simple with accountcode',
1292 'invoice_header' => "Date,Time,Called From,Account,Duration,Price",
1296 'invoice_header' => "Date/Time,Called Number,Min/Sec,Price",
1298 'basic_upstream_dst_regionname' => {
1299 'name' => 'Basic with upstream destination name',
1300 'invoice_header' => "Date/Time,Called Number,Destination,Min/Sec,Price",
1303 'name' => 'Default',
1304 'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
1306 'source_default' => {
1307 'name' => 'Default with source',
1308 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1310 'accountcode_default' => {
1311 'name' => 'Default plus accountcode',
1312 'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
1314 'description_default' => {
1315 'name' => 'Default with description field as destination',
1316 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1319 'name' => 'Summary, one line per service',
1320 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1323 'name' => 'Number of calls, one line per service',
1324 'invoice_header' => 'Caller,Rate,Messages,Price',
1327 'name' => 'Summary, one line per service',
1328 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1330 'sum_duration_prefix' => {
1331 'name' => 'Summary, one line per destination prefix',
1332 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1334 'sum_count_class' => {
1335 'name' => 'Summary, one line per usage class',
1336 'invoice_header' => 'Caller,Class,Calls,Price',
1338 'sum_duration_accountcode' => {
1339 'name' => 'Summary, one line per accountcode',
1340 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1344 my %export_formats = ();
1345 sub export_formats {
1348 return %export_formats if keys %export_formats;
1350 my $conf = new FS::Conf;
1351 my $date_format = $conf->config('date_format') || '%m/%d/%Y';
1353 # call duration in the largest units that accurately reflect the granularity
1354 my $duration_sub = sub {
1355 my($cdr, %opt) = @_;
1356 my $sec = $opt{seconds} || $cdr->billsec;
1357 if ( defined $opt{granularity} &&
1358 $opt{granularity} == 0 ) { #per call
1361 elsif ( defined $opt{granularity} && $opt{granularity} == 60 ) {#full minutes
1362 my $min = int($sec/60);
1366 else { #anything else
1367 return sprintf("%dm %ds", $sec/60, $sec%60);
1371 my $price_sub = sub {
1372 my ($cdr, %opt) = @_;
1374 if ( defined($opt{charge}) ) {
1375 $price = $opt{charge};
1377 elsif ( $opt{inbound} ) {
1378 my $term = $cdr->cdr_termination(1); # 1 = inbound
1379 $price = $term->rated_price if defined $term;
1382 $price = $cdr->rated_price;
1384 length($price) ? ($opt{money_char} . $price) : '';
1387 my $src_sub = sub { $_[0]->clid || $_[0]->src };
1391 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1392 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1394 'dst', #NUMBER_DIALED
1395 $duration_sub, #DURATION
1396 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1400 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1401 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1403 $src_sub, #called from
1404 'dst', #NUMBER_DIALED
1405 $duration_sub, #DURATION
1406 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1409 'accountcode_simple' => [
1410 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1411 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1412 $src_sub, #called from
1413 'accountcode', #NUMBER_DIALED
1414 $duration_sub, #DURATION
1418 # for summary formats, the CDR is a fictitious object containing the
1419 # total billsec and the phone number of the service
1421 sub { my($cdr, %opt) = @_; $opt{ratename} },
1422 sub { my($cdr, %opt) = @_; $opt{count} },
1423 sub { my($cdr, %opt) = @_; int($opt{seconds}/60).'m' },
1428 sub { my($cdr, %opt) = @_; $opt{ratename} },
1429 sub { my($cdr, %opt) = @_; $opt{count} },
1433 sub { time2str('%d %b - %I:%M %p', shift->calldate_unix) },
1441 sub { time2str($date_format, shift->calldate_unix ) },
1442 # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
1445 sub { time2str('%r', shift->calldate_unix ) },
1446 # 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
1449 sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
1451 #REGIONNAME ("Destination")
1452 sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
1461 $export_formats{'source_default'} = [ $src_sub, @{ $export_formats{'default'} }, ];
1462 $export_formats{'accountcode_default'} =
1463 [ @{ $export_formats{'default'} }[0,1],
1465 @{ $export_formats{'default'} }[2..5],
1467 my @default = @{ $export_formats{'default'} };
1468 $export_formats{'description_default'} =
1469 [ $src_sub, @default[0..2],
1470 sub { my($cdr, %opt) = @_; $cdr->description },
1473 return %export_formats;
1476 =item downstream_csv OPTION => VALUE ...
1478 Returns a string of formatted call details for display on an invoice.
1484 charge - override the 'rated_price' field of the CDR
1486 seconds - override the 'billsec' field of the CDR
1488 count - number of usage events included in this record, for summary formats
1490 ratename - name of the rate table used to rate this call
1496 sub downstream_csv {
1497 my( $self, %opt ) = @_;
1499 my $format = $opt{'format'};
1500 my %formats = $self->export_formats;
1501 return "Unknown format $format" unless exists $formats{$format};
1503 #my $conf = new FS::Conf;
1504 #$opt{'money_char'} ||= $conf->config('money_char') || '$';
1505 $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
1507 my $csv = new Text::CSV_XS;
1511 ref($_) ? &{$_}($self, %opt) : $self->$_();
1513 @{ $formats{$format} };
1515 return @columns if defined $opt{'keeparray'};
1517 my $status = $csv->combine(@columns);
1518 die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
1529 my $ua = LWP::UserAgent->new(
1531 verify_hostname => 0,
1532 SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
1536 my $url = 'https://ws.freeside.biz/get_lrn';
1538 my %content = ( 'support-key' => $support_key,
1539 'tn' => $self->get($field),
1541 my $response = $ua->request( POST $url, \%content );
1543 die "LRN service error: ". $response->message. "\n"
1544 unless $response->is_success;
1547 my $data = eval { decode_json($response->content) };
1548 die "LRN service JSON error : $@\n" if $@;
1550 if ($data->{error}) {
1551 die "acctid ".$self->acctid." $field LRN lookup failed:\n$data->{error}";
1552 # for testing; later we should respect ignore_unrateable
1553 } elsif ($data->{lrn}) {
1555 $self->set($field.'_lrn', $data->{lrn});
1557 die "acctid ".$self->acctid." $field LRN lookup returned no number.\n";
1560 return $data; # in case it's interesting somehow
1565 =head1 CLASS METHODS
1569 =item invoice_formats
1571 Returns an ordered list of key value pairs containing invoice format names
1572 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
1576 # in the future, load this dynamically from detail_format classes
1578 sub invoice_formats {
1579 map { ($_ => $export_names{$_}->{'name'}) }
1580 grep { $export_names{$_}->{'invoice_header'} }
1581 sort keys %export_names;
1584 =item invoice_header FORMAT
1586 Returns a scalar containing the CSV column header for invoice format FORMAT.
1590 sub invoice_header {
1592 $export_names{$format}->{'invoice_header'};
1597 Clears cdr and any associated cdr_termination statuses - used for
1606 local $SIG{HUP} = 'IGNORE';
1607 local $SIG{INT} = 'IGNORE';
1608 local $SIG{QUIT} = 'IGNORE';
1609 local $SIG{TERM} = 'IGNORE';
1610 local $SIG{TSTP} = 'IGNORE';
1611 local $SIG{PIPE} = 'IGNORE';
1613 my $oldAutoCommit = $FS::UID::AutoCommit;
1614 local $FS::UID::AutoCommit = 0;
1617 if ( $cdr_prerate && $cdr_prerate_cdrtypenums{$self->cdrtypenum}
1618 && $self->rated_ratedetailnum #avoid putting old CDRs back in "rated"
1619 && $self->freesidestatus eq 'done'
1623 $self->freesidestatus('rated');
1625 $self->freesidestatus('');
1628 my $error = $self->replace;
1630 $dbh->rollback if $oldAutoCommit;
1634 foreach my $cdr_termination ( $self->cdr_termination ) {
1635 #$cdr_termination->status('');
1636 #$error = $cdr_termination->replace;
1637 $error = $cdr_termination->delete;
1639 $dbh->rollback if $oldAutoCommit;
1644 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1649 =item import_formats
1651 Returns an ordered list of key value pairs containing import format names
1652 as keys (for use with batch_import) and "pretty" format names as values.
1656 #false laziness w/part_pkg & part_export
1659 foreach my $INC ( @INC ) {
1660 warn "globbing $INC/FS/cdr/[a-z]*.pm\n" if $DEBUG;
1661 foreach my $file ( glob("$INC/FS/cdr/[a-z]*.pm") ) {
1662 warn "attempting to load CDR format info from $file\n" if $DEBUG;
1663 $file =~ /\/(\w+)\.pm$/ or do {
1664 warn "unrecognized file in $INC/FS/cdr/: $file\n";
1668 my $info = eval "use FS::cdr::$mod; ".
1669 "\\%FS::cdr::$mod\::info;";
1671 die "error using FS::cdr::$mod (skipping): $@\n" if $@;
1674 unless ( keys %$info ) {
1675 warn "no %info hash found in FS::cdr::$mod, skipping\n";
1678 warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
1679 if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1680 warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
1683 $cdr_info{$mod} = $info;
1687 tie my %import_formats, 'Tie::IxHash',
1688 map { $_ => $cdr_info{$_}->{'name'} }
1690 #this is not doing anything useful anymore
1691 #sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
1693 sort { lc($cdr_info{$a}->{'name'}) cmp lc($cdr_info{$b}->{'name'}) }
1695 grep { exists($cdr_info{$_}->{'import_fields'}) }
1698 sub import_formats {
1702 sub _cdr_min_parser_maker {
1704 my @fields = ref($field) ? @$field : ($field);
1705 @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
1707 my( $cdr, $min ) = @_;
1708 my $sec = eval { _cdr_min_parse($min) };
1709 die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
1710 $cdr->$_($sec) foreach @fields;
1714 sub _cdr_min_parse {
1716 sprintf('%.0f', $min * 60 );
1719 sub _cdr_date_parser_maker {
1722 my @fields = ref($field) ? @$field : ($field);
1724 my( $cdr, $datestring ) = @_;
1725 my $unixdate = eval { _cdr_date_parse($datestring, %options) };
1726 die "error parsing date for @fields from $datestring: $@\n" if $@;
1727 $cdr->$_($unixdate) foreach @fields;
1731 sub _cdr_date_parse {
1735 return '' unless length($date); #that's okay, it becomes NULL
1736 return '' if $date eq 'NA'; #sansay
1738 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 ) {
1739 my $time = str2time($date);
1740 return $time if $time > 100000; #just in case
1743 my($year, $mon, $day, $hour, $min, $sec);
1745 #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
1746 #taqua #2007-10-31 08:57:24.113000000
1748 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|$)/ ) {
1749 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1750 } 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|$)/ ) {
1751 # 8/26/2010 12:20:01
1752 # optionally without seconds
1753 ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1754 $sec = 0 if !defined($sec);
1755 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\.\d+)$/ ) {
1756 # broadsoft: 20081223201938.314
1757 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1758 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\d+(\D|$)/ ) {
1759 # Taqua OM: 20050422203450943
1760 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1761 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) {
1762 # WIP: 20100329121420
1763 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1764 } elsif ( $date =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z$/) {
1765 # Telos 2014-10-10T05:30:33Z
1766 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1768 } elsif ( $date =~ /^(\d+):(\d+):(\d+)\.\d+ \w+ (\w+) (\d+) (\d+)$/ ) {
1769 ($hour, $min, $sec, $mon, $day, $year) = ( $1, $2, $3, $4, $5, $6 );
1770 $mon = { # Acme Packet: 15:54:56.868 PST DEC 18 2017
1771 # My best guess of month abbv they may use
1772 JAN => '01', FEB => '02', MAR => '03', APR => '04',
1773 MAY => '05', JUN => '06', JUL => '07', AUG => '08',
1774 SEP => '09', OCT => '10', NOV => '11', DEC => '12'
1777 die "unparsable date: $date"; #maybe we shouldn't die...
1780 return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
1781 && $hour == 0 && $min == 0 && $sec == 0;
1783 if ($options{gmt}) {
1784 timegm($sec, $min, $hour, $day, $mon-1, $year);
1786 timelocal($sec, $min, $hour, $day, $mon-1, $year);
1790 =item batch_import HASHREF
1792 Imports CDR records. Available options are:
1804 Hash reference of preset fields, typically cdrbatch
1808 Set true to prevent throwing an error on empty imports
1814 my %import_options = (
1817 'batch_keycol' => 'cdrbatchnum',
1818 'batch_table' => 'cdr_batch',
1819 'batch_namecol' => 'cdrbatch',
1821 'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
1825 #drop the || 'csv' to allow auto xls for csv types?
1826 'format_types' => { map { $_ => lc($cdr_info{$_}->{'type'} || 'csv'); }
1830 'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
1834 'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
1838 'format_fixedlength_formats' =>
1839 { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
1843 'format_xml_formats' =>
1844 { map { $_ => $cdr_info{$_}->{'xml_format'}; }
1848 'format_asn_formats' =>
1849 { map { $_ => $cdr_info{$_}->{'asn_format'}; }
1853 'format_row_callbacks' =>
1854 { map { $_ => $cdr_info{$_}->{'row_callback'}; }
1858 'format_parser_opts' =>
1859 { map { $_ => $cdr_info{$_}->{'parser_opt'}; }
1864 sub _import_options {
1871 my $iopt = _import_options;
1872 $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
1874 if ( defined $opt->{'cdrtypenum'} ) {
1875 $opt->{'preinsert_callback'} = sub {
1876 my($record,$param) = (shift,shift);
1877 $record->cdrtypenum($opt->{'cdrtypenum'});
1882 FS::Record::batch_import( $opt );
1886 =item process_batch_import
1890 sub process_batch_import {
1893 my $opt = _import_options;
1894 # $opt->{'params'} = [ 'format', 'cdrbatch' ];
1896 FS::Record::process_batch_import( $job, $opt, @_ );
1899 # if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
1900 # @columns = map { s/^ +//; $_; } @columns;
1905 # Used by FS::Upgrade to migrate to a new database.
1907 use FS::upgrade_journal;
1909 my ($class, %opts) = @_;
1911 return if FS::upgrade_journal->is_done('cdr_cdrbatchnum');
1913 warn "$me upgrading $class\n" if $DEBUG;
1915 my $sth = dbh->prepare(
1916 'SELECT DISTINCT(cdrbatch) FROM cdr WHERE cdrbatch IS NOT NULL'
1917 ) or die dbh->errstr;
1919 $sth->execute or die $sth->errstr;
1921 my %cdrbatchnum = ();
1922 while (my $row = $sth->fetchrow_arrayref) {
1924 my $cdr_batch = qsearchs( 'cdr_batch', { 'cdrbatch' => $row->[0] } );
1925 unless ( $cdr_batch ) {
1926 $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] };
1927 my $error = $cdr_batch->insert;
1928 die $error if $error;
1931 $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum;
1934 $sth = dbh->prepare('UPDATE cdr SET cdrbatch = NULL, cdrbatchnum = ? WHERE cdrbatch IS NOT NULL AND cdrbatch = ?') or die dbh->errstr;
1936 foreach my $cdrbatch (keys %cdrbatchnum) {
1937 $sth->execute($cdrbatchnum{$cdrbatch}, $cdrbatch) or die $sth->errstr;
1940 FS::upgrade_journal->set_done('cdr_cdrbatchnum');
1944 =item ip_addr_sql FIELD RANGE
1946 Returns an SQL condition to search for CDRs with an IP address
1947 within RANGE. FIELD is either 'src_ip_addr' or 'dst_ip_addr'. RANGE
1948 should be in the form "a.b.c.d-e.f.g.h' (dotted quads), where any of
1949 the leftmost octets of the second address can be omitted if they're
1950 the same as the first address.
1956 my ($field, $range) = @_;
1957 $range =~ /^[\d\.-]+$/ or die "bad ip address range '$range'";
1958 my @r = split('-', $range);
1959 my @saddr = split('\.', $r[0] || '');
1960 my @eaddr = split('\.', $r[1] || '');
1961 unshift @eaddr, (undef) x (4 - scalar @eaddr);
1963 $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
1965 "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
1966 "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
1975 L<FS::Record>, schema.html from the base documentation.