4 use vars qw( @ISA @EXPORT_OK $DEBUG $me
5 $conf $cdr_prerate %cdr_prerate_cdrtypenums
6 $use_lrn $support_key $max_duration
9 use List::Util qw(first min);
14 use List::Util qw( first min );
16 use FS::UID qw( dbh );
18 use FS::Record qw( qsearch qsearchs );
23 use FS::cdr_termination;
30 use HTTP::Request::Common qw(POST);
34 @ISA = qw(FS::Record);
35 @EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker _cdr_date_parse );
40 #ask FS::UID to run this stuff for us later
41 FS::UID->install_callback( sub {
44 my @cdr_prerate_cdrtypenums;
45 $cdr_prerate = $conf->exists('cdr-prerate');
46 @cdr_prerate_cdrtypenums = $conf->config('cdr-prerate-cdrtypenums')
48 %cdr_prerate_cdrtypenums = map { $_=>1 } @cdr_prerate_cdrtypenums;
50 $support_key = $conf->config('support-key');
51 $use_lrn = $conf->exists('cdr-lrn_lookup');
53 $max_duration = $conf->config('cdr-max_duration') || 0;
59 FS::cdr - Object methods for cdr records
65 $record = new FS::cdr \%hash;
66 $record = new FS::cdr { 'column' => 'value' };
68 $error = $record->insert;
70 $error = $new_record->replace($old_record);
72 $error = $record->delete;
74 $error = $record->check;
78 An FS::cdr object represents an Call Data Record, typically from a telephony
79 system or provider of some sort. FS::cdr inherits from FS::Record. The
80 following fields are currently supported:
84 =item acctid - primary key
86 =item calldate - Call timestamp (SQL timestamp)
88 =item clid - Caller*ID with text
90 =item src - Caller*ID number / Source number
92 =item dst - Destination extension
94 =item dcontext - Destination context
96 =item channel - Channel used
98 =item dstchannel - Destination channel if appropriate
100 =item lastapp - Last application if appropriate
102 =item lastdata - Last application data
104 =item src_ip_addr - Source IP address (dotted quad, zero-filled)
106 =item dst_ip_addr - Destination IP address (same)
108 =item dst_term - Terminating destination number (if different from dst)
110 =item startdate - Start of call (UNIX-style integer timestamp)
112 =item answerdate - Answer time of call (UNIX-style integer timestamp)
114 =item enddate - End time of call (UNIX-style integer timestamp)
116 =item duration - Total time in system, in seconds
118 =item billsec - Total time call is up, in seconds
120 =item disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
122 =item amaflags - What flags to use: BILL, IGNORE etc, specified on a per channel basis like accountcode.
126 #ignore the "omit" and "documentation" AMAs??
127 #AMA = Automated Message Accounting.
128 #default: Sets the system default.
129 #omit: Do not record calls.
130 #billing: Mark the entry for billing
131 #documentation: Mark the entry for documentation.
133 =item accountcode - CDR account number to use: account
135 =item uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
137 =item userfield - CDR user-defined field
139 =item cdr_type - CDR type - see L<FS::cdr_type> (Usage = 1, S&E = 7, OC&C = 8)
141 =item charged_party - Service number to be billed
143 =item upstream_currency - Wholesale currency from upstream
145 =item upstream_price - Wholesale price from upstream
147 =item upstream_rateplanid - Upstream rate plan ID
149 =item rated_price - Rated (or re-rated) price
151 =item distance - km (need units field?)
153 =item islocal - Local - 1, Non Local = 0
155 =item calltypenum - Type of call - see L<FS::cdr_calltype>
157 =item description - Description (cdr_type 7&8 only) (used for cust_bill_pkg.itemdesc)
159 =item quantity - Number of items (cdr_type 7&8 only)
161 =item carrierid - Upstream Carrier ID (see L<FS::cdr_carrier>)
165 #Telstra =1, Optus = 2, RSL COM = 3
167 =item upstream_rateid - Upstream Rate ID
169 =item svcnum - Link to customer service (see L<FS::cust_svc>)
171 =item freesidestatus - NULL, processing-tiered, rated, done, skipped, no-charge, failed
173 =item freesiderewritestatus - NULL, done, skipped
177 =item detailnum - Link to invoice detail (L<FS::cust_bill_pkg_detail>)
179 =item sipcallid - SIP Call-ID
189 Creates a new CDR. To add the CDR to the database, see L<"insert">.
191 Note that this stores the hash reference, not a distinct copy of the hash it
192 points to. You can ask the object for a copy with the I<hash> method.
196 # the new method can be inherited from FS::Record, if a table method is defined
203 #XXX fill in some (more) nice names
205 'calldate' => 'Call date',
206 'clid' => 'Caller ID',
208 'dst' => 'Destination',
209 'dcontext' => 'Dest. context',
210 'channel' => 'Channel',
211 'dstchannel' => 'Destination channel',
214 'src_ip_addr' => 'Source IP',
215 'dst_ip_addr' => 'Dest. IP',
216 'dst_term' => 'Termination dest.',
217 'startdate' => 'Start date',
218 'answerdate' => 'Answer date',
219 'enddate' => 'End date',
220 'duration' => 'Duration',
221 'billsec' => 'Billable seconds',
222 'disposition' => 'Disposition',
223 'amaflags' => 'AMA flags',
224 'accountcode' => 'Account code',
226 'userfield' => 'User field',
228 'charged_party' => 'Charged party',
229 #'upstream_currency' => '',
230 'upstream_price' => 'Upstream price',
231 #'upstream_rateplanid' => '',
232 #'ratedetailnum' => '',
233 'src_lrn' => 'Source LRN',
234 'dst_lrn' => 'Dest. LRN',
235 'rated_price' => 'Rated price',
236 'rated_cost' => 'Rated cost',
239 #'calltypenum' => '',
240 #'description' => '',
242 'carrierid' => 'Carrier ID',
243 #'upstream_rateid' => '',
244 'svcnum' => 'Freeside service',
245 'freesidestatus' => 'Freeside status',
246 'freesiderewritestatus' => 'Freeside rewrite status',
247 'cdrbatch' => 'Legacy batch',
248 'cdrbatchnum' => 'Batch',
249 'detailnum' => 'Freeside invoice detail line',
258 Adds this record to the database. If there is an error, returns the error,
259 otherwise returns false.
263 # the insert method can be inherited from FS::Record
267 Delete this record from the database.
271 # the delete method can be inherited from FS::Record
273 =item replace OLD_RECORD
275 Replaces the OLD_RECORD with this one in the database. If there is an error,
276 returns the error, otherwise returns false.
280 # the replace method can be inherited from FS::Record
284 Checks all fields to make sure this is a valid CDR. If there is
285 an error, returns the error, otherwise returns false. Called by the insert
288 Note: Unlike most types of records, we don't want to "reject" a CDR and we want
289 to process them as quickly as possible, so we allow the database to check most
297 # we don't want to "reject" a CDR like other sorts of input...
299 # $self->ut_numbern('acctid')
300 ## || $self->ut_('calldate')
301 # || $self->ut_text('clid')
302 # || $self->ut_text('src')
303 # || $self->ut_text('dst')
304 # || $self->ut_text('dcontext')
305 # || $self->ut_text('channel')
306 # || $self->ut_text('dstchannel')
307 # || $self->ut_text('lastapp')
308 # || $self->ut_text('lastdata')
309 # || $self->ut_numbern('startdate')
310 # || $self->ut_numbern('answerdate')
311 # || $self->ut_numbern('enddate')
312 # || $self->ut_number('duration')
313 # || $self->ut_number('billsec')
314 # || $self->ut_text('disposition')
315 # || $self->ut_number('amaflags')
316 # || $self->ut_text('accountcode')
317 # || $self->ut_text('uniqueid')
318 # || $self->ut_text('userfield')
319 # || $self->ut_numbern('cdrtypenum')
320 # || $self->ut_textn('charged_party')
321 ## || $self->ut_n('upstream_currency')
322 ## || $self->ut_n('upstream_price')
323 # || $self->ut_numbern('upstream_rateplanid')
324 ## || $self->ut_n('distance')
325 # || $self->ut_numbern('islocal')
326 # || $self->ut_numbern('calltypenum')
327 # || $self->ut_textn('description')
328 # || $self->ut_numbern('quantity')
329 # || $self->ut_numbern('carrierid')
330 # || $self->ut_numbern('upstream_rateid')
331 # || $self->ut_numbern('svcnum')
332 # || $self->ut_textn('freesidestatus')
333 # || $self->ut_textn('freesiderewritestatus')
335 # return $error if $error;
337 for my $f ( grep { $self->$_ =~ /\D/ } qw(startdate answerdate enddate)){
338 $self->$f( str2time($self->$f) );
341 $self->calldate( $self->startdate_sql )
342 if !$self->calldate && $self->startdate;
344 #was just for $format eq 'taqua' but can't see the harm... add something to
345 #disable if it becomes a problem
346 if ( $self->duration eq '' && $self->enddate && $self->startdate ) {
347 $self->duration( $self->enddate - $self->startdate );
349 if ( $self->billsec eq '' && $self->enddate && $self->answerdate ) {
350 $self->billsec( $self->enddate - $self->answerdate );
353 if ( ! $self->enddate && $self->startdate && $self->duration ) {
354 $self->enddate( $self->startdate + $self->duration );
357 $self->set_charged_party;
359 #check the foreign keys even?
360 #do we want to outright *reject* the CDR?
361 my $error = $self->ut_numbern('acctid');
362 return $error if $error;
364 if ( $self->freesidestatus ne 'done' ) {
365 $self->set('detailnum', ''); # can't have this on an unbilled call
368 #add a config option to turn these back on if someone needs 'em
370 # #Usage = 1, S&E = 7, OC&C = 8
371 # || $self->ut_foreign_keyn('cdrtypenum', 'cdr_type', 'cdrtypenum' )
373 # #the big list in appendix 2
374 # || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
376 # # Telstra =1, Optus = 2, RSL COM = 3
377 # || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
382 =item is_tollfree [ COLUMN ]
384 Returns true when the cdr represents a toll free number and false otherwise.
386 By default, inspects the dst field, but an optional column name can be passed
387 to inspect other field.
393 my $field = scalar(@_) ? shift : 'dst';
394 my $country = $conf->config('tollfree-country') || '';
395 if ( $country eq 'AU' ) {
396 ( $self->$field() =~ /^(\+?61)?(1800|1300)/ ) ? 1 : 0;
397 } elsif ( $country eq 'NZ' ) {
398 ( $self->$field() =~ /^(\+?64)?(800|508)/ ) ? 1 : 0;
399 } else { #NANPA (US/Canaada)
400 ( $self->$field() =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0;
404 =item set_charged_party
406 If the charged_party field is already set, does nothing. Otherwise:
408 If the cdr-charged_party-accountcode config option is enabled, sets the
409 charged_party to the accountcode.
411 Otherwise sets the charged_party normally: to the src field in most cases,
412 or to the dst field if it is a toll free number.
416 sub set_charged_party {
419 my $conf = new FS::Conf;
421 unless ( $self->charged_party ) {
423 if ( $conf->exists('cdr-charged_party-accountcode') && $self->accountcode ){
425 my $charged_party = $self->accountcode;
426 $charged_party =~ s/^0+//
427 if $conf->exists('cdr-charged_party-accountcode-trim_leading_0s');
428 $self->charged_party( $charged_party );
430 } elsif ( $conf->exists('cdr-charged_party-field') ) {
432 my $field = $conf->config('cdr-charged_party-field');
433 $self->charged_party( $self->$field() );
437 if ( $self->is_tollfree ) {
438 $self->charged_party($self->dst);
440 $self->charged_party($self->src);
447 # my $prefix = $conf->config('cdr-charged_party-truncate_prefix');
448 # my $prefix_len = length($prefix);
449 # my $trunc_len = $conf->config('cdr-charged_party-truncate_length');
451 # $self->charged_party( substr($self->charged_party, 0, $trunc_len) )
452 # if $prefix_len && $trunc_len
453 # && substr($self->charged_party, 0, $prefix_len) eq $prefix;
457 =item set_status STATUS
459 Sets the status to the provided string. If there is an error, returns the
460 error, otherwise returns false.
462 If status is being changed from 'rated' to some other status, also removes
463 any usage allocations to this CDR.
468 my($self, $status) = @_;
469 my $old_status = $self->freesidestatus;
470 $self->freesidestatus($status);
471 my $error = $self->replace;
472 if ( $old_status eq 'rated' and $status ne 'done' ) {
473 # deallocate any usage
474 foreach (qsearch('cdr_cust_pkg_usage', {acctid => $self->acctid})) {
475 my $cust_pkg_usage = $_->cust_pkg_usage;
476 $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $_->minutes);
477 $error ||= $cust_pkg_usage->replace || $_->delete;
483 =item set_status_and_rated_price STATUS RATED_PRICE [ SVCNUM [ OPTION => VALUE ... ] ]
485 Sets the status and rated price.
487 Available options are: inbound, rated_pretty_dst, rated_regionname,
488 rated_seconds, rated_minutes, rated_granularity, rated_ratedetailnum,
489 rated_classnum, rated_ratename. If rated_ratedetailnum is provided,
490 will also set a recalculated L</rate_cost> in the rated_cost field
491 after the other fields are set (does not work with inbound.)
493 If there is an error, returns the error, otherwise returns false.
497 sub set_status_and_rated_price {
498 my($self, $status, $rated_price, $svcnum, %opt) = @_;
500 if ($opt{'inbound'}) {
502 my $term = $self->cdr_termination( 1 ); #1: inbound
505 warn "replacing existing cdr status (".$self->acctid.")\n" if $term;
506 $error = $term->delete;
507 return $error if $error;
509 $term = FS::cdr_termination->new({
510 acctid => $self->acctid,
512 rated_price => $rated_price,
515 foreach (qw(rated_seconds rated_minutes rated_granularity)) {
516 $term->set($_, $opt{$_}) if exists($opt{$_});
518 $term->svcnum($svcnum) if $svcnum;
519 return $term->insert;
523 $self->freesidestatus($status);
524 $self->rated_price($rated_price);
526 foreach grep exists($opt{$_}), map "rated_$_",
527 qw( pretty_dst regionname seconds minutes granularity
528 ratedetailnum classnum ratename );
529 $self->svcnum($svcnum) if $svcnum;
530 $self->rated_cost($self->rate_cost) if $opt{'rated_ratedetailnum'};
532 return $self->replace();
537 =item parse_number [ OPTION => VALUE ... ]
539 Returns two scalars, the countrycode and the rest of the number.
541 Options are passed as name-value pairs. Currently available options are:
547 The column containing the number to be parsed. Defaults to dst.
549 =item international_prefix
551 The digits for international dialing. Defaults to '011' The value '+' is
554 =item domestic_prefix
556 The digits for domestic long distance dialing. Defaults to '1'
563 my ($self, %options) = @_;
565 my $field = $options{column} || 'dst';
566 my $intl = $options{international_prefix} || '011';
567 # Still, don't break anyone's CDR rating if they have an empty string in
568 # there. Require an explicit statement that there's no prefix.
569 $intl = '' if lc($intl) eq 'none';
570 my $countrycode = '';
571 my $number = $self->$field();
573 my $to_or_from = 'concerning';
574 $to_or_from = 'from' if $field eq 'src';
575 $to_or_from = 'to' if $field eq 'dst';
576 warn "parsing call $to_or_from $number\n" if $DEBUG;
578 #remove non-phone# stuff and whitespace
581 # $dest =~ s/^(\w+):// and $proto = $1; #sip:
583 # $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
585 if ( $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
586 || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
590 my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 );
591 #first look for 1 digit country code
592 if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) {
594 $number = $u1.$u2.$rest;
595 } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
598 } else { #3 digit country code
599 $countrycode = $three;
604 my $domestic_prefix =
605 exists($options{domestic_prefix}) ? $options{domestic_prefix} : '';
606 $countrycode = length($domestic_prefix) ? $domestic_prefix : '1';
607 $number =~ s/^$countrycode//;# if length($number) > 10;
610 return($countrycode, $number);
614 =item rate [ OPTION => VALUE ... ]
616 Rates this CDR according and sets the status to 'rated'.
618 Available options are: part_pkg, svcnum, plan_included_min,
619 detail_included_min_hashref.
621 part_pkg is required.
623 If svcnum is specified, will also associate this CDR with the specified svcnum.
625 plan_included_min should be set to a scalar reference of the number of
626 included minutes and will be decremented by the rated minutes of this
629 detail_included_min_hashref should be set to an empty hashref at the
630 start of a month's rating and then preserved across CDRs.
635 my( $self, %opt ) = @_;
636 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
639 warn "rating CDR $self\n".
640 join('', map { " $_ => ". $self->{$_}. "\n" } keys %$self );
643 my $rating_method = $part_pkg->option_cacheable('rating_method') || 'prefix';
644 my $method = "rate_$rating_method";
645 $self->$method(%opt);
649 our %interval_cache = (); # for timed rates
652 my( $self, %opt ) = @_;
653 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
654 my $cust_pkg = $opt{'cust_pkg'};
657 # (Directory assistance) rewriting
661 # this will result in those CDRs being marked as done... is that
664 if ( $part_pkg->option_cacheable('411_rewrite') ) {
665 my $dirass = $part_pkg->option_cacheable('411_rewrite');
667 @dirass = split(',', $dirass);
670 if ( length($self->dst) && grep { $self->dst eq $_ } @dirass ) {
676 # Checks to see if the CDR is chargeable
679 my $reason = $part_pkg->check_chargable( $self,
680 'da_rewrote' => $da_rewrote,
683 warn "not charging for CDR ($reason)\n" if $DEBUG;
684 return $self->set_status_and_rated_price( 'skipped',
690 if ( $part_pkg->option_cacheable('skip_same_customer')
691 and ! $self->is_tollfree ) {
692 my ($dst_countrycode, $dst_number) = $self->parse_number(
694 international_prefix => $part_pkg->option_cacheable('international_prefix'),
695 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
697 my $dst_same_cust = FS::Record->scalar_sql(
698 'SELECT COUNT(svc_phone.svcnum) AS count '.
700 'JOIN cust_svc USING (pkgnum) ' .
701 'JOIN svc_phone USING (svcnum) ' .
702 'WHERE svc_phone.countrycode = ' . dbh->quote($dst_countrycode) .
703 ' AND svc_phone.phonenum = ' . dbh->quote($dst_number) .
704 ' AND cust_pkg.custnum = ' . $cust_pkg->custnum,
706 if ( $dst_same_cust > 0 ) {
707 warn "not charging for CDR (same source and destination customer)\n" if $DEBUG;
708 return $self->set_status_and_rated_price( 'skipped',
715 my $rated_seconds = $part_pkg->option_cacheable('use_duration')
718 if ( $max_duration > 0 && $rated_seconds > $max_duration ) {
719 return $self->set_status_and_rated_price(
727 # look up rate details based on called station id
728 # (or calling station id for toll free calls)
731 my $eff_ratenum = $self->is_tollfree('accountcode')
732 ? $part_pkg->option_cacheable('accountcode_tollfree_ratenum')
735 my( $to_or_from, $column );
738 && ! $part_pkg->option_cacheable('disable_tollfree')
741 && $part_pkg->option_cacheable('accountcode_tollfree_field') eq 'src'
745 $to_or_from = 'from';
747 } else { #regular call
752 #determine the country code
753 my ($countrycode, $number) = $self->parse_number(
755 international_prefix => $part_pkg->option_cacheable('international_prefix'),
756 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
760 my $intrastate_ratenum = $part_pkg->option_cacheable('intrastate_ratenum');
762 if ( $use_lrn and $countrycode eq '1' ) {
764 # then ask about the number
765 foreach my $field ('src', 'dst') {
767 $self->get_lrn($field);
768 if ( $field eq $column ) {
769 # then we are rating on this number
770 $number = $self->get($field.'_lrn');
772 # is this ever meaningful? can the LRN be outside NANP space?
779 warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG;
780 my $pretty_dst = "+$countrycode $number";
781 #asterisks here causes inserting the detail to barf, so:
782 $pretty_dst =~ s/\*//g;
784 # should check $countrycode eq '1' here?
785 if ( $intrastate_ratenum && !$self->is_tollfree ) {
786 $ratename = 'Interstate'; #until proven otherwise
787 # this is relatively easy only because:
788 # -assume all numbers are valid NANP numbers NOT in a fully-qualified format
789 # -disregard toll-free
790 # -disregard private or unknown numbers
791 # -there is exactly one record in rate_prefix for a given NPANXX
792 # -default to interstate if we can't find one or both of the prefixes
793 my $dst_col = $use_lrn ? 'dst_lrn' : 'dst';
794 my $src_col = $use_lrn ? 'src_lrn' : 'src';
795 my (undef, $dstprefix) = $self->parse_number(
797 international_prefix => $part_pkg->option_cacheable('international_prefix'),
798 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
800 $dstprefix =~ /^(\d{6})/;
801 $dstprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
804 my (undef, $srcprefix) = $self->parse_number(
806 international_prefix => $part_pkg->option_cacheable('international_prefix'),
807 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
809 $srcprefix =~ /^(\d{6})/;
810 $srcprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
813 if ($srcprefix && $dstprefix
814 && $srcprefix->state && $dstprefix->state
815 && $srcprefix->state eq $dstprefix->state) {
816 $eff_ratenum = $intrastate_ratenum;
817 $ratename = 'Intrastate'; # XXX possibly just use the ratename?
821 $eff_ratenum ||= $part_pkg->option_cacheable('ratenum');
822 my $rate = qsearchs('rate', { 'ratenum' => $eff_ratenum })
823 or die "ratenum $eff_ratenum not found!";
825 my @ltime = localtime($self->startdate);
826 my $weektime = $ltime[0] +
827 $ltime[1]*60 + #minutes
828 $ltime[2]*3600 + #hours
829 $ltime[6]*86400; #days since sunday
830 # if there's no timed rate_detail for this time/region combination,
831 # dest_detail returns the default. There may still be a timed rate
832 # that applies after the starttime of the call, so be careful...
833 my $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
834 'phonenum' => $number,
835 'weektime' => $weektime,
836 'cdrtypenum' => $self->cdrtypenum,
839 unless ( $rate_detail ) {
841 if ( $part_pkg->option_cacheable('ignore_unrateable') ) {
843 if ( $part_pkg->option_cacheable('ignore_unrateable') == 2 ) {
844 # mark the CDR as unrateable
845 return $self->set_status_and_rated_price(
850 } elsif ( $part_pkg->option_cacheable('ignore_unrateable') == 1 ) {
852 warn "no rate_detail found for CDR.acctid: ". $self->acctid.
857 die "unknown ignore_unrateable, pkgpart ". $part_pkg->pkgpart;
862 die "FATAL: no rate_detail found in ".
863 $rate->ratenum. ":". $rate->ratename. " rate plan ".
864 "for +$countrycode $number (CDR acctid ". $self->acctid. "); ".
865 "add a rate or set ignore_unrateable flag on the package def\n";
870 my $regionnum = $rate_detail->dest_regionnum;
871 my $rate_region = $rate_detail->dest_region;
872 warn " found rate for regionnum $regionnum ".
873 "and rate detail $rate_detail\n"
876 if ( !exists($interval_cache{$regionnum}) ) {
878 sort { $a->stime <=> $b->stime }
879 map { $_->rate_time->intervals }
880 qsearch({ 'table' => 'rate_detail',
881 'hashref' => { 'ratenum' => $rate->ratenum },
882 'extra_sql' => 'AND ratetimenum IS NOT NULL',
885 $interval_cache{$regionnum} = \@intervals;
886 warn " cached ".scalar(@intervals)." interval(s)\n"
891 # find the price and add detail to the invoice
894 # About this section:
895 # We don't round _anything_ (except granularizing)
896 # until the final $charge = sprintf("%.2f"...).
898 my $seconds_left = $rated_seconds;
900 #no, do this later so it respects (group) included minutes
901 # # charge for the first (conn_sec) seconds
902 # my $seconds = min($seconds_left, $rate_detail->conn_sec);
903 # $seconds_left -= $seconds;
904 # $weektime += $seconds;
905 # my $charge = $rate_detail->conn_charge;
908 my $connection_charged = 0;
910 # before doing anything else, if there's an upstream multiplier and
911 # an upstream price, add that to the charge. (usually the rate detail
912 # will then have a minute charge of zero, but not necessarily.)
913 $charge += ($self->upstream_price || 0) * $rate_detail->upstream_mult_charge;
916 while($seconds_left) {
917 my $ratetimenum = $rate_detail->ratetimenum; # may be empty
919 # find the end of the current rate interval
920 if(@{ $interval_cache{$regionnum} } == 0) {
921 # There are no timed rates in this group, so just stay
922 # in the default rate_detail for the entire duration.
923 # Set an "end" of 1 past the end of the current call.
924 $etime = $weektime + $seconds_left + 1;
926 elsif($ratetimenum) {
927 # This is a timed rate, so go to the etime of this interval.
928 # If it's followed by another timed rate, the stime of that
929 # interval should match the etime of this one.
930 my $interval = $rate_detail->rate_time->contains($weektime);
931 $etime = $interval->etime;
934 # This is a default rate, so use the stime of the next
935 # interval in the sequence.
936 my $next_int = first { $_->stime > $weektime }
937 @{ $interval_cache{$regionnum} };
939 $etime = $next_int->stime;
942 # weektime is near the end of the week, so decrement
943 # it by a full week and use the stime of the first
945 $weektime -= (3600*24*7);
946 $etime = $interval_cache{$regionnum}->[0]->stime;
950 my $charge_sec = min($seconds_left, $etime - $weektime);
952 $seconds_left -= $charge_sec;
954 my $granularity = $rate_detail->sec_granularity;
957 if ( $granularity ) { # charge per minute
958 # Round up to the nearest $granularity
959 if ( $charge_sec and $charge_sec % $granularity ) {
960 $charge_sec += $granularity - ($charge_sec % $granularity);
962 $minutes = $charge_sec / 60; #don't round this
969 #$seconds += $charge_sec;
971 if ( $rate_detail->min_included ) {
972 # the old, kind of deprecated way to do this:
974 # The rate detail itself has included minutes. We MUST have a place
976 my $included_min = $opt{'detail_included_min_hashref'}
977 or return "unable to rate CDR: rate detail has included minutes, but ".
978 "no detail_included_min_hashref provided.\n";
980 # by default, set the included minutes for this region/time to
981 # what's in the rate_detail
982 if (!exists( $included_min->{$regionnum}{$ratetimenum} )) {
983 $included_min->{$regionnum}{$ratetimenum} =
984 ($rate_detail->min_included * $cust_pkg->quantity || 1);
987 if ( $included_min->{$regionnum}{$ratetimenum} >= $minutes ) {
989 $included_min->{$regionnum}{$ratetimenum} -= $minutes;
991 $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60);
992 $included_min->{$regionnum}{$ratetimenum} = 0;
994 } elsif ( $opt{plan_included_min} && ${ $opt{plan_included_min} } > 0 ) {
995 # The package definition has included minutes, but only for in-group
996 # rate details. Decrement them if this is an in-group call.
997 if ( $rate_detail->region_group ) {
998 if ( ${ $opt{'plan_included_min'} } >= $minutes ) {
1000 ${ $opt{'plan_included_min'} } -= $minutes;
1002 $charge_sec -= (${ $opt{'plan_included_min'} } * 60);
1003 ${ $opt{'plan_included_min'} } = 0;
1008 my $applied_min = $cust_pkg->apply_usage(
1010 'rate_detail' => $rate_detail,
1011 'minutes' => $minutes
1013 # for now, usage pools deal only in whole minutes
1014 $charge_sec -= $applied_min * 60;
1017 if ( $charge_sec > 0 ) {
1019 #NOW do connection charges here... right?
1020 #my $conn_seconds = min($seconds_left, $rate_detail->conn_sec);
1021 my $conn_seconds = 0;
1022 unless ( $connection_charged++ ) { #only one connection charge
1023 $conn_seconds = min($charge_sec, $rate_detail->conn_sec);
1024 $seconds_left -= $conn_seconds;
1025 $weektime += $conn_seconds;
1026 $charge += $rate_detail->conn_charge;
1029 #should preserve (display?) this
1030 if ( $granularity == 0 ) { # per call rate
1031 $charge += $rate_detail->min_charge;
1033 my $charge_min = ( $charge_sec - $conn_seconds ) / 60;
1034 $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
1039 # choose next rate_detail
1040 $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
1041 'phonenum' => $number,
1042 'weektime' => $etime,
1043 'cdrtypenum' => $self->cdrtypenum })
1045 # we have now moved forward to $etime
1048 } #while $seconds_left
1050 # this is why we need regionnum/rate_region....
1051 warn " (rate region $rate_region)\n" if $DEBUG;
1054 my $rounding = $part_pkg->option_cacheable('rounding') || 2;
1055 my $sprintformat = '%.'. $rounding. 'f';
1056 my $roundup = 10**(-3-$rounding);
1057 my $price = sprintf($sprintformat, $charge + $roundup);
1059 $self->set_status_and_rated_price(
1063 'rated_pretty_dst' => $pretty_dst,
1064 'rated_regionname' => ($rate_region ? $rate_region->regionname : ''),
1065 'rated_seconds' => $rated_seconds, #$seconds,
1066 'rated_granularity' => $rate_detail->sec_granularity, #$granularity
1067 'rated_ratedetailnum' => $rate_detail->ratedetailnum,
1068 'rated_classnum' => $rate_detail->classnum, #rated_ratedetailnum?
1069 'rated_ratename' => $ratename, #not rate_detail - Intrastate/Interstate
1074 sub rate_upstream_simple {
1075 my( $self, %opt ) = @_;
1077 $self->set_status_and_rated_price(
1079 sprintf('%.3f', $self->upstream_price),
1081 'rated_classnum' => $self->calltypenum,
1082 'rated_seconds' => $self->billsec,
1083 # others? upstream_*_regionname => rated_regionname is possible
1087 sub rate_single_price {
1088 my( $self, %opt ) = @_;
1089 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
1091 # a little false laziness w/abov
1092 # $rate_detail = new FS::rate_detail({sec_granularity => ... }) ?
1094 my $granularity = length($part_pkg->option_cacheable('sec_granularity'))
1095 ? $part_pkg->option_cacheable('sec_granularity')
1098 my $seconds = $part_pkg->option_cacheable('use_duration')
1102 $seconds += $granularity - ( $seconds % $granularity )
1103 if $seconds # don't granular-ize 0 billsec calls (bills them)
1104 && $granularity # 0 is per call
1105 && $seconds % $granularity;
1106 my $minutes = $granularity ? ($seconds / 60) : 1;
1108 my $charge_min = $minutes;
1110 ${$opt{plan_included_min}} -= $minutes;
1111 if ( ${$opt{plan_included_min}} > 0 ) {
1114 $charge_min = 0 - ${$opt{plan_included_min}};
1115 ${$opt{plan_included_min}} = 0;
1119 sprintf('%.4f', ( $part_pkg->option_cacheable('min_charge') * $charge_min )
1120 + 0.0000000001 ); #so 1.00005 rounds to 1.0001
1122 $self->set_status_and_rated_price(
1126 'rated_granularity' => $granularity,
1127 'rated_seconds' => $seconds,
1134 Rates an already-rated CDR according to the cost fields from the rate plan.
1143 return 0 unless $self->rated_ratedetailnum;
1146 qsearchs('rate_detail', { 'ratedetailnum' => $self->rated_ratedetailnum } );
1149 $charge += ($self->upstream_price || 0) * ($rate_detail->upstream_mult_cost);
1151 if ( $self->rated_granularity == 0 ) {
1152 $charge += $rate_detail->min_cost;
1154 my $minutes = $self->rated_seconds / 60;
1155 $charge += $rate_detail->conn_cost + $minutes * $rate_detail->min_cost;
1158 sprintf('%.2f', $charge + .00001 );
1162 =item cdr_termination [ TERMPART ]
1166 sub cdr_termination {
1169 if ( scalar(@_) && $_[0] ) {
1170 my $termpart = shift;
1172 qsearchs('cdr_termination', { acctid => $self->acctid,
1173 termpart => $termpart,
1179 qsearch('cdr_termination', { acctid => $self->acctid, } );
1187 Parses the calldate in SQL string format and returns a UNIX timestamp.
1192 str2time(shift->calldate);
1197 Parses the startdate in UNIX timestamp format and returns a string in SQL
1203 my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
1206 "$year-$mon-$mday $hour:$min:$sec";
1211 Returns the FS::cdr_carrier object associated with this CDR, or false if no
1212 carrierid is defined.
1216 my %carrier_cache = ();
1220 return '' unless $self->carrierid;
1221 $carrier_cache{$self->carrierid} ||=
1222 qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
1227 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
1228 no FS::cdr_carrier object is assocated with this CDR.
1234 my $cdr_carrier = $self->cdr_carrier;
1235 $cdr_carrier ? $cdr_carrier->carriername : '';
1240 Returns the FS::cdr_calltype object associated with this CDR, or false if no
1241 calltypenum is defined.
1245 my %calltype_cache = ();
1249 return '' unless $self->calltypenum;
1250 $calltype_cache{$self->calltypenum} ||=
1251 qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
1256 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
1257 no FS::cdr_calltype object is assocated with this CDR.
1263 my $cdr_calltype = $self->cdr_calltype;
1264 $cdr_calltype ? $cdr_calltype->calltypename : '';
1267 =item downstream_csv [ OPTION => VALUE, ... ]
1271 # in the future, load this dynamically from detail_format classes
1273 my %export_names = (
1276 'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
1279 'name' => 'Simple with source',
1280 'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
1281 #"Date,Time,Name,Called From,Destination,Duration,Price",
1283 'accountcode_simple' => {
1284 'name' => 'Simple with accountcode',
1285 'invoice_header' => "Date,Time,Called From,Account,Duration,Price",
1289 'invoice_header' => "Date/Time,Called Number,Min/Sec,Price",
1291 'basic_upstream_dst_regionname' => {
1292 'name' => 'Basic with upstream destination name',
1293 'invoice_header' => "Date/Time,Called Number,Destination,Min/Sec,Price",
1296 'name' => 'Default',
1297 'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
1299 'source_default' => {
1300 'name' => 'Default with source',
1301 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1303 'accountcode_default' => {
1304 'name' => 'Default plus accountcode',
1305 'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
1307 'description_default' => {
1308 'name' => 'Default with description field as destination',
1309 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1312 'name' => 'Summary, one line per service',
1313 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1316 'name' => 'Number of calls, one line per service',
1317 'invoice_header' => 'Caller,Rate,Messages,Price',
1320 'name' => 'Summary, one line per service',
1321 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1323 'sum_duration_prefix' => {
1324 'name' => 'Summary, one line per destination prefix',
1325 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1327 'sum_count_class' => {
1328 'name' => 'Summary, one line per usage class',
1329 'invoice_header' => 'Caller,Class,Calls,Price',
1331 'sum_duration_accountcode' => {
1332 'name' => 'Summary, one line per accountcode',
1333 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1337 my %export_formats = ();
1338 sub export_formats {
1341 return %export_formats if keys %export_formats;
1343 my $conf = new FS::Conf;
1344 my $date_format = $conf->config('date_format') || '%m/%d/%Y';
1346 # call duration in the largest units that accurately reflect the granularity
1347 my $duration_sub = sub {
1348 my($cdr, %opt) = @_;
1349 my $sec = $opt{seconds} || $cdr->billsec;
1350 if ( defined $opt{granularity} &&
1351 $opt{granularity} == 0 ) { #per call
1354 elsif ( defined $opt{granularity} && $opt{granularity} == 60 ) {#full minutes
1355 my $min = int($sec/60);
1359 else { #anything else
1360 return sprintf("%dm %ds", $sec/60, $sec%60);
1364 my $price_sub = sub {
1365 my ($cdr, %opt) = @_;
1367 if ( defined($opt{charge}) ) {
1368 $price = $opt{charge};
1370 elsif ( $opt{inbound} ) {
1371 my $term = $cdr->cdr_termination(1); # 1 = inbound
1372 $price = $term->rated_price if defined $term;
1375 $price = $cdr->rated_price;
1377 length($price) ? ($opt{money_char} . $price) : '';
1380 my $src_sub = sub { $_[0]->clid || $_[0]->src };
1384 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1385 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1387 'dst', #NUMBER_DIALED
1388 $duration_sub, #DURATION
1389 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1393 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1394 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1396 $src_sub, #called from
1397 'dst', #NUMBER_DIALED
1398 $duration_sub, #DURATION
1399 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1402 'accountcode_simple' => [
1403 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1404 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1405 $src_sub, #called from
1406 'accountcode', #NUMBER_DIALED
1407 $duration_sub, #DURATION
1411 # for summary formats, the CDR is a fictitious object containing the
1412 # total billsec and the phone number of the service
1414 sub { my($cdr, %opt) = @_; $opt{ratename} },
1415 sub { my($cdr, %opt) = @_; $opt{count} },
1416 sub { my($cdr, %opt) = @_; int($opt{seconds}/60).'m' },
1421 sub { my($cdr, %opt) = @_; $opt{ratename} },
1422 sub { my($cdr, %opt) = @_; $opt{count} },
1426 sub { time2str('%d %b - %I:%M %p', shift->calldate_unix) },
1434 sub { time2str($date_format, shift->calldate_unix ) },
1435 # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
1438 sub { time2str('%r', shift->calldate_unix ) },
1439 # 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
1442 sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
1444 #REGIONNAME ("Destination")
1445 sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
1454 $export_formats{'source_default'} = [ $src_sub, @{ $export_formats{'default'} }, ];
1455 $export_formats{'accountcode_default'} =
1456 [ @{ $export_formats{'default'} }[0,1],
1458 @{ $export_formats{'default'} }[2..5],
1460 my @default = @{ $export_formats{'default'} };
1461 $export_formats{'description_default'} =
1462 [ $src_sub, @default[0..2],
1463 sub { my($cdr, %opt) = @_; $cdr->description },
1466 return %export_formats;
1469 =item downstream_csv OPTION => VALUE ...
1471 Returns a string of formatted call details for display on an invoice.
1477 charge - override the 'rated_price' field of the CDR
1479 seconds - override the 'billsec' field of the CDR
1481 count - number of usage events included in this record, for summary formats
1483 ratename - name of the rate table used to rate this call
1489 sub downstream_csv {
1490 my( $self, %opt ) = @_;
1492 my $format = $opt{'format'};
1493 my %formats = $self->export_formats;
1494 return "Unknown format $format" unless exists $formats{$format};
1496 #my $conf = new FS::Conf;
1497 #$opt{'money_char'} ||= $conf->config('money_char') || '$';
1498 $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
1500 my $csv = new Text::CSV_XS;
1504 ref($_) ? &{$_}($self, %opt) : $self->$_();
1506 @{ $formats{$format} };
1508 return @columns if defined $opt{'keeparray'};
1510 my $status = $csv->combine(@columns);
1511 die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
1522 my $ua = LWP::UserAgent->new(
1524 verify_hostname => 0,
1525 SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
1529 my $url = 'https://ws.freeside.biz/get_lrn';
1531 my %content = ( 'support-key' => $support_key,
1532 'tn' => $self->get($field),
1534 my $response = $ua->request( POST $url, \%content );
1536 die "LRN service error: ". $response->message. "\n"
1537 unless $response->is_success;
1540 my $data = eval { decode_json($response->content) };
1541 die "LRN service JSON error : $@\n" if $@;
1543 if ($data->{error}) {
1544 die "acctid ".$self->acctid." $field LRN lookup failed:\n$data->{error}";
1545 # for testing; later we should respect ignore_unrateable
1546 } elsif ($data->{lrn}) {
1548 $self->set($field.'_lrn', $data->{lrn});
1550 die "acctid ".$self->acctid." $field LRN lookup returned no number.\n";
1553 return $data; # in case it's interesting somehow
1558 =head1 CLASS METHODS
1562 =item invoice_formats
1564 Returns an ordered list of key value pairs containing invoice format names
1565 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
1569 # in the future, load this dynamically from detail_format classes
1571 sub invoice_formats {
1572 map { ($_ => $export_names{$_}->{'name'}) }
1573 grep { $export_names{$_}->{'invoice_header'} }
1574 sort keys %export_names;
1577 =item invoice_header FORMAT
1579 Returns a scalar containing the CSV column header for invoice format FORMAT.
1583 sub invoice_header {
1585 $export_names{$format}->{'invoice_header'};
1590 Clears cdr and any associated cdr_termination statuses - used for
1599 local $SIG{HUP} = 'IGNORE';
1600 local $SIG{INT} = 'IGNORE';
1601 local $SIG{QUIT} = 'IGNORE';
1602 local $SIG{TERM} = 'IGNORE';
1603 local $SIG{TSTP} = 'IGNORE';
1604 local $SIG{PIPE} = 'IGNORE';
1606 my $oldAutoCommit = $FS::UID::AutoCommit;
1607 local $FS::UID::AutoCommit = 0;
1610 if ( $cdr_prerate && $cdr_prerate_cdrtypenums{$self->cdrtypenum}
1611 && $self->rated_ratedetailnum #avoid putting old CDRs back in "rated"
1612 && $self->freesidestatus eq 'done'
1616 $self->freesidestatus('rated');
1618 $self->freesidestatus('');
1621 my $error = $self->replace;
1623 $dbh->rollback if $oldAutoCommit;
1627 foreach my $cdr_termination ( $self->cdr_termination ) {
1628 #$cdr_termination->status('');
1629 #$error = $cdr_termination->replace;
1630 $error = $cdr_termination->delete;
1632 $dbh->rollback if $oldAutoCommit;
1637 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1642 =item import_formats
1644 Returns an ordered list of key value pairs containing import format names
1645 as keys (for use with batch_import) and "pretty" format names as values.
1649 #false laziness w/part_pkg & part_export
1652 foreach my $INC ( @INC ) {
1653 warn "globbing $INC/FS/cdr/[a-z]*.pm\n" if $DEBUG;
1654 foreach my $file ( glob("$INC/FS/cdr/[a-z]*.pm") ) {
1655 warn "attempting to load CDR format info from $file\n" if $DEBUG;
1656 $file =~ /\/(\w+)\.pm$/ or do {
1657 warn "unrecognized file in $INC/FS/cdr/: $file\n";
1661 my $info = eval "use FS::cdr::$mod; ".
1662 "\\%FS::cdr::$mod\::info;";
1664 die "error using FS::cdr::$mod (skipping): $@\n" if $@;
1667 unless ( keys %$info ) {
1668 warn "no %info hash found in FS::cdr::$mod, skipping\n";
1671 warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
1672 if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1673 warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
1676 $cdr_info{$mod} = $info;
1680 tie my %import_formats, 'Tie::IxHash',
1681 map { $_ => $cdr_info{$_}->{'name'} }
1682 sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
1683 grep { exists($cdr_info{$_}->{'import_fields'}) }
1686 sub import_formats {
1690 sub _cdr_min_parser_maker {
1692 my @fields = ref($field) ? @$field : ($field);
1693 @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
1695 my( $cdr, $min ) = @_;
1696 my $sec = eval { _cdr_min_parse($min) };
1697 die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
1698 $cdr->$_($sec) foreach @fields;
1702 sub _cdr_min_parse {
1704 sprintf('%.0f', $min * 60 );
1707 sub _cdr_date_parser_maker {
1710 my @fields = ref($field) ? @$field : ($field);
1712 my( $cdr, $datestring ) = @_;
1713 my $unixdate = eval { _cdr_date_parse($datestring, %options) };
1714 die "error parsing date for @fields from $datestring: $@\n" if $@;
1715 $cdr->$_($unixdate) foreach @fields;
1719 sub _cdr_date_parse {
1723 return '' unless length($date); #that's okay, it becomes NULL
1724 return '' if $date eq 'NA'; #sansay
1726 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 ) {
1727 my $time = str2time($date);
1728 return $time if $time > 100000; #just in case
1731 my($year, $mon, $day, $hour, $min, $sec);
1733 #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
1734 #taqua #2007-10-31 08:57:24.113000000
1736 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|$)/ ) {
1737 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1738 } 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|$)/ ) {
1739 # 8/26/2010 12:20:01
1740 # optionally without seconds
1741 ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1742 $sec = 0 if !defined($sec);
1743 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\.\d+)$/ ) {
1744 # broadsoft: 20081223201938.314
1745 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1746 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\d+(\D|$)/ ) {
1747 # Taqua OM: 20050422203450943
1748 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1749 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) {
1750 # WIP: 20100329121420
1751 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1752 } elsif ( $date =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z$/) {
1753 # Telos 2014-10-10T05:30:33Z
1754 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1757 die "unparsable date: $date"; #maybe we shouldn't die...
1760 return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
1761 && $hour == 0 && $min == 0 && $sec == 0;
1763 if ($options{gmt}) {
1764 timegm($sec, $min, $hour, $day, $mon-1, $year);
1766 timelocal($sec, $min, $hour, $day, $mon-1, $year);
1770 =item batch_import HASHREF
1772 Imports CDR records. Available options are:
1784 Hash reference of preset fields, typically cdrbatch
1788 Set true to prevent throwing an error on empty imports
1794 my %import_options = (
1797 'batch_keycol' => 'cdrbatchnum',
1798 'batch_table' => 'cdr_batch',
1799 'batch_namecol' => 'cdrbatch',
1801 'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
1805 #drop the || 'csv' to allow auto xls for csv types?
1806 'format_types' => { map { $_ => lc($cdr_info{$_}->{'type'} || 'csv'); }
1810 'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
1814 'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
1818 'format_fixedlength_formats' =>
1819 { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
1823 'format_xml_formats' =>
1824 { map { $_ => $cdr_info{$_}->{'xml_format'}; }
1828 'format_asn_formats' =>
1829 { map { $_ => $cdr_info{$_}->{'asn_format'}; }
1833 'format_row_callbacks' =>
1834 { map { $_ => $cdr_info{$_}->{'row_callback'}; }
1838 'format_parser_opts' =>
1839 { map { $_ => $cdr_info{$_}->{'parser_opt'}; }
1844 sub _import_options {
1851 my $iopt = _import_options;
1852 $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
1854 if ( defined $opt->{'cdrtypenum'} ) {
1855 $opt->{'preinsert_callback'} = sub {
1856 my($record,$param) = (shift,shift);
1857 $record->cdrtypenum($opt->{'cdrtypenum'});
1862 FS::Record::batch_import( $opt );
1866 =item process_batch_import
1870 sub process_batch_import {
1873 my $opt = _import_options;
1874 # $opt->{'params'} = [ 'format', 'cdrbatch' ];
1876 FS::Record::process_batch_import( $job, $opt, @_ );
1879 # if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
1880 # @columns = map { s/^ +//; $_; } @columns;
1885 # Used by FS::Upgrade to migrate to a new database.
1887 use FS::upgrade_journal;
1889 my ($class, %opts) = @_;
1891 return if FS::upgrade_journal->is_done('cdr_cdrbatchnum');
1893 warn "$me upgrading $class\n" if $DEBUG;
1895 my $sth = dbh->prepare(
1896 'SELECT DISTINCT(cdrbatch) FROM cdr WHERE cdrbatch IS NOT NULL'
1897 ) or die dbh->errstr;
1899 $sth->execute or die $sth->errstr;
1901 my %cdrbatchnum = ();
1902 while (my $row = $sth->fetchrow_arrayref) {
1904 my $cdr_batch = qsearchs( 'cdr_batch', { 'cdrbatch' => $row->[0] } );
1905 unless ( $cdr_batch ) {
1906 $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] };
1907 my $error = $cdr_batch->insert;
1908 die $error if $error;
1911 $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum;
1914 $sth = dbh->prepare('UPDATE cdr SET cdrbatch = NULL, cdrbatchnum = ? WHERE cdrbatch IS NOT NULL AND cdrbatch = ?') or die dbh->errstr;
1916 foreach my $cdrbatch (keys %cdrbatchnum) {
1917 $sth->execute($cdrbatchnum{$cdrbatch}, $cdrbatch) or die $sth->errstr;
1920 FS::upgrade_journal->set_done('cdr_cdrbatchnum');
1924 =item ip_addr_sql FIELD RANGE
1926 Returns an SQL condition to search for CDRs with an IP address
1927 within RANGE. FIELD is either 'src_ip_addr' or 'dst_ip_addr'. RANGE
1928 should be in the form "a.b.c.d-e.f.g.h' (dotted quads), where any of
1929 the leftmost octets of the second address can be omitted if they're
1930 the same as the first address.
1936 my ($field, $range) = @_;
1937 $range =~ /^[\d\.-]+$/ or die "bad ip address range '$range'";
1938 my @r = split('-', $range);
1939 my @saddr = split('\.', $r[0] || '');
1940 my @eaddr = split('\.', $r[1] || '');
1941 unshift @eaddr, (undef) x (4 - scalar @eaddr);
1943 $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
1945 "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
1946 "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
1955 L<FS::Record>, schema.html from the base documentation.