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>)
188 =item sipcallid - SIP Call-ID
198 Creates a new CDR. To add the CDR to the database, see L<"insert">.
200 Note that this stores the hash reference, not a distinct copy of the hash it
201 points to. You can ask the object for a copy with the I<hash> method.
205 # the new method can be inherited from FS::Record, if a table method is defined
212 #XXX fill in some (more) nice names
214 'calldate' => 'Call date',
215 'clid' => 'Caller ID',
217 'dst' => 'Destination',
218 'dcontext' => 'Dest. context',
219 'channel' => 'Channel',
220 'dstchannel' => 'Destination channel',
223 'src_ip_addr' => 'Source IP',
224 'dst_ip_addr' => 'Dest. IP',
225 'dst_term' => 'Termination dest.',
226 'startdate' => 'Start date',
227 'answerdate' => 'Answer date',
228 'enddate' => 'End date',
229 'duration' => 'Duration',
230 'billsec' => 'Billable seconds',
231 'disposition' => 'Disposition',
232 'amaflags' => 'AMA flags',
233 'accountcode' => 'Account code',
235 'userfield' => 'User field',
237 'charged_party' => 'Charged party',
238 #'upstream_currency' => '',
239 'upstream_price' => 'Upstream price',
240 #'upstream_rateplanid' => '',
241 #'ratedetailnum' => '',
242 'src_lrn' => 'Source LRN',
243 'dst_lrn' => 'Dest. LRN',
244 'rated_price' => 'Rated price',
245 'rated_cost' => 'Rated cost',
248 #'calltypenum' => '',
249 #'description' => '',
251 'carrierid' => 'Carrier ID',
252 #'upstream_rateid' => '',
253 'svcnum' => 'Freeside service',
254 'freesidestatus' => 'Freeside status',
255 'freesiderewritestatus' => 'Freeside rewrite status',
256 'cdrbatch' => 'Legacy batch',
257 'cdrbatchnum' => 'Batch',
258 'detailnum' => 'Freeside invoice detail line',
267 Adds this record to the database. If there is an error, returns the error,
268 otherwise returns false.
272 # the insert method can be inherited from FS::Record
276 Delete this record from the database.
280 # the delete method can be inherited from FS::Record
282 =item replace OLD_RECORD
284 Replaces the OLD_RECORD with this one in the database. If there is an error,
285 returns the error, otherwise returns false.
289 # the replace method can be inherited from FS::Record
293 Checks all fields to make sure this is a valid CDR. If there is
294 an error, returns the error, otherwise returns false. Called by the insert
297 Note: Unlike most types of records, we don't want to "reject" a CDR and we want
298 to process them as quickly as possible, so we allow the database to check most
306 # we don't want to "reject" a CDR like other sorts of input...
308 # $self->ut_numbern('acctid')
309 ## || $self->ut_('calldate')
310 # || $self->ut_text('clid')
311 # || $self->ut_text('src')
312 # || $self->ut_text('dst')
313 # || $self->ut_text('dcontext')
314 # || $self->ut_text('channel')
315 # || $self->ut_text('dstchannel')
316 # || $self->ut_text('lastapp')
317 # || $self->ut_text('lastdata')
318 # || $self->ut_numbern('startdate')
319 # || $self->ut_numbern('answerdate')
320 # || $self->ut_numbern('enddate')
321 # || $self->ut_number('duration')
322 # || $self->ut_number('billsec')
323 # || $self->ut_text('disposition')
324 # || $self->ut_number('amaflags')
325 # || $self->ut_text('accountcode')
326 # || $self->ut_text('uniqueid')
327 # || $self->ut_text('userfield')
328 # || $self->ut_numbern('cdrtypenum')
329 # || $self->ut_textn('charged_party')
330 ## || $self->ut_n('upstream_currency')
331 ## || $self->ut_n('upstream_price')
332 # || $self->ut_numbern('upstream_rateplanid')
333 ## || $self->ut_n('distance')
334 # || $self->ut_numbern('islocal')
335 # || $self->ut_numbern('calltypenum')
336 # || $self->ut_textn('description')
337 # || $self->ut_numbern('quantity')
338 # || $self->ut_numbern('carrierid')
339 # || $self->ut_numbern('upstream_rateid')
340 # || $self->ut_numbern('svcnum')
341 # || $self->ut_textn('freesidestatus')
342 # || $self->ut_textn('freesiderewritestatus')
344 # return $error if $error;
346 for my $f ( grep { $self->$_ =~ /\D/ } qw(startdate answerdate enddate)){
347 $self->$f( str2time($self->$f) );
350 $self->calldate( $self->startdate_sql )
351 if !$self->calldate && $self->startdate;
353 #was just for $format eq 'taqua' but can't see the harm... add something to
354 #disable if it becomes a problem
355 if ( $self->duration eq '' && $self->enddate && $self->startdate ) {
356 $self->duration( $self->enddate - $self->startdate );
358 if ( $self->billsec eq '' && $self->enddate && $self->answerdate ) {
359 $self->billsec( $self->enddate - $self->answerdate );
362 if ( ! $self->enddate && $self->startdate && $self->duration ) {
363 $self->enddate( $self->startdate + $self->duration );
366 $self->set_charged_party;
368 #check the foreign keys even?
369 #do we want to outright *reject* the CDR?
370 my $error = $self->ut_numbern('acctid');
371 return $error if $error;
373 if ( $self->freesidestatus ne 'done' ) {
374 $self->set('detailnum', ''); # can't have this on an unbilled call
377 #add a config option to turn these back on if someone needs 'em
379 # #Usage = 1, S&E = 7, OC&C = 8
380 # || $self->ut_foreign_keyn('cdrtypenum', 'cdr_type', 'cdrtypenum' )
382 # #the big list in appendix 2
383 # || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
385 # # Telstra =1, Optus = 2, RSL COM = 3
386 # || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
391 =item is_tollfree [ COLUMN ]
393 Returns true when the cdr represents a toll free number and false otherwise.
395 By default, inspects the dst field, but an optional column name can be passed
396 to inspect other field.
402 my $field = scalar(@_) ? shift : 'dst';
403 if ( $tollfree_country eq 'AU' ) {
404 ( $self->$field() =~ /^(\+?61)?(1800|1300)/ ) ? 1 : 0;
405 } elsif ( $tollfree_country eq 'NZ' ) {
406 ( $self->$field() =~ /^(\+?64)?(800|508)/ ) ? 1 : 0;
407 } else { #NANPA (US/Canaada)
408 ( $self->$field() =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0;
412 =item set_charged_party
414 If the charged_party field is already set, does nothing. Otherwise:
416 If the cdr-charged_party-accountcode config option is enabled, sets the
417 charged_party to the accountcode.
419 Otherwise sets the charged_party normally: to the src field in most cases,
420 or to the dst field if it is a toll free number.
424 sub set_charged_party {
427 my $conf = new FS::Conf;
429 unless ( $self->charged_party ) {
431 if ( $cp_accountcode && $self->accountcode ) {
433 my $charged_party = $self->accountcode;
434 $charged_party =~ s/^0+//
435 if $cp_accountcode_trim0s;
436 $self->charged_party( $charged_party );
438 } elsif ( $cp_field ) {
440 $self->charged_party( $self->$cp_field() );
444 if ( $self->is_tollfree ) {
445 $self->charged_party($self->dst);
447 $self->charged_party($self->src);
454 # my $prefix = $conf->config('cdr-charged_party-truncate_prefix');
455 # my $prefix_len = length($prefix);
456 # my $trunc_len = $conf->config('cdr-charged_party-truncate_length');
458 # $self->charged_party( substr($self->charged_party, 0, $trunc_len) )
459 # if $prefix_len && $trunc_len
460 # && substr($self->charged_party, 0, $prefix_len) eq $prefix;
464 =item set_status STATUS
466 Sets the status to the provided string. If there is an error, returns the
467 error, otherwise returns false.
469 If status is being changed from 'rated' to some other status, also removes
470 any usage allocations to this CDR.
475 my($self, $status) = @_;
476 my $old_status = $self->freesidestatus;
477 $self->freesidestatus($status);
478 my $error = $self->replace;
479 if ( $old_status eq 'rated' and $status ne 'done' ) {
480 # deallocate any usage
481 foreach (qsearch('cdr_cust_pkg_usage', {acctid => $self->acctid})) {
482 my $cust_pkg_usage = $_->cust_pkg_usage;
483 $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $_->minutes);
484 $error ||= $cust_pkg_usage->replace || $_->delete;
490 =item set_status_and_rated_price STATUS RATED_PRICE [ SVCNUM [ OPTION => VALUE ... ] ]
492 Sets the status and rated price.
494 Available options are: inbound, rated_pretty_dst, rated_regionname,
495 rated_seconds, rated_minutes, rated_granularity, rated_ratedetailnum,
496 rated_classnum, rated_ratename. If rated_ratedetailnum is provided,
497 will also set a recalculated L</rate_cost> in the rated_cost field
498 after the other fields are set (does not work with inbound.)
500 If there is an error, returns the error, otherwise returns false.
504 sub set_status_and_rated_price {
505 my($self, $status, $rated_price, $svcnum, %opt) = @_;
507 if ($opt{'inbound'}) {
509 my $term = $self->cdr_termination( 1 ); #1: inbound
512 warn "replacing existing cdr status (".$self->acctid.")\n" if $term;
513 $error = $term->delete;
514 return $error if $error;
516 $term = FS::cdr_termination->new({
517 acctid => $self->acctid,
519 rated_price => $rated_price,
522 foreach (qw(rated_seconds rated_minutes rated_granularity)) {
523 $term->set($_, $opt{$_}) if exists($opt{$_});
525 $term->svcnum($svcnum) if $svcnum;
526 return $term->insert;
530 $self->freesidestatus($status);
531 $self->freesidestatustext($opt{'statustext'}) if exists($opt{'statustext'});
532 $self->rated_price($rated_price);
534 foreach grep exists($opt{$_}), map "rated_$_",
535 qw( pretty_dst regionname seconds minutes granularity
536 ratedetailnum classnum ratename );
537 $self->svcnum($svcnum) if $svcnum;
538 $self->rated_cost($self->rate_cost) if $opt{'rated_ratedetailnum'};
540 return $self->replace();
545 =item parse_number [ OPTION => VALUE ... ]
547 Returns two scalars, the countrycode and the rest of the number.
549 Options are passed as name-value pairs. Currently available options are:
555 The column containing the number to be parsed. Defaults to dst.
557 =item international_prefix
559 The digits for international dialing. Defaults to '011' The value '+' is
562 =item domestic_prefix
564 The digits for domestic long distance dialing. Defaults to '1'
571 my ($self, %options) = @_;
573 my $field = $options{column} || 'dst';
574 my $intl = $options{international_prefix} || '011';
575 # Still, don't break anyone's CDR rating if they have an empty string in
576 # there. Require an explicit statement that there's no prefix.
577 $intl = '' if lc($intl) eq 'none';
578 my $countrycode = '';
579 my $number = $self->$field();
581 my $to_or_from = 'concerning';
582 $to_or_from = 'from' if $field eq 'src';
583 $to_or_from = 'to' if $field eq 'dst';
584 warn "parsing call $to_or_from $number\n" if $DEBUG;
586 #remove non-phone# stuff and whitespace
589 # $dest =~ s/^(\w+):// and $proto = $1; #sip:
591 # $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
593 if ( $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
594 || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
598 my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 );
599 #first look for 1 digit country code
600 if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) {
602 $number = $u1.$u2.$rest;
603 } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
606 } else { #3 digit country code
607 $countrycode = $three;
612 my $domestic_prefix =
613 exists($options{domestic_prefix}) ? $options{domestic_prefix} : '';
614 $countrycode = length($domestic_prefix) ? $domestic_prefix : '1';
615 $number =~ s/^$countrycode//;# if length($number) > 10;
618 return($countrycode, $number);
622 =item rate [ OPTION => VALUE ... ]
624 Rates this CDR according and sets the status to 'rated'.
626 Available options are: part_pkg, svcnum, plan_included_min,
627 detail_included_min_hashref.
629 part_pkg is required.
631 If svcnum is specified, will also associate this CDR with the specified svcnum.
633 plan_included_min should be set to a scalar reference of the number of
634 included minutes and will be decremented by the rated minutes of this
637 detail_included_min_hashref should be set to an empty hashref at the
638 start of a month's rating and then preserved across CDRs.
643 my( $self, %opt ) = @_;
644 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
647 warn "rating CDR $self\n".
648 join('', map { " $_ => ". $self->{$_}. "\n" } keys %$self );
651 my $rating_method = $part_pkg->option_cacheable('rating_method') || 'prefix';
652 my $method = "rate_$rating_method";
653 $self->$method(%opt);
657 our %interval_cache = (); # for timed rates
660 my( $self, %opt ) = @_;
661 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
662 my $cust_pkg = $opt{'cust_pkg'};
665 # (Directory assistance) rewriting
669 # this will result in those CDRs being marked as done... is that
672 if ( $part_pkg->option_cacheable('411_rewrite') ) {
673 my $dirass = $part_pkg->option_cacheable('411_rewrite');
675 @dirass = split(',', $dirass);
678 if ( length($self->dst) && grep { $self->dst eq $_ } @dirass ) {
684 # Checks to see if the CDR is chargeable
687 my $reason = $part_pkg->check_chargable( $self,
688 'da_rewrote' => $da_rewrote,
691 warn "not charging for CDR ($reason)\n" if $DEBUG;
692 return $self->set_status_and_rated_price( 'skipped',
695 'statustext' => $reason,
699 if ( $part_pkg->option_cacheable('skip_same_customer')
700 and ! $self->is_tollfree ) {
701 my ($dst_countrycode, $dst_number) = $self->parse_number(
703 international_prefix => $part_pkg->option_cacheable('international_prefix'),
704 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
706 my $dst_same_cust = FS::Record->scalar_sql(
707 'SELECT COUNT(svc_phone.svcnum) AS count '.
709 'JOIN cust_svc USING (pkgnum) ' .
710 'JOIN svc_phone USING (svcnum) ' .
711 'WHERE svc_phone.countrycode = ' . dbh->quote($dst_countrycode) .
712 ' AND svc_phone.phonenum = ' . dbh->quote($dst_number) .
713 ' AND cust_pkg.custnum = ' . $cust_pkg->custnum,
715 if ( $dst_same_cust > 0 ) {
716 warn "not charging for CDR (same source and destination customer)\n" if $DEBUG;
717 return $self->set_status_and_rated_price( 'skipped',
724 my $rated_seconds = $part_pkg->option_cacheable('use_duration')
727 if ( $max_duration > 0 && $rated_seconds > $max_duration ) {
728 return $self->set_status_and_rated_price(
736 # look up rate details based on called station id
737 # (or calling station id for toll free calls)
740 my $eff_ratenum = $self->is_tollfree('accountcode')
741 ? $part_pkg->option_cacheable('accountcode_tollfree_ratenum')
744 my( $to_or_from, $column );
747 && ! $part_pkg->option_cacheable('disable_tollfree')
750 && $part_pkg->option_cacheable('accountcode_tollfree_field') eq 'src'
754 $to_or_from = 'from';
756 } else { #regular call
761 #determine the country code
762 my ($countrycode, $number) = $self->parse_number(
764 international_prefix => $part_pkg->option_cacheable('international_prefix'),
765 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
769 my $intrastate_ratenum = $part_pkg->option_cacheable('intrastate_ratenum');
771 if ( $use_lrn and $countrycode eq '1' ) {
773 # then ask about the number
774 foreach my $field ('src', 'dst') {
776 $self->get_lrn($field);
777 if ( $field eq $column ) {
778 # then we are rating on this number
779 $number = $self->get($field.'_lrn');
781 # is this ever meaningful? can the LRN be outside NANP space?
788 warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG;
789 my $pretty_dst = "+$countrycode $number";
790 #asterisks here causes inserting the detail to barf, so:
791 $pretty_dst =~ s/\*//g;
793 # should check $countrycode eq '1' here?
794 if ( $intrastate_ratenum && !$self->is_tollfree ) {
795 $ratename = 'Interstate'; #until proven otherwise
796 # this is relatively easy only because:
797 # -assume all numbers are valid NANP numbers NOT in a fully-qualified format
798 # -disregard toll-free
799 # -disregard private or unknown numbers
800 # -there is exactly one record in rate_prefix for a given NPANXX
801 # -default to interstate if we can't find one or both of the prefixes
802 my $dst_col = $use_lrn ? 'dst_lrn' : 'dst';
803 my $src_col = $use_lrn ? 'src_lrn' : 'src';
804 my (undef, $dstprefix) = $self->parse_number(
806 international_prefix => $part_pkg->option_cacheable('international_prefix'),
807 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
809 $dstprefix =~ /^(\d{6})/;
810 $dstprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
813 my (undef, $srcprefix) = $self->parse_number(
815 international_prefix => $part_pkg->option_cacheable('international_prefix'),
816 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
818 $srcprefix =~ /^(\d{6})/;
819 $srcprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
822 if ($srcprefix && $dstprefix
823 && $srcprefix->state && $dstprefix->state
824 && $srcprefix->state eq $dstprefix->state) {
825 $eff_ratenum = $intrastate_ratenum;
826 $ratename = 'Intrastate'; # XXX possibly just use the ratename?
830 $eff_ratenum ||= $part_pkg->option_cacheable('ratenum');
831 my $rate = qsearchs('rate', { 'ratenum' => $eff_ratenum })
832 or die "ratenum $eff_ratenum not found!";
834 my @ltime = localtime($self->startdate);
835 my $weektime = $ltime[0] +
836 $ltime[1]*60 + #minutes
837 $ltime[2]*3600 + #hours
838 $ltime[6]*86400; #days since sunday
839 # if there's no timed rate_detail for this time/region combination,
840 # dest_detail returns the default. There may still be a timed rate
841 # that applies after the starttime of the call, so be careful...
842 my $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
843 'phonenum' => $number,
844 'weektime' => $weektime,
845 'cdrtypenum' => $self->cdrtypenum,
848 unless ( $rate_detail ) {
850 if ( $part_pkg->option_cacheable('ignore_unrateable') ) {
852 if ( $part_pkg->option_cacheable('ignore_unrateable') == 2 ) {
853 # mark the CDR as unrateable
854 return $self->set_status_and_rated_price(
859 } elsif ( $part_pkg->option_cacheable('ignore_unrateable') == 1 ) {
861 warn "no rate_detail found for CDR.acctid: ". $self->acctid.
866 die "unknown ignore_unrateable, pkgpart ". $part_pkg->pkgpart;
871 die "FATAL: no rate_detail found in ".
872 $rate->ratenum. ":". $rate->ratename. " rate plan ".
873 "for +$countrycode $number (CDR acctid ". $self->acctid. "); ".
874 "add a rate or set ignore_unrateable flag on the package def\n";
879 my $regionnum = $rate_detail->dest_regionnum;
880 my $rate_region = $rate_detail->dest_region;
881 warn " found rate for regionnum $regionnum ".
882 "and rate detail $rate_detail\n"
885 if ( !exists($interval_cache{$regionnum}) ) {
887 sort { $a->stime <=> $b->stime }
888 map { $_->rate_time->intervals }
889 qsearch({ 'table' => 'rate_detail',
890 'hashref' => { 'ratenum' => $rate->ratenum },
891 'extra_sql' => 'AND ratetimenum IS NOT NULL',
894 $interval_cache{$regionnum} = \@intervals;
895 warn " cached ".scalar(@intervals)." interval(s)\n"
900 # find the price and add detail to the invoice
903 # About this section:
904 # We don't round _anything_ (except granularizing)
905 # until the final $charge = sprintf("%.2f"...).
907 my $seconds_left = $rated_seconds;
909 #no, do this later so it respects (group) included minutes
910 # # charge for the first (conn_sec) seconds
911 # my $seconds = min($seconds_left, $rate_detail->conn_sec);
912 # $seconds_left -= $seconds;
913 # $weektime += $seconds;
914 # my $charge = $rate_detail->conn_charge;
917 my $connection_charged = 0;
919 # before doing anything else, if there's an upstream multiplier and
920 # an upstream price, add that to the charge. (usually the rate detail
921 # will then have a minute charge of zero, but not necessarily.)
922 $charge += ($self->upstream_price || 0) * $rate_detail->upstream_mult_charge;
925 while($seconds_left) {
926 my $ratetimenum = $rate_detail->ratetimenum; # may be empty
928 # find the end of the current rate interval
929 if(@{ $interval_cache{$regionnum} } == 0) {
930 # There are no timed rates in this group, so just stay
931 # in the default rate_detail for the entire duration.
932 # Set an "end" of 1 past the end of the current call.
933 $etime = $weektime + $seconds_left + 1;
935 elsif($ratetimenum) {
936 # This is a timed rate, so go to the etime of this interval.
937 # If it's followed by another timed rate, the stime of that
938 # interval should match the etime of this one.
939 my $interval = $rate_detail->rate_time->contains($weektime);
940 $etime = $interval->etime;
943 # This is a default rate, so use the stime of the next
944 # interval in the sequence.
945 my $next_int = first { $_->stime > $weektime }
946 @{ $interval_cache{$regionnum} };
948 $etime = $next_int->stime;
951 # weektime is near the end of the week, so decrement
952 # it by a full week and use the stime of the first
954 $weektime -= (3600*24*7);
955 $etime = $interval_cache{$regionnum}->[0]->stime;
959 my $charge_sec = min($seconds_left, $etime - $weektime);
961 $seconds_left -= $charge_sec;
963 my $granularity = $rate_detail->sec_granularity;
966 if ( $granularity ) { # charge per minute
967 # Round up to the nearest $granularity
968 if ( $charge_sec and $charge_sec % $granularity ) {
969 $charge_sec += $granularity - ($charge_sec % $granularity);
971 $minutes = $charge_sec / 60; #don't round this
978 #$seconds += $charge_sec;
980 if ( $rate_detail->min_included ) {
981 # the old, kind of deprecated way to do this:
983 # The rate detail itself has included minutes. We MUST have a place
985 my $included_min = $opt{'detail_included_min_hashref'}
986 or return "unable to rate CDR: rate detail has included minutes, but ".
987 "no detail_included_min_hashref provided.\n";
989 # by default, set the included minutes for this region/time to
990 # what's in the rate_detail
991 if (!exists( $included_min->{$regionnum}{$ratetimenum} )) {
992 $included_min->{$regionnum}{$ratetimenum} =
993 ($rate_detail->min_included * $cust_pkg->quantity || 1);
996 if ( $included_min->{$regionnum}{$ratetimenum} >= $minutes ) {
998 $included_min->{$regionnum}{$ratetimenum} -= $minutes;
1000 $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60);
1001 $included_min->{$regionnum}{$ratetimenum} = 0;
1003 } elsif ( $opt{plan_included_min} && ${ $opt{plan_included_min} } > 0 ) {
1004 # The package definition has included minutes, but only for in-group
1005 # rate details. Decrement them if this is an in-group call.
1006 if ( $rate_detail->region_group ) {
1007 if ( ${ $opt{'plan_included_min'} } >= $minutes ) {
1009 ${ $opt{'plan_included_min'} } -= $minutes;
1011 $charge_sec -= (${ $opt{'plan_included_min'} } * 60);
1012 ${ $opt{'plan_included_min'} } = 0;
1017 my $applied_min = $cust_pkg->apply_usage(
1019 'rate_detail' => $rate_detail,
1020 'minutes' => $minutes
1022 # for now, usage pools deal only in whole minutes
1023 $charge_sec -= $applied_min * 60;
1026 if ( $charge_sec > 0 ) {
1028 #NOW do connection charges here... right?
1029 #my $conn_seconds = min($seconds_left, $rate_detail->conn_sec);
1030 my $conn_seconds = 0;
1031 unless ( $connection_charged++ ) { #only one connection charge
1032 $conn_seconds = min($charge_sec, $rate_detail->conn_sec);
1033 $seconds_left -= $conn_seconds;
1034 $weektime += $conn_seconds;
1035 $charge += $rate_detail->conn_charge;
1038 #should preserve (display?) this
1039 if ( $granularity == 0 ) { # per call rate
1040 $charge += $rate_detail->min_charge;
1042 my $charge_min = ( $charge_sec - $conn_seconds ) / 60;
1043 $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
1048 # choose next rate_detail
1049 $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
1050 'phonenum' => $number,
1051 'weektime' => $etime,
1052 'cdrtypenum' => $self->cdrtypenum })
1054 # we have now moved forward to $etime
1057 } #while $seconds_left
1059 # this is why we need regionnum/rate_region....
1060 warn " (rate region $rate_region)\n" if $DEBUG;
1063 my $rounding = $part_pkg->option_cacheable('rounding') || 2;
1064 my $sprintformat = '%.'. $rounding. 'f';
1065 my $roundup = 10**(-3-$rounding);
1066 my $price = sprintf($sprintformat, $charge + $roundup);
1068 $self->set_status_and_rated_price(
1072 'rated_pretty_dst' => $pretty_dst,
1073 'rated_regionname' => ($rate_region ? $rate_region->regionname : ''),
1074 'rated_seconds' => $rated_seconds, #$seconds,
1075 'rated_granularity' => $rate_detail->sec_granularity, #$granularity
1076 'rated_ratedetailnum' => $rate_detail->ratedetailnum,
1077 'rated_classnum' => $rate_detail->classnum, #rated_ratedetailnum?
1078 'rated_ratename' => $ratename, #not rate_detail - Intrastate/Interstate
1083 sub rate_upstream_simple {
1084 my( $self, %opt ) = @_;
1086 $self->set_status_and_rated_price(
1088 sprintf('%.3f', $self->upstream_price),
1090 'rated_classnum' => $self->calltypenum,
1091 'rated_seconds' => $self->billsec,
1092 # others? upstream_*_regionname => rated_regionname is possible
1096 sub rate_single_price {
1097 my( $self, %opt ) = @_;
1098 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
1100 # a little false laziness w/abov
1101 # $rate_detail = new FS::rate_detail({sec_granularity => ... }) ?
1103 my $granularity = length($part_pkg->option_cacheable('sec_granularity'))
1104 ? $part_pkg->option_cacheable('sec_granularity')
1107 my $seconds = $part_pkg->option_cacheable('use_duration')
1111 $seconds += $granularity - ( $seconds % $granularity )
1112 if $seconds # don't granular-ize 0 billsec calls (bills them)
1113 && $granularity # 0 is per call
1114 && $seconds % $granularity;
1115 my $minutes = $granularity ? ($seconds / 60) : 1;
1117 my $charge_min = $minutes;
1119 ${$opt{plan_included_min}} -= $minutes;
1120 if ( ${$opt{plan_included_min}} > 0 ) {
1123 $charge_min = 0 - ${$opt{plan_included_min}};
1124 ${$opt{plan_included_min}} = 0;
1128 sprintf('%.4f', ( $part_pkg->option_cacheable('min_charge') * $charge_min )
1129 + 0.0000000001 ); #so 1.00005 rounds to 1.0001
1131 $self->set_status_and_rated_price(
1135 'rated_granularity' => $granularity,
1136 'rated_seconds' => $seconds,
1143 Rates an already-rated CDR according to the cost fields from the rate plan.
1152 return 0 unless $self->rated_ratedetailnum;
1155 qsearchs('rate_detail', { 'ratedetailnum' => $self->rated_ratedetailnum } );
1158 $charge += ($self->upstream_price || 0) * ($rate_detail->upstream_mult_cost);
1160 if ( $self->rated_granularity == 0 ) {
1161 $charge += $rate_detail->min_cost;
1163 my $minutes = $self->rated_seconds / 60;
1164 $charge += $rate_detail->conn_cost + $minutes * $rate_detail->min_cost;
1167 sprintf('%.2f', $charge + .00001 );
1171 =item cdr_termination [ TERMPART ]
1175 sub cdr_termination {
1178 if ( scalar(@_) && $_[0] ) {
1179 my $termpart = shift;
1181 qsearchs('cdr_termination', { acctid => $self->acctid,
1182 termpart => $termpart,
1188 qsearch('cdr_termination', { acctid => $self->acctid, } );
1196 Parses the calldate in SQL string format and returns a UNIX timestamp.
1201 str2time(shift->calldate);
1206 Parses the startdate in UNIX timestamp format and returns a string in SQL
1212 my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
1215 "$year-$mon-$mday $hour:$min:$sec";
1220 Returns the FS::cdr_carrier object associated with this CDR, or false if no
1221 carrierid is defined.
1225 my %carrier_cache = ();
1229 return '' unless $self->carrierid;
1230 $carrier_cache{$self->carrierid} ||=
1231 qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
1236 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
1237 no FS::cdr_carrier object is assocated with this CDR.
1243 my $cdr_carrier = $self->cdr_carrier;
1244 $cdr_carrier ? $cdr_carrier->carriername : '';
1249 Returns the FS::cdr_calltype object associated with this CDR, or false if no
1250 calltypenum is defined.
1254 my %calltype_cache = ();
1258 return '' unless $self->calltypenum;
1259 $calltype_cache{$self->calltypenum} ||=
1260 qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
1265 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
1266 no FS::cdr_calltype object is assocated with this CDR.
1272 my $cdr_calltype = $self->cdr_calltype;
1273 $cdr_calltype ? $cdr_calltype->calltypename : '';
1276 =item downstream_csv [ OPTION => VALUE, ... ]
1280 # in the future, load this dynamically from detail_format classes
1282 my %export_names = (
1285 'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
1288 'name' => 'Simple with source',
1289 'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
1290 #"Date,Time,Name,Called From,Destination,Duration,Price",
1292 'accountcode_simple' => {
1293 'name' => 'Simple with accountcode',
1294 'invoice_header' => "Date,Time,Called From,Account,Duration,Price",
1298 'invoice_header' => "Date/Time,Called Number,Min/Sec,Price",
1300 'basic_upstream_dst_regionname' => {
1301 'name' => 'Basic with upstream destination name',
1302 'invoice_header' => "Date/Time,Called Number,Destination,Min/Sec,Price",
1305 'name' => 'Default',
1306 'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
1308 'source_default' => {
1309 'name' => 'Default with source',
1310 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1312 'accountcode_default' => {
1313 'name' => 'Default plus accountcode',
1314 'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
1316 'description_default' => {
1317 'name' => 'Default with description field as destination',
1318 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1321 'name' => 'Summary, one line per service',
1322 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1325 'name' => 'Number of calls, one line per service',
1326 'invoice_header' => 'Caller,Rate,Messages,Price',
1329 'name' => 'Summary, one line per service',
1330 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1332 'sum_duration_prefix' => {
1333 'name' => 'Summary, one line per destination prefix',
1334 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1336 'sum_count_class' => {
1337 'name' => 'Summary, one line per usage class',
1338 'invoice_header' => 'Caller,Class,Calls,Price',
1340 'sum_duration_accountcode' => {
1341 'name' => 'Summary, one line per accountcode',
1342 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1346 my %export_formats = ();
1347 sub export_formats {
1350 return %export_formats if keys %export_formats;
1352 my $conf = new FS::Conf;
1353 my $date_format = $conf->config('date_format') || '%m/%d/%Y';
1355 # call duration in the largest units that accurately reflect the granularity
1356 my $duration_sub = sub {
1357 my($cdr, %opt) = @_;
1358 my $sec = $opt{seconds} || $cdr->billsec;
1359 if ( defined $opt{granularity} &&
1360 $opt{granularity} == 0 ) { #per call
1363 elsif ( defined $opt{granularity} && $opt{granularity} == 60 ) {#full minutes
1364 my $min = int($sec/60);
1368 else { #anything else
1369 return sprintf("%dm %ds", $sec/60, $sec%60);
1373 my $price_sub = sub {
1374 my ($cdr, %opt) = @_;
1376 if ( defined($opt{charge}) ) {
1377 $price = $opt{charge};
1379 elsif ( $opt{inbound} ) {
1380 my $term = $cdr->cdr_termination(1); # 1 = inbound
1381 $price = $term->rated_price if defined $term;
1384 $price = $cdr->rated_price;
1386 length($price) ? ($opt{money_char} . $price) : '';
1389 my $src_sub = sub { $_[0]->clid || $_[0]->src };
1393 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1394 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1396 'dst', #NUMBER_DIALED
1397 $duration_sub, #DURATION
1398 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1402 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1403 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1405 $src_sub, #called from
1406 'dst', #NUMBER_DIALED
1407 $duration_sub, #DURATION
1408 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1411 'accountcode_simple' => [
1412 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1413 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1414 $src_sub, #called from
1415 'accountcode', #NUMBER_DIALED
1416 $duration_sub, #DURATION
1420 # for summary formats, the CDR is a fictitious object containing the
1421 # total billsec and the phone number of the service
1423 sub { my($cdr, %opt) = @_; $opt{ratename} },
1424 sub { my($cdr, %opt) = @_; $opt{count} },
1425 sub { my($cdr, %opt) = @_; int($opt{seconds}/60).'m' },
1430 sub { my($cdr, %opt) = @_; $opt{ratename} },
1431 sub { my($cdr, %opt) = @_; $opt{count} },
1435 sub { time2str('%d %b - %I:%M %p', shift->calldate_unix) },
1443 sub { time2str($date_format, shift->calldate_unix ) },
1444 # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
1447 sub { time2str('%r', shift->calldate_unix ) },
1448 # 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
1451 sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
1453 #REGIONNAME ("Destination")
1454 sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
1463 $export_formats{'source_default'} = [ $src_sub, @{ $export_formats{'default'} }, ];
1464 $export_formats{'accountcode_default'} =
1465 [ @{ $export_formats{'default'} }[0,1],
1467 @{ $export_formats{'default'} }[2..5],
1469 my @default = @{ $export_formats{'default'} };
1470 $export_formats{'description_default'} =
1471 [ $src_sub, @default[0..2],
1472 sub { my($cdr, %opt) = @_; $cdr->description },
1475 return %export_formats;
1478 =item downstream_csv OPTION => VALUE ...
1480 Returns a string of formatted call details for display on an invoice.
1486 charge - override the 'rated_price' field of the CDR
1488 seconds - override the 'billsec' field of the CDR
1490 count - number of usage events included in this record, for summary formats
1492 ratename - name of the rate table used to rate this call
1498 sub downstream_csv {
1499 my( $self, %opt ) = @_;
1501 my $format = $opt{'format'};
1502 my %formats = $self->export_formats;
1503 return "Unknown format $format" unless exists $formats{$format};
1505 #my $conf = new FS::Conf;
1506 #$opt{'money_char'} ||= $conf->config('money_char') || '$';
1507 $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
1509 my $csv = new Text::CSV_XS;
1513 ref($_) ? &{$_}($self, %opt) : $self->$_();
1515 @{ $formats{$format} };
1517 return @columns if defined $opt{'keeparray'};
1519 my $status = $csv->combine(@columns);
1520 die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
1531 my $ua = LWP::UserAgent->new(
1533 verify_hostname => 0,
1534 SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
1538 my $url = 'https://ws.freeside.biz/get_lrn';
1540 my %content = ( 'support-key' => $support_key,
1541 'tn' => $self->get($field),
1543 my $response = $ua->request( POST $url, \%content );
1545 die "LRN service error: ". $response->message. "\n"
1546 unless $response->is_success;
1549 my $data = eval { decode_json($response->content) };
1550 die "LRN service JSON error : $@\n" if $@;
1552 if ($data->{error}) {
1553 die "acctid ".$self->acctid." $field LRN lookup failed:\n$data->{error}";
1554 # for testing; later we should respect ignore_unrateable
1555 } elsif ($data->{lrn}) {
1557 $self->set($field.'_lrn', $data->{lrn});
1559 die "acctid ".$self->acctid." $field LRN lookup returned no number.\n";
1562 return $data; # in case it's interesting somehow
1567 =head1 CLASS METHODS
1571 =item invoice_formats
1573 Returns an ordered list of key value pairs containing invoice format names
1574 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
1578 # in the future, load this dynamically from detail_format classes
1580 sub invoice_formats {
1581 map { ($_ => $export_names{$_}->{'name'}) }
1582 grep { $export_names{$_}->{'invoice_header'} }
1583 sort keys %export_names;
1586 =item invoice_header FORMAT
1588 Returns a scalar containing the CSV column header for invoice format FORMAT.
1592 sub invoice_header {
1594 $export_names{$format}->{'invoice_header'};
1599 Clears cdr and any associated cdr_termination statuses - used for
1608 local $SIG{HUP} = 'IGNORE';
1609 local $SIG{INT} = 'IGNORE';
1610 local $SIG{QUIT} = 'IGNORE';
1611 local $SIG{TERM} = 'IGNORE';
1612 local $SIG{TSTP} = 'IGNORE';
1613 local $SIG{PIPE} = 'IGNORE';
1615 my $oldAutoCommit = $FS::UID::AutoCommit;
1616 local $FS::UID::AutoCommit = 0;
1619 if ( $cdr_prerate && $cdr_prerate_cdrtypenums{$self->cdrtypenum}
1620 && $self->rated_ratedetailnum #avoid putting old CDRs back in "rated"
1621 && $self->freesidestatus eq 'done'
1625 $self->freesidestatus('rated');
1627 $self->freesidestatus('');
1630 my $error = $self->replace;
1632 $dbh->rollback if $oldAutoCommit;
1636 foreach my $cdr_termination ( $self->cdr_termination ) {
1637 #$cdr_termination->status('');
1638 #$error = $cdr_termination->replace;
1639 $error = $cdr_termination->delete;
1641 $dbh->rollback if $oldAutoCommit;
1646 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1651 =item import_formats
1653 Returns an ordered list of key value pairs containing import format names
1654 as keys (for use with batch_import) and "pretty" format names as values.
1658 #false laziness w/part_pkg & part_export
1661 foreach my $INC ( @INC ) {
1662 warn "globbing $INC/FS/cdr/[a-z]*.pm\n" if $DEBUG;
1663 foreach my $file ( glob("$INC/FS/cdr/[a-z]*.pm") ) {
1664 warn "attempting to load CDR format info from $file\n" if $DEBUG;
1665 $file =~ /\/(\w+)\.pm$/ or do {
1666 warn "unrecognized file in $INC/FS/cdr/: $file\n";
1670 my $info = eval "use FS::cdr::$mod; ".
1671 "\\%FS::cdr::$mod\::info;";
1673 die "error using FS::cdr::$mod (skipping): $@\n" if $@;
1676 unless ( keys %$info ) {
1677 warn "no %info hash found in FS::cdr::$mod, skipping\n";
1680 warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
1681 if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1682 warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
1685 $cdr_info{$mod} = $info;
1689 tie my %import_formats, 'Tie::IxHash',
1690 map { $_ => $cdr_info{$_}->{'name'} }
1692 #this is not doing anything useful anymore
1693 #sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
1695 sort { lc($cdr_info{$a}->{'name'}) cmp lc($cdr_info{$b}->{'name'}) }
1697 grep { exists($cdr_info{$_}->{'import_fields'}) }
1700 sub import_formats {
1704 sub _cdr_min_parser_maker {
1706 my @fields = ref($field) ? @$field : ($field);
1707 @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
1709 my( $cdr, $min ) = @_;
1710 my $sec = eval { _cdr_min_parse($min) };
1711 die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
1712 $cdr->$_($sec) foreach @fields;
1716 sub _cdr_min_parse {
1718 sprintf('%.0f', $min * 60 );
1721 sub _cdr_date_parser_maker {
1724 my @fields = ref($field) ? @$field : ($field);
1726 my( $cdr, $datestring ) = @_;
1727 my $unixdate = eval { _cdr_date_parse($datestring, %options) };
1728 die "error parsing date for @fields from $datestring: $@\n" if $@;
1729 $cdr->$_($unixdate) foreach @fields;
1733 sub _cdr_date_parse {
1737 return '' unless length($date); #that's okay, it becomes NULL
1738 return '' if $date eq 'NA'; #sansay
1740 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 ) {
1741 my $time = str2time($date);
1742 return $time if $time > 100000; #just in case
1745 my($year, $mon, $day, $hour, $min, $sec);
1747 #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
1748 #taqua #2007-10-31 08:57:24.113000000
1750 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|$)/ ) {
1751 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1752 } 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|$)/ ) {
1753 # 8/26/2010 12:20:01
1754 # optionally without seconds
1755 ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1756 $sec = 0 if !defined($sec);
1757 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\.\d+)$/ ) {
1758 # broadsoft: 20081223201938.314
1759 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1760 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\d+(\D|$)/ ) {
1761 # Taqua OM: 20050422203450943
1762 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1763 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) {
1764 # WIP: 20100329121420
1765 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1766 } elsif ( $date =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z$/) {
1767 # Telos 2014-10-10T05:30:33Z
1768 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1770 } elsif ( $date =~ /^(\d+):(\d+):(\d+)\.\d+ \w+ (\w+) (\d+) (\d+)$/ ) {
1771 ($hour, $min, $sec, $mon, $day, $year) = ( $1, $2, $3, $4, $5, $6 );
1772 $mon = { # Acme Packet: 15:54:56.868 PST DEC 18 2017
1773 # My best guess of month abbv they may use
1774 JAN => '01', FEB => '02', MAR => '03', APR => '04',
1775 MAY => '05', JUN => '06', JUL => '07', AUG => '08',
1776 SEP => '09', OCT => '10', NOV => '11', DEC => '12'
1779 die "unparsable date: $date"; #maybe we shouldn't die...
1782 return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
1783 && $hour == 0 && $min == 0 && $sec == 0;
1785 if ($options{gmt}) {
1786 timegm($sec, $min, $hour, $day, $mon-1, $year);
1788 timelocal($sec, $min, $hour, $day, $mon-1, $year);
1792 =item batch_import HASHREF
1794 Imports CDR records. Available options are:
1806 Hash reference of preset fields, typically cdrbatch
1810 Set true to prevent throwing an error on empty imports
1816 my %import_options = (
1819 'batch_keycol' => 'cdrbatchnum',
1820 'batch_table' => 'cdr_batch',
1821 'batch_namecol' => 'cdrbatch',
1823 'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
1827 #drop the || 'csv' to allow auto xls for csv types?
1828 'format_types' => { map { $_ => lc($cdr_info{$_}->{'type'} || 'csv'); }
1832 'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
1836 'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
1840 'format_fixedlength_formats' =>
1841 { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
1845 'format_xml_formats' =>
1846 { map { $_ => $cdr_info{$_}->{'xml_format'}; }
1850 'format_asn_formats' =>
1851 { map { $_ => $cdr_info{$_}->{'asn_format'}; }
1855 'format_row_callbacks' =>
1856 { map { $_ => $cdr_info{$_}->{'row_callback'}; }
1860 'format_parser_opts' =>
1861 { map { $_ => $cdr_info{$_}->{'parser_opt'}; }
1866 sub _import_options {
1873 my $iopt = _import_options;
1874 $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
1876 if ( grep defined $opt->{$_}, qw(cdrtypenum carrierid) ) {
1877 $opt->{preinsert_callback} = sub {
1878 my($record, $param) = @_;
1879 $record->$_($opt->{$_})
1880 foreach grep defined $opt->{$_}, qw(cdrtypenum carrierid);
1885 FS::Record::batch_import( $opt );
1889 =item process_batch_import
1893 sub process_batch_import {
1896 my $opt = _import_options;
1897 # $opt->{'params'} = [ 'format', 'cdrbatch' ];
1899 FS::Record::process_batch_import( $job, $opt, @_ );
1902 # if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
1903 # @columns = map { s/^ +//; $_; } @columns;
1908 # Used by FS::Upgrade to migrate to a new database.
1910 use FS::upgrade_journal;
1912 my ($class, %opts) = @_;
1914 return if FS::upgrade_journal->is_done('cdr_cdrbatchnum');
1916 warn "$me upgrading $class\n" if $DEBUG;
1918 my $sth = dbh->prepare(
1919 'SELECT DISTINCT(cdrbatch) FROM cdr WHERE cdrbatch IS NOT NULL'
1920 ) or die dbh->errstr;
1922 $sth->execute or die $sth->errstr;
1924 my %cdrbatchnum = ();
1925 while (my $row = $sth->fetchrow_arrayref) {
1927 my $cdr_batch = qsearchs( 'cdr_batch', { 'cdrbatch' => $row->[0] } );
1928 unless ( $cdr_batch ) {
1929 $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] };
1930 my $error = $cdr_batch->insert;
1931 die $error if $error;
1934 $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum;
1937 $sth = dbh->prepare('UPDATE cdr SET cdrbatch = NULL, cdrbatchnum = ? WHERE cdrbatch IS NOT NULL AND cdrbatch = ?') or die dbh->errstr;
1939 foreach my $cdrbatch (keys %cdrbatchnum) {
1940 $sth->execute($cdrbatchnum{$cdrbatch}, $cdrbatch) or die $sth->errstr;
1943 FS::upgrade_journal->set_done('cdr_cdrbatchnum');
1947 =item ip_addr_sql FIELD RANGE
1949 Returns an SQL condition to search for CDRs with an IP address
1950 within RANGE. FIELD is either 'src_ip_addr' or 'dst_ip_addr'. RANGE
1951 should be in the form "a.b.c.d-e.f.g.h' (dotted quads), where any of
1952 the leftmost octets of the second address can be omitted if they're
1953 the same as the first address.
1959 my ($field, $range) = @_;
1960 $range =~ /^[\d\.-]+$/ or die "bad ip address range '$range'";
1961 my @r = split('-', $range);
1962 my @saddr = split('\.', $r[0] || '');
1963 my @eaddr = split('\.', $r[1] || '');
1964 unshift @eaddr, (undef) x (4 - scalar @eaddr);
1966 $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
1968 "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
1969 "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
1978 L<FS::Record>, schema.html from the base documentation.