4 use vars qw( @ISA @EXPORT_OK $DEBUG $me
5 $conf $cdr_prerate %cdr_prerate_cdrtypenums
9 use List::Util qw(first min);
14 use List::Util qw( first min );
16 use FS::UID qw( dbh );
18 use FS::Record qw( qsearch qsearchs );
23 use FS::cdr_termination;
30 use HTTP::Request::Common qw(POST);
32 use Cpanel::JSON::XS qw(decode_json);
34 @ISA = qw(FS::Record);
35 @EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker _cdr_date_parse );
40 #ask FS::UID to run this stuff for us later
41 FS::UID->install_callback( sub {
44 my @cdr_prerate_cdrtypenums;
45 $cdr_prerate = $conf->exists('cdr-prerate');
46 @cdr_prerate_cdrtypenums = $conf->config('cdr-prerate-cdrtypenums')
48 %cdr_prerate_cdrtypenums = map { $_=>1 } @cdr_prerate_cdrtypenums;
50 $support_key = $conf->config('support-key');
51 $use_lrn = $conf->exists('cdr-lrn_lookup');
57 FS::cdr - Object methods for cdr records
63 $record = new FS::cdr \%hash;
64 $record = new FS::cdr { 'column' => 'value' };
66 $error = $record->insert;
68 $error = $new_record->replace($old_record);
70 $error = $record->delete;
72 $error = $record->check;
76 An FS::cdr object represents an Call Data Record, typically from a telephony
77 system or provider of some sort. FS::cdr inherits from FS::Record. The
78 following fields are currently supported:
82 =item acctid - primary key
84 =item calldate - Call timestamp (SQL timestamp)
86 =item clid - Caller*ID with text
88 =item src - Caller*ID number / Source number
90 =item dst - Destination extension
92 =item dcontext - Destination context
94 =item channel - Channel used
96 =item dstchannel - Destination channel if appropriate
98 =item lastapp - Last application if appropriate
100 =item lastdata - Last application data
102 =item src_ip_addr - Source IP address (dotted quad, zero-filled)
104 =item dst_ip_addr - Destination IP address (same)
106 =item dst_term - Terminating destination number (if different from dst)
108 =item startdate - Start of call (UNIX-style integer timestamp)
110 =item answerdate - Answer time of call (UNIX-style integer timestamp)
112 =item enddate - End time of call (UNIX-style integer timestamp)
114 =item duration - Total time in system, in seconds
116 =item billsec - Total time call is up, in seconds
118 =item disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
120 =item amaflags - What flags to use: BILL, IGNORE etc, specified on a per channel basis like accountcode.
124 #ignore the "omit" and "documentation" AMAs??
125 #AMA = Automated Message Accounting.
126 #default: Sets the system default.
127 #omit: Do not record calls.
128 #billing: Mark the entry for billing
129 #documentation: Mark the entry for documentation.
131 =item accountcode - CDR account number to use: account
133 =item uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
135 =item userfield - CDR user-defined field
137 =item cdr_type - CDR type - see L<FS::cdr_type> (Usage = 1, S&E = 7, OC&C = 8)
139 =item charged_party - Service number to be billed
141 =item upstream_currency - Wholesale currency from upstream
143 =item upstream_price - Wholesale price from upstream
145 =item upstream_rateplanid - Upstream rate plan ID
147 =item rated_price - Rated (or re-rated) price
149 =item distance - km (need units field?)
151 =item islocal - Local - 1, Non Local = 0
153 =item calltypenum - Type of call - see L<FS::cdr_calltype>
155 =item description - Description (cdr_type 7&8 only) (used for cust_bill_pkg.itemdesc)
157 =item quantity - Number of items (cdr_type 7&8 only)
159 =item carrierid - Upstream Carrier ID (see L<FS::cdr_carrier>)
163 #Telstra =1, Optus = 2, RSL COM = 3
165 =item upstream_rateid - Upstream Rate ID
167 =item svcnum - Link to customer service (see L<FS::cust_svc>)
169 =item freesidestatus - NULL, processing-tiered, rated, done, skipped, no-charge, failed
171 =item freesiderewritestatus - NULL, done, skipped
175 =item detailnum - Link to invoice detail (L<FS::cust_bill_pkg_detail>)
185 Creates a new CDR. To add the CDR to the database, see L<"insert">.
187 Note that this stores the hash reference, not a distinct copy of the hash it
188 points to. You can ask the object for a copy with the I<hash> method.
192 # the new method can be inherited from FS::Record, if a table method is defined
199 #XXX fill in some (more) nice names
201 'calldate' => 'Call date',
202 'clid' => 'Caller ID',
204 'dst' => 'Destination',
205 'dcontext' => 'Dest. context',
206 'channel' => 'Channel',
207 'dstchannel' => 'Destination channel',
210 'src_ip_addr' => 'Source IP',
211 'dst_ip_addr' => 'Dest. IP',
212 'dst_term' => 'Termination dest.',
213 'startdate' => 'Start date',
214 'answerdate' => 'Answer date',
215 'enddate' => 'End date',
216 'duration' => 'Duration',
217 'billsec' => 'Billable seconds',
218 'disposition' => 'Disposition',
219 'amaflags' => 'AMA flags',
220 'accountcode' => 'Account code',
222 'userfield' => 'User field',
224 'charged_party' => 'Charged party',
225 #'upstream_currency' => '',
226 'upstream_price' => 'Upstream price',
227 #'upstream_rateplanid' => '',
228 #'ratedetailnum' => '',
229 'src_lrn' => 'Source LRN',
230 'dst_lrn' => 'Dest. LRN',
231 'rated_price' => 'Rated price',
232 'rated_cost' => 'Rated cost',
235 #'calltypenum' => '',
236 #'description' => '',
238 'carrierid' => 'Carrier ID',
239 #'upstream_rateid' => '',
240 'svcnum' => 'Freeside service',
241 'freesidestatus' => 'Freeside status',
242 'freesiderewritestatus' => 'Freeside rewrite status',
243 'cdrbatchnum' => 'Batch',
244 'detailnum' => 'Freeside invoice detail line',
253 Adds this record to the database. If there is an error, returns the error,
254 otherwise returns false.
258 # the insert method can be inherited from FS::Record
262 Delete this record from the database.
266 # the delete method can be inherited from FS::Record
268 =item replace OLD_RECORD
270 Replaces the OLD_RECORD with this one in the database. If there is an error,
271 returns the error, otherwise returns false.
275 # the replace method can be inherited from FS::Record
279 Checks all fields to make sure this is a valid CDR. If there is
280 an error, returns the error, otherwise returns false. Called by the insert
283 Note: Unlike most types of records, we don't want to "reject" a CDR and we want
284 to process them as quickly as possible, so we allow the database to check most
292 # we don't want to "reject" a CDR like other sorts of input...
294 # $self->ut_numbern('acctid')
295 ## || $self->ut_('calldate')
296 # || $self->ut_text('clid')
297 # || $self->ut_text('src')
298 # || $self->ut_text('dst')
299 # || $self->ut_text('dcontext')
300 # || $self->ut_text('channel')
301 # || $self->ut_text('dstchannel')
302 # || $self->ut_text('lastapp')
303 # || $self->ut_text('lastdata')
304 # || $self->ut_numbern('startdate')
305 # || $self->ut_numbern('answerdate')
306 # || $self->ut_numbern('enddate')
307 # || $self->ut_number('duration')
308 # || $self->ut_number('billsec')
309 # || $self->ut_text('disposition')
310 # || $self->ut_number('amaflags')
311 # || $self->ut_text('accountcode')
312 # || $self->ut_text('uniqueid')
313 # || $self->ut_text('userfield')
314 # || $self->ut_numbern('cdrtypenum')
315 # || $self->ut_textn('charged_party')
316 ## || $self->ut_n('upstream_currency')
317 ## || $self->ut_n('upstream_price')
318 # || $self->ut_numbern('upstream_rateplanid')
319 ## || $self->ut_n('distance')
320 # || $self->ut_numbern('islocal')
321 # || $self->ut_numbern('calltypenum')
322 # || $self->ut_textn('description')
323 # || $self->ut_numbern('quantity')
324 # || $self->ut_numbern('carrierid')
325 # || $self->ut_numbern('upstream_rateid')
326 # || $self->ut_numbern('svcnum')
327 # || $self->ut_textn('freesidestatus')
328 # || $self->ut_textn('freesiderewritestatus')
330 # return $error if $error;
332 for my $f ( grep { $self->$_ =~ /\D/ } qw(startdate answerdate enddate)){
333 $self->$f( str2time($self->$f) );
336 $self->calldate( $self->startdate_sql )
337 if !$self->calldate && $self->startdate;
339 #was just for $format eq 'taqua' but can't see the harm... add something to
340 #disable if it becomes a problem
341 if ( $self->duration eq '' && $self->enddate && $self->startdate ) {
342 $self->duration( $self->enddate - $self->startdate );
344 if ( $self->billsec eq '' && $self->enddate && $self->answerdate ) {
345 $self->billsec( $self->enddate - $self->answerdate );
348 if ( ! $self->enddate && $self->startdate && $self->duration ) {
349 $self->enddate( $self->startdate + $self->duration );
352 $self->set_charged_party;
354 #check the foreign keys even?
355 #do we want to outright *reject* the CDR?
356 my $error = $self->ut_numbern('acctid');
357 return $error if $error;
359 if ( $self->freesidestatus ne 'done' ) {
360 $self->set('detailnum', ''); # can't have this on an unbilled call
363 #add a config option to turn these back on if someone needs 'em
365 # #Usage = 1, S&E = 7, OC&C = 8
366 # || $self->ut_foreign_keyn('cdrtypenum', 'cdr_type', 'cdrtypenum' )
368 # #the big list in appendix 2
369 # || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
371 # # Telstra =1, Optus = 2, RSL COM = 3
372 # || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
377 =item is_tollfree [ COLUMN ]
379 Returns true when the cdr represents a toll free number and false otherwise.
381 By default, inspects the dst field, but an optional column name can be passed
382 to inspect other field.
388 my $field = scalar(@_) ? shift : 'dst';
389 my $country = $conf->config('tollfree-country') || '';
390 if ( $country eq 'AU' ) {
391 ( $self->$field() =~ /^(\+?61)?(1800|1300)/ ) ? 1 : 0;
392 } elsif ( $country eq 'NZ' ) {
393 ( $self->$field() =~ /^(\+?64)?(800|508)/ ) ? 1 : 0;
394 } else { #NANPA (US/Canaada)
395 ( $self->$field() =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0;
399 =item set_charged_party
401 If the charged_party field is already set, does nothing. Otherwise:
403 If the cdr-charged_party-accountcode config option is enabled, sets the
404 charged_party to the accountcode.
406 Otherwise sets the charged_party normally: to the src field in most cases,
407 or to the dst field if it is a toll free number.
411 sub set_charged_party {
414 my $conf = new FS::Conf;
416 unless ( $self->charged_party ) {
418 if ( $conf->exists('cdr-charged_party-accountcode') && $self->accountcode ){
420 my $charged_party = $self->accountcode;
421 $charged_party =~ s/^0+//
422 if $conf->exists('cdr-charged_party-accountcode-trim_leading_0s');
423 $self->charged_party( $charged_party );
425 } elsif ( $conf->exists('cdr-charged_party-field') ) {
427 my $field = $conf->config('cdr-charged_party-field');
428 $self->charged_party( $self->$field() );
432 if ( $self->is_tollfree ) {
433 $self->charged_party($self->dst);
435 $self->charged_party($self->src);
442 # my $prefix = $conf->config('cdr-charged_party-truncate_prefix');
443 # my $prefix_len = length($prefix);
444 # my $trunc_len = $conf->config('cdr-charged_party-truncate_length');
446 # $self->charged_party( substr($self->charged_party, 0, $trunc_len) )
447 # if $prefix_len && $trunc_len
448 # && substr($self->charged_party, 0, $prefix_len) eq $prefix;
452 =item set_status STATUS
454 Sets the status to the provided string. If there is an error, returns the
455 error, otherwise returns false.
457 If status is being changed from 'rated' to some other status, also removes
458 any usage allocations to this CDR.
463 my($self, $status) = @_;
464 my $old_status = $self->freesidestatus;
465 $self->freesidestatus($status);
466 my $error = $self->replace;
467 if ( $old_status eq 'rated' and $status ne 'done' ) {
468 # deallocate any usage
469 foreach (qsearch('cdr_cust_pkg_usage', {acctid => $self->acctid})) {
470 my $cust_pkg_usage = $_->cust_pkg_usage;
471 $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $_->minutes);
472 $error ||= $cust_pkg_usage->replace || $_->delete;
478 =item set_status_and_rated_price STATUS RATED_PRICE [ SVCNUM [ OPTION => VALUE ... ] ]
480 Sets the status and rated price.
482 Available options are: inbound, rated_pretty_dst, rated_regionname,
483 rated_seconds, rated_minutes, rated_granularity, rated_ratedetailnum,
484 rated_classnum, rated_ratename. If rated_ratedetailnum is provided,
485 will also set a recalculated L</rate_cost> in the rated_cost field
486 after the other fields are set (does not work with inbound.)
488 If there is an error, returns the error, otherwise returns false.
492 sub set_status_and_rated_price {
493 my($self, $status, $rated_price, $svcnum, %opt) = @_;
495 if ($opt{'inbound'}) {
497 my $term = $self->cdr_termination( 1 ); #1: inbound
500 warn "replacing existing cdr status (".$self->acctid.")\n" if $term;
501 $error = $term->delete;
502 return $error if $error;
504 $term = FS::cdr_termination->new({
505 acctid => $self->acctid,
507 rated_price => $rated_price,
510 foreach (qw(rated_seconds rated_minutes rated_granularity)) {
511 $term->set($_, $opt{$_}) if exists($opt{$_});
513 $term->svcnum($svcnum) if $svcnum;
514 return $term->insert;
518 $self->freesidestatus($status);
519 $self->rated_price($rated_price);
521 foreach grep exists($opt{$_}), map "rated_$_",
522 qw( pretty_dst regionname seconds minutes granularity
523 ratedetailnum classnum ratename );
524 $self->svcnum($svcnum) if $svcnum;
525 $self->rated_cost($self->rate_cost) if $opt{'rated_ratedetailnum'};
527 return $self->replace();
532 =item parse_number [ OPTION => VALUE ... ]
534 Returns two scalars, the countrycode and the rest of the number.
536 Options are passed as name-value pairs. Currently available options are:
542 The column containing the number to be parsed. Defaults to dst.
544 =item international_prefix
546 The digits for international dialing. Defaults to '011' The value '+' is
549 =item domestic_prefix
551 The digits for domestic long distance dialing. Defaults to '1'
558 my ($self, %options) = @_;
560 my $field = $options{column} || 'dst';
561 my $intl = $options{international_prefix} || '011';
562 # Still, don't break anyone's CDR rating if they have an empty string in
563 # there. Require an explicit statement that there's no prefix.
564 $intl = '' if lc($intl) eq 'none';
565 my $countrycode = '';
566 my $number = $self->$field();
568 my $to_or_from = 'concerning';
569 $to_or_from = 'from' if $field eq 'src';
570 $to_or_from = 'to' if $field eq 'dst';
571 warn "parsing call $to_or_from $number\n" if $DEBUG;
573 #remove non-phone# stuff and whitespace
576 # $dest =~ s/^(\w+):// and $proto = $1; #sip:
578 # $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
580 if ( $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
581 || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
585 my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 );
586 #first look for 1 digit country code
587 if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) {
589 $number = $u1.$u2.$rest;
590 } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
593 } else { #3 digit country code
594 $countrycode = $three;
599 my $domestic_prefix =
600 exists($options{domestic_prefix}) ? $options{domestic_prefix} : '';
601 $countrycode = length($domestic_prefix) ? $domestic_prefix : '1';
602 $number =~ s/^$countrycode//;# if length($number) > 10;
605 return($countrycode, $number);
609 =item rate [ OPTION => VALUE ... ]
611 Rates this CDR according and sets the status to 'rated'.
613 Available options are: part_pkg, svcnum, plan_included_min,
614 detail_included_min_hashref.
616 part_pkg is required.
618 If svcnum is specified, will also associate this CDR with the specified svcnum.
620 plan_included_min should be set to a scalar reference of the number of
621 included minutes and will be decremented by the rated minutes of this
624 detail_included_min_hashref should be set to an empty hashref at the
625 start of a month's rating and then preserved across CDRs.
630 my( $self, %opt ) = @_;
631 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
634 warn "rating CDR $self\n".
635 join('', map { " $_ => ". $self->{$_}. "\n" } keys %$self );
638 my $rating_method = $part_pkg->option_cacheable('rating_method') || 'prefix';
639 my $method = "rate_$rating_method";
640 $self->$method(%opt);
644 our %interval_cache = (); # for timed rates
647 my( $self, %opt ) = @_;
648 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
649 my $cust_pkg = $opt{'cust_pkg'};
652 # this will result in those CDRs being marked as done... is that
655 if ( $part_pkg->option_cacheable('411_rewrite') ) {
656 my $dirass = $part_pkg->option_cacheable('411_rewrite');
658 @dirass = split(',', $dirass);
661 if ( length($self->dst) && grep { $self->dst eq $_ } @dirass ) {
666 my $reason = $part_pkg->check_chargable( $self,
667 'da_rewrote' => $da_rewrote,
670 warn "not charging for CDR ($reason)\n" if $DEBUG;
671 return $self->set_status_and_rated_price( 'skipped',
677 if ( $part_pkg->option_cacheable('skip_same_customer')
678 and ! $self->is_tollfree ) {
679 my ($dst_countrycode, $dst_number) = $self->parse_number(
681 international_prefix => $part_pkg->option_cacheable('international_prefix'),
682 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
684 my $dst_same_cust = FS::Record->scalar_sql(
685 'SELECT COUNT(svc_phone.svcnum) AS count '.
687 'JOIN cust_svc USING (pkgnum) ' .
688 'JOIN svc_phone USING (svcnum) ' .
689 'WHERE svc_phone.countrycode = ' . dbh->quote($dst_countrycode) .
690 ' AND svc_phone.phonenum = ' . dbh->quote($dst_number) .
691 ' AND cust_pkg.custnum = ' . $cust_pkg->custnum,
693 if ( $dst_same_cust > 0 ) {
694 warn "not charging for CDR (same source and destination customer)\n" if $DEBUG;
695 return $self->set_status_and_rated_price( 'skipped',
703 # look up rate details based on called station id
704 # (or calling station id for toll free calls)
707 my $eff_ratenum = $self->is_tollfree('accountcode')
708 ? $part_pkg->option_cacheable('accountcode_tollfree_ratenum')
711 my( $to_or_from, $column );
714 && ! $part_pkg->option_cacheable('disable_tollfree')
717 && $part_pkg->option_cacheable('accountcode_tollfree_field') eq 'src'
721 $to_or_from = 'from';
723 } else { #regular call
728 #determine the country code
729 my ($countrycode, $number) = $self->parse_number(
731 international_prefix => $part_pkg->option_cacheable('international_prefix'),
732 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
736 my $intrastate_ratenum = $part_pkg->option_cacheable('intrastate_ratenum');
738 if ( $use_lrn and $countrycode eq '1' ) {
740 # then ask about the number
741 foreach my $field ('src', 'dst') {
743 $self->get_lrn($field);
744 if ( $field eq $column ) {
745 # then we are rating on this number
746 $number = $self->get($field.'_lrn');
748 # is this ever meaningful? can the LRN be outside NANP space?
755 warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG;
756 my $pretty_dst = "+$countrycode $number";
757 #asterisks here causes inserting the detail to barf, so:
758 $pretty_dst =~ s/\*//g;
760 # should check $countrycode eq '1' here?
761 if ( $intrastate_ratenum && !$self->is_tollfree ) {
762 $ratename = 'Interstate'; #until proven otherwise
763 # this is relatively easy only because:
764 # -assume all numbers are valid NANP numbers NOT in a fully-qualified format
765 # -disregard toll-free
766 # -disregard private or unknown numbers
767 # -there is exactly one record in rate_prefix for a given NPANXX
768 # -default to interstate if we can't find one or both of the prefixes
769 my $dst_col = $use_lrn ? 'dst_lrn' : 'dst';
770 my $src_col = $use_lrn ? 'src_lrn' : 'src';
771 my (undef, $dstprefix) = $self->parse_number(
773 international_prefix => $part_pkg->option_cacheable('international_prefix'),
774 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
776 $dstprefix =~ /^(\d{6})/;
777 $dstprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
780 my (undef, $srcprefix) = $self->parse_number(
782 international_prefix => $part_pkg->option_cacheable('international_prefix'),
783 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
785 $srcprefix =~ /^(\d{6})/;
786 $srcprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
789 if ($srcprefix && $dstprefix
790 && $srcprefix->state && $dstprefix->state
791 && $srcprefix->state eq $dstprefix->state) {
792 $eff_ratenum = $intrastate_ratenum;
793 $ratename = 'Intrastate'; # XXX possibly just use the ratename?
797 $eff_ratenum ||= $part_pkg->option_cacheable('ratenum');
798 my $rate = qsearchs('rate', { 'ratenum' => $eff_ratenum })
799 or die "ratenum $eff_ratenum not found!";
801 my @ltime = localtime($self->startdate);
802 my $weektime = $ltime[0] +
803 $ltime[1]*60 + #minutes
804 $ltime[2]*3600 + #hours
805 $ltime[6]*86400; #days since sunday
806 # if there's no timed rate_detail for this time/region combination,
807 # dest_detail returns the default. There may still be a timed rate
808 # that applies after the starttime of the call, so be careful...
809 my $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
810 'phonenum' => $number,
811 'weektime' => $weektime,
812 'cdrtypenum' => $self->cdrtypenum,
815 unless ( $rate_detail ) {
817 if ( $part_pkg->option_cacheable('ignore_unrateable') ) {
819 if ( $part_pkg->option_cacheable('ignore_unrateable') == 2 ) {
820 # mark the CDR as unrateable
821 return $self->set_status_and_rated_price(
826 } elsif ( $part_pkg->option_cacheable('ignore_unrateable') == 1 ) {
828 warn "no rate_detail found for CDR.acctid: ". $self->acctid.
833 die "unknown ignore_unrateable, pkgpart ". $part_pkg->pkgpart;
838 die "FATAL: no rate_detail found in ".
839 $rate->ratenum. ":". $rate->ratename. " rate plan ".
840 "for +$countrycode $number (CDR acctid ". $self->acctid. "); ".
841 "add a rate or set ignore_unrateable flag on the package def\n";
846 my $regionnum = $rate_detail->dest_regionnum;
847 my $rate_region = $rate_detail->dest_region;
848 warn " found rate for regionnum $regionnum ".
849 "and rate detail $rate_detail\n"
852 if ( !exists($interval_cache{$regionnum}) ) {
854 sort { $a->stime <=> $b->stime }
855 map { $_->rate_time->intervals }
856 qsearch({ 'table' => 'rate_detail',
857 'hashref' => { 'ratenum' => $rate->ratenum },
858 'extra_sql' => 'AND ratetimenum IS NOT NULL',
861 $interval_cache{$regionnum} = \@intervals;
862 warn " cached ".scalar(@intervals)." interval(s)\n"
867 # find the price and add detail to the invoice
870 # About this section:
871 # We don't round _anything_ (except granularizing)
872 # until the final $charge = sprintf("%.2f"...).
874 my $rated_seconds = $part_pkg->option_cacheable('use_duration')
877 my $seconds_left = $rated_seconds;
879 #no, do this later so it respects (group) included minutes
880 # # charge for the first (conn_sec) seconds
881 # my $seconds = min($seconds_left, $rate_detail->conn_sec);
882 # $seconds_left -= $seconds;
883 # $weektime += $seconds;
884 # my $charge = $rate_detail->conn_charge;
887 my $connection_charged = 0;
889 # before doing anything else, if there's an upstream multiplier and
890 # an upstream price, add that to the charge. (usually the rate detail
891 # will then have a minute charge of zero, but not necessarily.)
892 $charge += ($self->upstream_price || 0) * $rate_detail->upstream_mult_charge;
895 while($seconds_left) {
896 my $ratetimenum = $rate_detail->ratetimenum; # may be empty
898 # find the end of the current rate interval
899 if(@{ $interval_cache{$regionnum} } == 0) {
900 # There are no timed rates in this group, so just stay
901 # in the default rate_detail for the entire duration.
902 # Set an "end" of 1 past the end of the current call.
903 $etime = $weektime + $seconds_left + 1;
905 elsif($ratetimenum) {
906 # This is a timed rate, so go to the etime of this interval.
907 # If it's followed by another timed rate, the stime of that
908 # interval should match the etime of this one.
909 my $interval = $rate_detail->rate_time->contains($weektime);
910 $etime = $interval->etime;
913 # This is a default rate, so use the stime of the next
914 # interval in the sequence.
915 my $next_int = first { $_->stime > $weektime }
916 @{ $interval_cache{$regionnum} };
918 $etime = $next_int->stime;
921 # weektime is near the end of the week, so decrement
922 # it by a full week and use the stime of the first
924 $weektime -= (3600*24*7);
925 $etime = $interval_cache{$regionnum}->[0]->stime;
929 my $charge_sec = min($seconds_left, $etime - $weektime);
931 $seconds_left -= $charge_sec;
933 my $granularity = $rate_detail->sec_granularity;
936 if ( $granularity ) { # charge per minute
937 # Round up to the nearest $granularity
938 if ( $charge_sec and $charge_sec % $granularity ) {
939 $charge_sec += $granularity - ($charge_sec % $granularity);
941 $minutes = $charge_sec / 60; #don't round this
948 #$seconds += $charge_sec;
950 if ( $rate_detail->min_included ) {
951 # the old, kind of deprecated way to do this:
953 # The rate detail itself has included minutes. We MUST have a place
955 my $included_min = $opt{'detail_included_min_hashref'}
956 or return "unable to rate CDR: rate detail has included minutes, but ".
957 "no detail_included_min_hashref provided.\n";
959 # by default, set the included minutes for this region/time to
960 # what's in the rate_detail
961 if (!exists( $included_min->{$regionnum}{$ratetimenum} )) {
962 $included_min->{$regionnum}{$ratetimenum} =
963 ($rate_detail->min_included * $cust_pkg->quantity || 1);
966 if ( $included_min->{$regionnum}{$ratetimenum} >= $minutes ) {
968 $included_min->{$regionnum}{$ratetimenum} -= $minutes;
970 $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60);
971 $included_min->{$regionnum}{$ratetimenum} = 0;
973 } elsif ( $opt{plan_included_min} && ${ $opt{plan_included_min} } > 0 ) {
974 # The package definition has included minutes, but only for in-group
975 # rate details. Decrement them if this is an in-group call.
976 if ( $rate_detail->region_group ) {
977 if ( ${ $opt{'plan_included_min'} } >= $minutes ) {
979 ${ $opt{'plan_included_min'} } -= $minutes;
981 $charge_sec -= (${ $opt{'plan_included_min'} } * 60);
982 ${ $opt{'plan_included_min'} } = 0;
987 my $applied_min = $cust_pkg->apply_usage(
989 'rate_detail' => $rate_detail,
990 'minutes' => $minutes
992 # for now, usage pools deal only in whole minutes
993 $charge_sec -= $applied_min * 60;
996 if ( $charge_sec > 0 ) {
998 #NOW do connection charges here... right?
999 #my $conn_seconds = min($seconds_left, $rate_detail->conn_sec);
1000 my $conn_seconds = 0;
1001 unless ( $connection_charged++ ) { #only one connection charge
1002 $conn_seconds = min($charge_sec, $rate_detail->conn_sec);
1003 $seconds_left -= $conn_seconds;
1004 $weektime += $conn_seconds;
1005 $charge += $rate_detail->conn_charge;
1008 #should preserve (display?) this
1009 if ( $granularity == 0 ) { # per call rate
1010 $charge += $rate_detail->min_charge;
1012 my $charge_min = ( $charge_sec - $conn_seconds ) / 60;
1013 $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
1018 # choose next rate_detail
1019 $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
1020 'phonenum' => $number,
1021 'weektime' => $etime,
1022 'cdrtypenum' => $self->cdrtypenum })
1024 # we have now moved forward to $etime
1027 } #while $seconds_left
1029 # this is why we need regionnum/rate_region....
1030 warn " (rate region $rate_region)\n" if $DEBUG;
1033 my $rounding = $part_pkg->option_cacheable('rounding') || 2;
1034 my $sprintformat = '%.'. $rounding. 'f';
1035 my $roundup = 10**(-3-$rounding);
1036 my $price = sprintf($sprintformat, $charge + $roundup);
1038 $self->set_status_and_rated_price(
1042 'rated_pretty_dst' => $pretty_dst,
1043 'rated_regionname' => ($rate_region ? $rate_region->regionname : ''),
1044 'rated_seconds' => $rated_seconds, #$seconds,
1045 'rated_granularity' => $rate_detail->sec_granularity, #$granularity
1046 'rated_ratedetailnum' => $rate_detail->ratedetailnum,
1047 'rated_classnum' => $rate_detail->classnum, #rated_ratedetailnum?
1048 'rated_ratename' => $ratename, #not rate_detail - Intrastate/Interstate
1053 sub rate_upstream_simple {
1054 my( $self, %opt ) = @_;
1056 $self->set_status_and_rated_price(
1058 sprintf('%.3f', $self->upstream_price),
1060 'rated_classnum' => $self->calltypenum,
1061 'rated_seconds' => $self->billsec,
1062 # others? upstream_*_regionname => rated_regionname is possible
1066 sub rate_single_price {
1067 my( $self, %opt ) = @_;
1068 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
1070 # a little false laziness w/abov
1071 # $rate_detail = new FS::rate_detail({sec_granularity => ... }) ?
1073 my $granularity = length($part_pkg->option_cacheable('sec_granularity'))
1074 ? $part_pkg->option_cacheable('sec_granularity')
1077 my $seconds = $part_pkg->option_cacheable('use_duration')
1081 $seconds += $granularity - ( $seconds % $granularity )
1082 if $seconds # don't granular-ize 0 billsec calls (bills them)
1083 && $granularity # 0 is per call
1084 && $seconds % $granularity;
1085 my $minutes = $granularity ? ($seconds / 60) : 1;
1087 my $charge_min = $minutes;
1089 ${$opt{plan_included_min}} -= $minutes;
1090 if ( ${$opt{plan_included_min}} > 0 ) {
1093 $charge_min = 0 - ${$opt{plan_included_min}};
1094 ${$opt{plan_included_min}} = 0;
1098 sprintf('%.4f', ( $part_pkg->option_cacheable('min_charge') * $charge_min )
1099 + 0.0000000001 ); #so 1.00005 rounds to 1.0001
1101 $self->set_status_and_rated_price(
1105 'rated_granularity' => $granularity,
1106 'rated_seconds' => $seconds,
1113 Rates an already-rated CDR according to the cost fields from the rate plan.
1122 return 0 unless $self->rated_ratedetailnum;
1125 qsearchs('rate_detail', { 'ratedetailnum' => $self->rated_ratedetailnum } );
1128 $charge += ($self->upstream_price || 0) * ($rate_detail->upstream_mult_cost);
1130 if ( $self->rated_granularity == 0 ) {
1131 $charge += $rate_detail->min_cost;
1133 my $minutes = $self->rated_seconds / 60;
1134 $charge += $rate_detail->conn_cost + $minutes * $rate_detail->min_cost;
1137 sprintf('%.2f', $charge + .00001 );
1141 =item cdr_termination [ TERMPART ]
1145 sub cdr_termination {
1148 if ( scalar(@_) && $_[0] ) {
1149 my $termpart = shift;
1151 qsearchs('cdr_termination', { acctid => $self->acctid,
1152 termpart => $termpart,
1158 qsearch('cdr_termination', { acctid => $self->acctid, } );
1166 Parses the calldate in SQL string format and returns a UNIX timestamp.
1171 str2time(shift->calldate);
1176 Parses the startdate in UNIX timestamp format and returns a string in SQL
1182 my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
1185 "$year-$mon-$mday $hour:$min:$sec";
1190 Returns the FS::cdr_carrier object associated with this CDR, or false if no
1191 carrierid is defined.
1195 my %carrier_cache = ();
1199 return '' unless $self->carrierid;
1200 $carrier_cache{$self->carrierid} ||=
1201 qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
1206 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
1207 no FS::cdr_carrier object is assocated with this CDR.
1213 my $cdr_carrier = $self->cdr_carrier;
1214 $cdr_carrier ? $cdr_carrier->carriername : '';
1219 Returns the FS::cdr_calltype object associated with this CDR, or false if no
1220 calltypenum is defined.
1224 my %calltype_cache = ();
1228 return '' unless $self->calltypenum;
1229 $calltype_cache{$self->calltypenum} ||=
1230 qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
1235 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
1236 no FS::cdr_calltype object is assocated with this CDR.
1242 my $cdr_calltype = $self->cdr_calltype;
1243 $cdr_calltype ? $cdr_calltype->calltypename : '';
1246 =item downstream_csv [ OPTION => VALUE, ... ]
1250 # in the future, load this dynamically from detail_format classes
1252 my %export_names = (
1255 'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
1258 'name' => 'Simple with source',
1259 'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
1260 #"Date,Time,Name,Called From,Destination,Duration,Price",
1262 'accountcode_simple' => {
1263 'name' => 'Simple with accountcode',
1264 'invoice_header' => "Date,Time,Called From,Account,Duration,Price",
1268 'invoice_header' => "Date/Time,Called Number,Min/Sec,Price",
1270 'basic_upstream_dst_regionname' => {
1271 'name' => 'Basic with upstream destination name',
1272 'invoice_header' => "Date/Time,Called Number,Destination,Min/Sec,Price",
1275 'name' => 'Default',
1276 'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
1278 'source_default' => {
1279 'name' => 'Default with source',
1280 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1282 'accountcode_default' => {
1283 'name' => 'Default plus accountcode',
1284 'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
1286 'description_default' => {
1287 'name' => 'Default with description field as destination',
1288 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1291 'name' => 'Summary, one line per service',
1292 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1295 'name' => 'Number of calls, one line per service',
1296 'invoice_header' => 'Caller,Rate,Messages,Price',
1299 'name' => 'Summary, one line per service',
1300 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1302 'sum_duration_prefix' => {
1303 'name' => 'Summary, one line per destination prefix',
1304 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1306 'sum_count_class' => {
1307 'name' => 'Summary, one line per usage class',
1308 'invoice_header' => 'Caller,Class,Calls,Price',
1310 'sum_duration_accountcode' => {
1311 'name' => 'Summary, one line per accountcode',
1312 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1316 my %export_formats = ();
1317 sub export_formats {
1320 return %export_formats if keys %export_formats;
1322 my $conf = new FS::Conf;
1323 my $date_format = $conf->config('date_format') || '%m/%d/%Y';
1325 # call duration in the largest units that accurately reflect the granularity
1326 my $duration_sub = sub {
1327 my($cdr, %opt) = @_;
1328 my $sec = $opt{seconds} || $cdr->billsec;
1329 if ( defined $opt{granularity} &&
1330 $opt{granularity} == 0 ) { #per call
1333 elsif ( defined $opt{granularity} && $opt{granularity} == 60 ) {#full minutes
1334 my $min = int($sec/60);
1338 else { #anything else
1339 return sprintf("%dm %ds", $sec/60, $sec%60);
1343 my $price_sub = sub {
1344 my ($cdr, %opt) = @_;
1346 if ( defined($opt{charge}) ) {
1347 $price = $opt{charge};
1349 elsif ( $opt{inbound} ) {
1350 my $term = $cdr->cdr_termination(1); # 1 = inbound
1351 $price = $term->rated_price if defined $term;
1354 $price = $cdr->rated_price;
1356 length($price) ? ($opt{money_char} . $price) : '';
1359 my $src_sub = sub { $_[0]->clid || $_[0]->src };
1363 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1364 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1366 'dst', #NUMBER_DIALED
1367 $duration_sub, #DURATION
1368 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1372 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1373 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1375 $src_sub, #called from
1376 'dst', #NUMBER_DIALED
1377 $duration_sub, #DURATION
1378 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1381 'accountcode_simple' => [
1382 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1383 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1384 $src_sub, #called from
1385 'accountcode', #NUMBER_DIALED
1386 $duration_sub, #DURATION
1390 # for summary formats, the CDR is a fictitious object containing the
1391 # total billsec and the phone number of the service
1393 sub { my($cdr, %opt) = @_; $opt{ratename} },
1394 sub { my($cdr, %opt) = @_; $opt{count} },
1395 sub { my($cdr, %opt) = @_; int($opt{seconds}/60).'m' },
1400 sub { my($cdr, %opt) = @_; $opt{ratename} },
1401 sub { my($cdr, %opt) = @_; $opt{count} },
1405 sub { time2str('%d %b - %I:%M %p', shift->calldate_unix) },
1413 sub { time2str($date_format, shift->calldate_unix ) },
1414 # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
1417 sub { time2str('%r', shift->calldate_unix ) },
1418 # 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
1421 sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
1423 #REGIONNAME ("Destination")
1424 sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
1433 $export_formats{'source_default'} = [ $src_sub, @{ $export_formats{'default'} }, ];
1434 $export_formats{'accountcode_default'} =
1435 [ @{ $export_formats{'default'} }[0,1],
1437 @{ $export_formats{'default'} }[2..5],
1439 my @default = @{ $export_formats{'default'} };
1440 $export_formats{'description_default'} =
1441 [ $src_sub, @default[0..2],
1442 sub { my($cdr, %opt) = @_; $cdr->description },
1445 return %export_formats;
1448 =item downstream_csv OPTION => VALUE ...
1450 Returns a string of formatted call details for display on an invoice.
1456 charge - override the 'rated_price' field of the CDR
1458 seconds - override the 'billsec' field of the CDR
1460 count - number of usage events included in this record, for summary formats
1462 ratename - name of the rate table used to rate this call
1468 sub downstream_csv {
1469 my( $self, %opt ) = @_;
1471 my $format = $opt{'format'};
1472 my %formats = $self->export_formats;
1473 return "Unknown format $format" unless exists $formats{$format};
1475 #my $conf = new FS::Conf;
1476 #$opt{'money_char'} ||= $conf->config('money_char') || '$';
1477 $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
1479 my $csv = new Text::CSV_XS;
1483 ref($_) ? &{$_}($self, %opt) : $self->$_();
1485 @{ $formats{$format} };
1487 return @columns if defined $opt{'keeparray'};
1489 my $status = $csv->combine(@columns);
1490 die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
1501 my $ua = LWP::UserAgent->new(
1503 verify_hostname => 0,
1504 SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
1508 my $url = 'https://ws.freeside.biz/get_lrn';
1510 my %content = ( 'support-key' => $support_key,
1511 'tn' => $self->get($field),
1513 my $response = $ua->request( POST $url, \%content );
1515 die "LRN service error: ". $response->message. "\n"
1516 unless $response->is_success;
1519 my $data = eval { decode_json($response->content) };
1520 die "LRN service JSON error : $@\n" if $@;
1522 if ($data->{error}) {
1523 die "acctid ".$self->acctid." $field LRN lookup failed:\n$data->{error}";
1524 # for testing; later we should respect ignore_unrateable
1525 } elsif ($data->{lrn}) {
1527 $self->set($field.'_lrn', $data->{lrn});
1529 die "acctid ".$self->acctid." $field LRN lookup returned no number.\n";
1532 return $data; # in case it's interesting somehow
1537 =head1 CLASS METHODS
1541 =item invoice_formats
1543 Returns an ordered list of key value pairs containing invoice format names
1544 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
1548 # in the future, load this dynamically from detail_format classes
1550 sub invoice_formats {
1551 map { ($_ => $export_names{$_}->{'name'}) }
1552 grep { $export_names{$_}->{'invoice_header'} }
1553 sort keys %export_names;
1556 =item invoice_header FORMAT
1558 Returns a scalar containing the CSV column header for invoice format FORMAT.
1562 sub invoice_header {
1564 $export_names{$format}->{'invoice_header'};
1569 Clears cdr and any associated cdr_termination statuses - used for
1578 local $SIG{HUP} = 'IGNORE';
1579 local $SIG{INT} = 'IGNORE';
1580 local $SIG{QUIT} = 'IGNORE';
1581 local $SIG{TERM} = 'IGNORE';
1582 local $SIG{TSTP} = 'IGNORE';
1583 local $SIG{PIPE} = 'IGNORE';
1585 my $oldAutoCommit = $FS::UID::AutoCommit;
1586 local $FS::UID::AutoCommit = 0;
1589 if ( $cdr_prerate && $cdr_prerate_cdrtypenums{$self->cdrtypenum}
1590 && $self->rated_ratedetailnum #avoid putting old CDRs back in "rated"
1591 && $self->freesidestatus eq 'done'
1595 $self->freesidestatus('rated');
1597 $self->freesidestatus('');
1600 my $error = $self->replace;
1602 $dbh->rollback if $oldAutoCommit;
1606 foreach my $cdr_termination ( $self->cdr_termination ) {
1607 #$cdr_termination->status('');
1608 #$error = $cdr_termination->replace;
1609 $error = $cdr_termination->delete;
1611 $dbh->rollback if $oldAutoCommit;
1616 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1621 =item import_formats
1623 Returns an ordered list of key value pairs containing import format names
1624 as keys (for use with batch_import) and "pretty" format names as values.
1628 #false laziness w/part_pkg & part_export
1631 foreach my $INC ( @INC ) {
1632 warn "globbing $INC/FS/cdr/[a-z]*.pm\n" if $DEBUG;
1633 foreach my $file ( glob("$INC/FS/cdr/[a-z]*.pm") ) {
1634 warn "attempting to load CDR format info from $file\n" if $DEBUG;
1635 $file =~ /\/(\w+)\.pm$/ or do {
1636 warn "unrecognized file in $INC/FS/cdr/: $file\n";
1640 my $info = eval "use FS::cdr::$mod; ".
1641 "\\%FS::cdr::$mod\::info;";
1643 die "error using FS::cdr::$mod (skipping): $@\n" if $@;
1646 unless ( keys %$info ) {
1647 warn "no %info hash found in FS::cdr::$mod, skipping\n";
1650 warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
1651 if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1652 warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
1655 $cdr_info{$mod} = $info;
1659 tie my %import_formats, 'Tie::IxHash',
1660 map { $_ => $cdr_info{$_}->{'name'} }
1662 #this is not doing anything useful anymore
1663 #sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
1665 sort { lc($cdr_info{$a}->{'name'}) cmp lc($cdr_info{$b}->{'name'}) }
1667 grep { exists($cdr_info{$_}->{'import_fields'}) }
1670 sub import_formats {
1674 sub _cdr_min_parser_maker {
1676 my @fields = ref($field) ? @$field : ($field);
1677 @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
1679 my( $cdr, $min ) = @_;
1680 my $sec = eval { _cdr_min_parse($min) };
1681 die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
1682 $cdr->$_($sec) foreach @fields;
1686 sub _cdr_min_parse {
1688 sprintf('%.0f', $min * 60 );
1691 sub _cdr_date_parser_maker {
1694 my @fields = ref($field) ? @$field : ($field);
1696 my( $cdr, $datestring ) = @_;
1697 my $unixdate = eval { _cdr_date_parse($datestring, %options) };
1698 die "error parsing date for @fields from $datestring: $@\n" if $@;
1699 $cdr->$_($unixdate) foreach @fields;
1703 sub _cdr_date_parse {
1707 return '' unless length($date); #that's okay, it becomes NULL
1708 return '' if $date eq 'NA'; #sansay
1710 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 ) {
1711 my $time = str2time($date);
1712 return $time if $time > 100000; #just in case
1715 my($year, $mon, $day, $hour, $min, $sec);
1717 #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
1718 #taqua #2007-10-31 08:57:24.113000000
1720 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|$)/ ) {
1721 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1722 } 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|$)/ ) {
1723 # 8/26/2010 12:20:01
1724 # optionally without seconds
1725 ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1726 $sec = 0 if !defined($sec);
1727 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\.\d+)$/ ) {
1728 # broadsoft: 20081223201938.314
1729 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1730 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\d+(\D|$)/ ) {
1731 # Taqua OM: 20050422203450943
1732 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1733 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) {
1734 # WIP: 20100329121420
1735 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1736 } elsif ( $date =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z$/) {
1737 # Telos 2014-10-10T05:30:33Z
1738 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1740 } elsif ( $date =~ /^(\d+):(\d+):(\d+)\.\d+ \w+ (\w+) (\d+) (\d+)$/ ) {
1741 ($hour, $min, $sec, $mon, $day, $year) = ( $1, $2, $3, $4, $5, $6 );
1742 $mon = { # Acme Packet: 15:54:56.868 PST DEC 18 2017
1743 # My best guess of month abbv they may use
1744 JAN => '01', FEB => '02', MAR => '03', APR => '04',
1745 MAY => '05', JUN => '06', JUL => '07', AUG => '08',
1746 SEP => '09', OCT => '10', NOV => '11', DEC => '12'
1749 die "unparsable date: $date"; #maybe we shouldn't die...
1752 return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
1753 && $hour == 0 && $min == 0 && $sec == 0;
1755 if ($options{gmt}) {
1756 timegm($sec, $min, $hour, $day, $mon-1, $year);
1758 timelocal($sec, $min, $hour, $day, $mon-1, $year);
1762 =item batch_import HASHREF
1764 Imports CDR records. Available options are:
1776 Hash reference of preset fields, typically cdrbatch
1780 Set true to prevent throwing an error on empty imports
1786 my %import_options = (
1789 'batch_keycol' => 'cdrbatchnum',
1790 'batch_table' => 'cdr_batch',
1791 'batch_namecol' => 'cdrbatch',
1793 'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
1797 #drop the || 'csv' to allow auto xls for csv types?
1798 'format_types' => { map { $_ => lc($cdr_info{$_}->{'type'} || 'csv'); }
1802 'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
1806 'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
1810 'format_fixedlength_formats' =>
1811 { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
1815 'format_xml_formats' =>
1816 { map { $_ => $cdr_info{$_}->{'xml_format'}; }
1820 'format_asn_formats' =>
1821 { map { $_ => $cdr_info{$_}->{'asn_format'}; }
1825 'format_row_callbacks' =>
1826 { map { $_ => $cdr_info{$_}->{'row_callback'}; }
1830 'format_parser_opts' =>
1831 { map { $_ => $cdr_info{$_}->{'parser_opt'}; }
1836 sub _import_options {
1843 my $iopt = _import_options;
1844 $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
1846 if ( defined $opt->{'cdrtypenum'} ) {
1847 $opt->{'preinsert_callback'} = sub {
1848 my($record,$param) = (shift,shift);
1849 $record->cdrtypenum($opt->{'cdrtypenum'});
1854 FS::Record::batch_import( $opt );
1858 =item process_batch_import
1862 sub process_batch_import {
1865 my $opt = _import_options;
1866 # $opt->{'params'} = [ 'format', 'cdrbatch' ];
1868 FS::Record::process_batch_import( $job, $opt, @_ );
1871 # if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
1872 # @columns = map { s/^ +//; $_; } @columns;
1876 =item ip_addr_sql FIELD RANGE
1878 Returns an SQL condition to search for CDRs with an IP address
1879 within RANGE. FIELD is either 'src_ip_addr' or 'dst_ip_addr'. RANGE
1880 should be in the form "a.b.c.d-e.f.g.h' (dotted quads), where any of
1881 the leftmost octets of the second address can be omitted if they're
1882 the same as the first address.
1888 my ($field, $range) = @_;
1889 $range =~ /^[\d\.-]+$/ or die "bad ip address range '$range'";
1890 my @r = split('-', $range);
1891 my @saddr = split('\.', $r[0] || '');
1892 my @eaddr = split('\.', $r[1] || '');
1893 unshift @eaddr, (undef) x (4 - scalar @eaddr);
1895 $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
1897 "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
1898 "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
1907 L<FS::Record>, schema.html from the base documentation.