4 use vars qw( @ISA @EXPORT_OK $DEBUG $me
5 $conf $cdr_prerate %cdr_prerate_cdrtypenums
8 use List::Util qw(first min);
13 use List::Util qw( first min );
15 use FS::UID qw( dbh );
17 use FS::Record qw( qsearch qsearchs );
22 use FS::cdr_termination;
27 @ISA = qw(FS::Record);
28 @EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker );
33 #ask FS::UID to run this stuff for us later
34 FS::UID->install_callback( sub {
37 my @cdr_prerate_cdrtypenums;
38 $cdr_prerate = $conf->exists('cdr-prerate');
39 @cdr_prerate_cdrtypenums = $conf->config('cdr-prerate-cdrtypenums')
41 %cdr_prerate_cdrtypenums = map { $_=>1 } @cdr_prerate_cdrtypenums;
46 FS::cdr - Object methods for cdr records
52 $record = new FS::cdr \%hash;
53 $record = new FS::cdr { 'column' => 'value' };
55 $error = $record->insert;
57 $error = $new_record->replace($old_record);
59 $error = $record->delete;
61 $error = $record->check;
65 An FS::cdr object represents an Call Data Record, typically from a telephony
66 system or provider of some sort. FS::cdr inherits from FS::Record. The
67 following fields are currently supported:
71 =item acctid - primary key
73 =item calldate - Call timestamp (SQL timestamp)
75 =item clid - Caller*ID with text
77 =item src - Caller*ID number / Source number
79 =item dst - Destination extension
81 =item dcontext - Destination context
83 =item channel - Channel used
85 =item dstchannel - Destination channel if appropriate
87 =item lastapp - Last application if appropriate
89 =item lastdata - Last application data
91 =item src_ip_addr - Source IP address (dotted quad, zero-filled)
93 =item dst_ip_addr - Destination IP address (same)
95 =item dst_term - Terminating destination number (if different from dst)
97 =item startdate - Start of call (UNIX-style integer timestamp)
99 =item answerdate - Answer time of call (UNIX-style integer timestamp)
101 =item enddate - End time of call (UNIX-style integer timestamp)
103 =item duration - Total time in system, in seconds
105 =item billsec - Total time call is up, in seconds
107 =item disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
109 =item amaflags - What flags to use: BILL, IGNORE etc, specified on a per channel basis like accountcode.
113 #ignore the "omit" and "documentation" AMAs??
114 #AMA = Automated Message Accounting.
115 #default: Sets the system default.
116 #omit: Do not record calls.
117 #billing: Mark the entry for billing
118 #documentation: Mark the entry for documentation.
120 =item accountcode - CDR account number to use: account
122 =item uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
124 =item userfield - CDR user-defined field
126 =item cdr_type - CDR type - see L<FS::cdr_type> (Usage = 1, S&E = 7, OC&C = 8)
128 =item charged_party - Service number to be billed
130 =item upstream_currency - Wholesale currency from upstream
132 =item upstream_price - Wholesale price from upstream
134 =item upstream_rateplanid - Upstream rate plan ID
136 =item rated_price - Rated (or re-rated) price
138 =item distance - km (need units field?)
140 =item islocal - Local - 1, Non Local = 0
142 =item calltypenum - Type of call - see L<FS::cdr_calltype>
144 =item description - Description (cdr_type 7&8 only) (used for cust_bill_pkg.itemdesc)
146 =item quantity - Number of items (cdr_type 7&8 only)
148 =item carrierid - Upstream Carrier ID (see L<FS::cdr_carrier>)
152 #Telstra =1, Optus = 2, RSL COM = 3
154 =item upstream_rateid - Upstream Rate ID
156 =item svcnum - Link to customer service (see L<FS::cust_svc>)
158 =item freesidestatus - NULL, processing-tiered, rated, done, skipped, no-charge, failed
160 =item freesiderewritestatus - NULL, done, skipped
172 Creates a new CDR. To add the CDR to the database, see L<"insert">.
174 Note that this stores the hash reference, not a distinct copy of the hash it
175 points to. You can ask the object for a copy with the I<hash> method.
179 # the new method can be inherited from FS::Record, if a table method is defined
186 #XXX fill in some (more) nice names
188 'calldate' => 'Call date',
189 'clid' => 'Caller ID',
191 'dst' => 'Destination',
192 'dcontext' => 'Dest. context',
193 'channel' => 'Channel',
194 'dstchannel' => 'Destination channel',
197 'src_ip_addr' => 'Source IP',
198 'dst_ip_addr' => 'Dest. IP',
199 'dst_term' => 'Termination dest.',
200 'startdate' => 'Start date',
201 'answerdate' => 'Answer date',
202 'enddate' => 'End date',
203 'duration' => 'Duration',
204 'billsec' => 'Billable seconds',
205 'disposition' => 'Disposition',
206 'amaflags' => 'AMA flags',
207 'accountcode' => 'Account code',
209 'userfield' => 'User field',
211 'charged_party' => 'Charged party',
212 #'upstream_currency' => '',
213 'upstream_price' => 'Upstream price',
214 #'upstream_rateplanid' => '',
215 #'ratedetailnum' => '',
216 'rated_price' => 'Rated price',
219 #'calltypenum' => '',
220 #'description' => '',
222 'carrierid' => 'Carrier ID',
223 #'upstream_rateid' => '',
224 'svcnum' => 'Freeside service',
225 'freesidestatus' => 'Freeside status',
226 'freesiderewritestatus' => 'Freeside rewrite status',
227 'cdrbatch' => 'Legacy batch',
228 'cdrbatchnum' => 'Batch',
237 Adds this record to the database. If there is an error, returns the error,
238 otherwise returns false.
242 # the insert method can be inherited from FS::Record
246 Delete this record from the database.
250 # the delete method can be inherited from FS::Record
252 =item replace OLD_RECORD
254 Replaces the OLD_RECORD with this one in the database. If there is an error,
255 returns the error, otherwise returns false.
259 # the replace method can be inherited from FS::Record
263 Checks all fields to make sure this is a valid CDR. If there is
264 an error, returns the error, otherwise returns false. Called by the insert
267 Note: Unlike most types of records, we don't want to "reject" a CDR and we want
268 to process them as quickly as possible, so we allow the database to check most
276 # we don't want to "reject" a CDR like other sorts of input...
278 # $self->ut_numbern('acctid')
279 ## || $self->ut_('calldate')
280 # || $self->ut_text('clid')
281 # || $self->ut_text('src')
282 # || $self->ut_text('dst')
283 # || $self->ut_text('dcontext')
284 # || $self->ut_text('channel')
285 # || $self->ut_text('dstchannel')
286 # || $self->ut_text('lastapp')
287 # || $self->ut_text('lastdata')
288 # || $self->ut_numbern('startdate')
289 # || $self->ut_numbern('answerdate')
290 # || $self->ut_numbern('enddate')
291 # || $self->ut_number('duration')
292 # || $self->ut_number('billsec')
293 # || $self->ut_text('disposition')
294 # || $self->ut_number('amaflags')
295 # || $self->ut_text('accountcode')
296 # || $self->ut_text('uniqueid')
297 # || $self->ut_text('userfield')
298 # || $self->ut_numbern('cdrtypenum')
299 # || $self->ut_textn('charged_party')
300 ## || $self->ut_n('upstream_currency')
301 ## || $self->ut_n('upstream_price')
302 # || $self->ut_numbern('upstream_rateplanid')
303 ## || $self->ut_n('distance')
304 # || $self->ut_numbern('islocal')
305 # || $self->ut_numbern('calltypenum')
306 # || $self->ut_textn('description')
307 # || $self->ut_numbern('quantity')
308 # || $self->ut_numbern('carrierid')
309 # || $self->ut_numbern('upstream_rateid')
310 # || $self->ut_numbern('svcnum')
311 # || $self->ut_textn('freesidestatus')
312 # || $self->ut_textn('freesiderewritestatus')
314 # return $error if $error;
316 for my $f ( grep { $self->$_ =~ /\D/ } qw(startdate answerdate enddate)){
317 $self->$f( str2time($self->$f) );
320 $self->calldate( $self->startdate_sql )
321 if !$self->calldate && $self->startdate;
323 #was just for $format eq 'taqua' but can't see the harm... add something to
324 #disable if it becomes a problem
325 if ( $self->duration eq '' && $self->enddate && $self->startdate ) {
326 $self->duration( $self->enddate - $self->startdate );
328 if ( $self->billsec eq '' && $self->enddate && $self->answerdate ) {
329 $self->billsec( $self->enddate - $self->answerdate );
332 if ( ! $self->enddate && $self->startdate && $self->duration ) {
333 $self->enddate( $self->startdate + $self->duration );
336 $self->set_charged_party;
338 #check the foreign keys even?
339 #do we want to outright *reject* the CDR?
341 $self->ut_numbern('acctid');
343 #add a config option to turn these back on if someone needs 'em
345 # #Usage = 1, S&E = 7, OC&C = 8
346 # || $self->ut_foreign_keyn('cdrtypenum', 'cdr_type', 'cdrtypenum' )
348 # #the big list in appendix 2
349 # || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
351 # # Telstra =1, Optus = 2, RSL COM = 3
352 # || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
354 return $error if $error;
359 =item is_tollfree [ COLUMN ]
361 Returns true when the cdr represents a toll free number and false otherwise.
363 By default, inspects the dst field, but an optional column name can be passed
364 to inspect other field.
370 my $field = scalar(@_) ? shift : 'dst';
371 ( $self->$field() =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0;
374 =item set_charged_party
376 If the charged_party field is already set, does nothing. Otherwise:
378 If the cdr-charged_party-accountcode config option is enabled, sets the
379 charged_party to the accountcode.
381 Otherwise sets the charged_party normally: to the src field in most cases,
382 or to the dst field if it is a toll free number.
386 sub set_charged_party {
389 my $conf = new FS::Conf;
391 unless ( $self->charged_party ) {
393 if ( $conf->exists('cdr-charged_party-accountcode') && $self->accountcode ){
395 my $charged_party = $self->accountcode;
396 $charged_party =~ s/^0+//
397 if $conf->exists('cdr-charged_party-accountcode-trim_leading_0s');
398 $self->charged_party( $charged_party );
400 } elsif ( $conf->exists('cdr-charged_party-field') ) {
402 my $field = $conf->config('cdr-charged_party-field');
403 $self->charged_party( $self->$field() );
407 if ( $self->is_tollfree ) {
408 $self->charged_party($self->dst);
410 $self->charged_party($self->src);
417 # my $prefix = $conf->config('cdr-charged_party-truncate_prefix');
418 # my $prefix_len = length($prefix);
419 # my $trunc_len = $conf->config('cdr-charged_party-truncate_length');
421 # $self->charged_party( substr($self->charged_party, 0, $trunc_len) )
422 # if $prefix_len && $trunc_len
423 # && substr($self->charged_party, 0, $prefix_len) eq $prefix;
427 =item set_status STATUS
429 Sets the status to the provided string. If there is an error, returns the
430 error, otherwise returns false.
432 If status is being changed from 'rated' to some other status, also removes
433 any usage allocations to this CDR.
438 my($self, $status) = @_;
439 my $old_status = $self->freesidestatus;
440 $self->freesidestatus($status);
441 my $error = $self->replace;
442 if ( $old_status eq 'rated' and $status ne 'done' ) {
443 # deallocate any usage
444 foreach (qsearch('cdr_cust_pkg_usage', {acctid => $self->acctid})) {
445 my $cust_pkg_usage = $_->cust_pkg_usage;
446 $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $_->minutes);
447 $error ||= $cust_pkg_usage->replace || $_->delete;
453 =item set_status_and_rated_price STATUS RATED_PRICE [ SVCNUM [ OPTION => VALUE ... ] ]
455 Sets the status and rated price.
457 Available options are: inbound, rated_pretty_dst, rated_regionname,
458 rated_seconds, rated_minutes, rated_granularity, rated_ratedetailnum,
459 rated_classnum, rated_ratename.
461 If there is an error, returns the error, otherwise returns false.
465 sub set_status_and_rated_price {
466 my($self, $status, $rated_price, $svcnum, %opt) = @_;
468 if ($opt{'inbound'}) {
470 my $term = $self->cdr_termination( 1 ); #1: inbound
473 warn "replacing existing cdr status (".$self->acctid.")\n" if $term;
474 $error = $term->delete;
475 return $error if $error;
477 $term = FS::cdr_termination->new({
478 acctid => $self->acctid,
480 rated_price => $rated_price,
483 $term->rated_seconds($opt{rated_seconds}) if exists($opt{rated_seconds});
484 $term->rated_minutes($opt{rated_minutes}) if exists($opt{rated_minutes});
485 $term->svcnum($svcnum) if $svcnum;
486 return $term->insert;
490 $self->freesidestatus($status);
491 $self->rated_price($rated_price);
493 foreach grep exists($opt{$_}), map "rated_$_",
494 qw( pretty_dst regionname seconds minutes granularity
495 ratedetailnum classnum ratename );
496 $self->svcnum($svcnum) if $svcnum;
497 return $self->replace();
502 =item parse_number [ OPTION => VALUE ... ]
504 Returns two scalars, the countrycode and the rest of the number.
506 Options are passed as name-value pairs. Currently available options are:
512 The column containing the number to be parsed. Defaults to dst.
514 =item international_prefix
516 The digits for international dialing. Defaults to '011' The value '+' is
519 =item domestic_prefix
521 The digits for domestic long distance dialing. Defaults to '1'
528 my ($self, %options) = @_;
530 my $field = $options{column} || 'dst';
531 my $intl = $options{international_prefix} || '011';
532 my $countrycode = '';
533 my $number = $self->$field();
535 my $to_or_from = 'concerning';
536 $to_or_from = 'from' if $field eq 'src';
537 $to_or_from = 'to' if $field eq 'dst';
538 warn "parsing call $to_or_from $number\n" if $DEBUG;
540 #remove non-phone# stuff and whitespace
543 # $dest =~ s/^(\w+):// and $proto = $1; #sip:
545 # $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
547 if ( $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
548 || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
552 my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 );
553 #first look for 1 digit country code
554 if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) {
556 $number = $u1.$u2.$rest;
557 } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
560 } else { #3 digit country code
561 $countrycode = $three;
566 my $domestic_prefix =
567 exists($options{domestic_prefix}) ? $options{domestic_prefix} : '';
568 $countrycode = length($domestic_prefix) ? $domestic_prefix : '1';
569 $number =~ s/^$countrycode//;# if length($number) > 10;
572 return($countrycode, $number);
576 =item rate [ OPTION => VALUE ... ]
578 Rates this CDR according and sets the status to 'rated'.
580 Available options are: part_pkg, svcnum, plan_included_min,
581 detail_included_min_hashref.
583 part_pkg is required.
585 If svcnum is specified, will also associate this CDR with the specified svcnum.
587 plan_included_min should be set to a scalar reference of the number of
588 included minutes and will be decremented by the rated minutes of this
591 detail_included_min_hashref should be set to an empty hashref at the
592 start of a month's rating and then preserved across CDRs.
597 my( $self, %opt ) = @_;
598 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
601 warn "rating CDR $self\n".
602 join('', map { " $_ => ". $self->{$_}. "\n" } keys %$self );
605 my $rating_method = $part_pkg->option_cacheable('rating_method') || 'prefix';
606 my $method = "rate_$rating_method";
607 $self->$method(%opt);
611 our %interval_cache = (); # for timed rates
614 my( $self, %opt ) = @_;
615 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
616 my $cust_pkg = $opt{'cust_pkg'};
619 # this will result in those CDRs being marked as done... is that
622 if ( $part_pkg->option_cacheable('411_rewrite') ) {
623 my $dirass = $part_pkg->option_cacheable('411_rewrite');
625 @dirass = split(',', $dirass);
628 if ( length($self->dst) && grep { $self->dst eq $_ } @dirass ) {
633 my $reason = $part_pkg->check_chargable( $self,
634 'da_rewrote' => $da_rewrote,
637 warn "not charging for CDR ($reason)\n" if $DEBUG;
638 return $self->set_status_and_rated_price( 'skipped',
644 if ( $part_pkg->option_cacheable('skip_same_customer')
645 and ! $self->is_tollfree ) {
646 my ($dst_countrycode, $dst_number) = $self->parse_number(
648 international_prefix => $part_pkg->option_cacheable('international_prefix'),
649 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
651 my $dst_same_cust = FS::Record->scalar_sql(
652 'SELECT COUNT(svc_phone.svcnum) AS count '.
654 'JOIN cust_svc USING (pkgnum) ' .
655 'JOIN svc_phone USING (svcnum) ' .
656 'WHERE svc_phone.countrycode = ' . dbh->quote($dst_countrycode) .
657 ' AND svc_phone.phonenum = ' . dbh->quote($dst_number) .
658 ' AND cust_pkg.custnum = ' . $cust_pkg->custnum,
660 if ( $dst_same_cust > 0 ) {
661 warn "not charging for CDR (same source and destination customer)\n" if $DEBUG;
662 return $self->set_status_and_rated_price( 'skipped',
673 # look up rate details based on called station id
674 # (or calling station id for toll free calls)
677 my $eff_ratenum = $self->is_tollfree('accountcode')
678 ? $part_pkg->option_cacheable('accountcode_tollfree_ratenum')
681 my( $to_or_from, $column );
684 && ! $part_pkg->option_cacheable('disable_tollfree')
687 && $part_pkg->option_cacheable('accountcode_tollfree_field') eq 'src'
691 $to_or_from = 'from';
693 } else { #regular call
698 #determine the country code
699 my ($countrycode, $number) = $self->parse_number(
701 international_prefix => $part_pkg->option_cacheable('international_prefix'),
702 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
705 warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG;
706 my $pretty_dst = "+$countrycode $number";
707 #asterisks here causes inserting the detail to barf, so:
708 $pretty_dst =~ s/\*//g;
711 my $intrastate_ratenum = $part_pkg->option_cacheable('intrastate_ratenum');
712 if ( $intrastate_ratenum && !$self->is_tollfree ) {
713 $ratename = 'Interstate'; #until proven otherwise
714 # this is relatively easy only because:
715 # -assume all numbers are valid NANP numbers NOT in a fully-qualified format
716 # -disregard toll-free
717 # -disregard private or unknown numbers
718 # -there is exactly one record in rate_prefix for a given NPANXX
719 # -default to interstate if we can't find one or both of the prefixes
720 my (undef, $dstprefix) = $self->parse_number(
722 international_prefix => $part_pkg->option_cacheable('international_prefix'),
723 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
725 $dstprefix =~ /^(\d{6})/;
726 $dstprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
729 my (undef, $srcprefix) = $self->parse_number(
731 international_prefix => $part_pkg->option_cacheable('international_prefix'),
732 domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
734 $srcprefix =~ /^(\d{6})/;
735 $srcprefix = qsearchs('rate_prefix', { 'countrycode' => '1',
738 if ($srcprefix && $dstprefix
739 && $srcprefix->state && $dstprefix->state
740 && $srcprefix->state eq $dstprefix->state) {
741 $eff_ratenum = $intrastate_ratenum;
742 $ratename = 'Intrastate'; # XXX possibly just use the ratename?
746 $eff_ratenum ||= $part_pkg->option_cacheable('ratenum');
747 my $rate = qsearchs('rate', { 'ratenum' => $eff_ratenum })
748 or die "ratenum $eff_ratenum not found!";
750 my @ltime = localtime($self->startdate);
751 my $weektime = $ltime[0] +
752 $ltime[1]*60 + #minutes
753 $ltime[2]*3600 + #hours
754 $ltime[6]*86400; #days since sunday
755 # if there's no timed rate_detail for this time/region combination,
756 # dest_detail returns the default. There may still be a timed rate
757 # that applies after the starttime of the call, so be careful...
758 my $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
759 'phonenum' => $number,
760 'weektime' => $weektime,
761 'cdrtypenum' => $self->cdrtypenum,
764 unless ( $rate_detail ) {
766 if ( $part_pkg->option_cacheable('ignore_unrateable') ) {
768 if ( $part_pkg->option_cacheable('ignore_unrateable') == 2 ) {
769 # mark the CDR as unrateable
770 return $self->set_status_and_rated_price(
775 } elsif ( $part_pkg->option_cacheable('ignore_unrateable') == 1 ) {
777 warn "no rate_detail found for CDR.acctid: ". $self->acctid.
782 die "unknown ignore_unrateable, pkgpart ". $part_pkg->pkgpart;
787 die "FATAL: no rate_detail found in ".
788 $rate->ratenum. ":". $rate->ratename. " rate plan ".
789 "for +$countrycode $number (CDR acctid ". $self->acctid. "); ".
790 "add a rate or set ignore_unrateable flag on the package def\n";
795 my $rate_region = $rate_detail->dest_region;
796 my $regionnum = $rate_region->regionnum;
797 warn " found rate for regionnum $regionnum ".
798 "and rate detail $rate_detail\n"
801 if ( !exists($interval_cache{$regionnum}) ) {
803 sort { $a->stime <=> $b->stime }
804 map { $_->rate_time->intervals }
805 qsearch({ 'table' => 'rate_detail',
806 'hashref' => { 'ratenum' => $rate->ratenum },
807 'extra_sql' => 'AND ratetimenum IS NOT NULL',
810 $interval_cache{$regionnum} = \@intervals;
811 warn " cached ".scalar(@intervals)." interval(s)\n"
816 # find the price and add detail to the invoice
819 # About this section:
820 # We don't round _anything_ (except granularizing)
821 # until the final $charge = sprintf("%.2f"...).
823 my $seconds_left = $part_pkg->option_cacheable('use_duration')
827 #no, do this later so it respects (group) included minutes
828 # # charge for the first (conn_sec) seconds
829 # my $seconds = min($seconds_left, $rate_detail->conn_sec);
830 # $seconds_left -= $seconds;
831 # $weektime += $seconds;
832 # my $charge = $rate_detail->conn_charge;
835 my $connection_charged = 0;
838 while($seconds_left) {
839 my $ratetimenum = $rate_detail->ratetimenum; # may be empty
841 # find the end of the current rate interval
842 if(@{ $interval_cache{$regionnum} } == 0) {
843 # There are no timed rates in this group, so just stay
844 # in the default rate_detail for the entire duration.
845 # Set an "end" of 1 past the end of the current call.
846 $etime = $weektime + $seconds_left + 1;
848 elsif($ratetimenum) {
849 # This is a timed rate, so go to the etime of this interval.
850 # If it's followed by another timed rate, the stime of that
851 # interval should match the etime of this one.
852 my $interval = $rate_detail->rate_time->contains($weektime);
853 $etime = $interval->etime;
856 # This is a default rate, so use the stime of the next
857 # interval in the sequence.
858 my $next_int = first { $_->stime > $weektime }
859 @{ $interval_cache{$regionnum} };
861 $etime = $next_int->stime;
864 # weektime is near the end of the week, so decrement
865 # it by a full week and use the stime of the first
867 $weektime -= (3600*24*7);
868 $etime = $interval_cache{$regionnum}->[0]->stime;
872 my $charge_sec = min($seconds_left, $etime - $weektime);
874 $seconds_left -= $charge_sec;
876 my $granularity = $rate_detail->sec_granularity;
879 if ( $granularity ) { # charge per minute
880 # Round up to the nearest $granularity
881 if ( $charge_sec and $charge_sec % $granularity ) {
882 $charge_sec += $granularity - ($charge_sec % $granularity);
884 $minutes = $charge_sec / 60; #don't round this
891 $seconds += $charge_sec;
893 if ( $rate_detail->min_included ) {
894 # the old, kind of deprecated way to do this:
896 # The rate detail itself has included minutes. We MUST have a place
898 my $included_min = $opt{'detail_included_min_hashref'}
899 or return "unable to rate CDR: rate detail has included minutes, but ".
900 "no detail_included_min_hashref provided.\n";
902 # by default, set the included minutes for this region/time to
903 # what's in the rate_detail
904 $included_min->{$regionnum}{$ratetimenum} = $rate_detail->min_included
905 unless exists $included_min->{$regionnum}{$ratetimenum};
907 if ( $included_min->{$regionnum}{$ratetimenum} >= $minutes ) {
909 $included_min->{$regionnum}{$ratetimenum} -= $minutes;
911 $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60);
912 $included_min->{$regionnum}{$ratetimenum} = 0;
914 } elsif ( $opt{plan_included_min} && ${ $opt{plan_included_min} } > 0 ) {
915 # The package definition has included minutes, but only for in-group
916 # rate details. Decrement them if this is an in-group call.
917 if ( $rate_detail->region_group ) {
918 if ( ${ $opt{'plan_included_min'} } >= $minutes ) {
920 ${ $opt{'plan_included_min'} } -= $minutes;
922 $charge_sec -= (${ $opt{'plan_included_min'} } * 60);
923 ${ $opt{'plan_included_min'} } = 0;
928 my $applied_min = $cust_pkg->apply_usage(
930 'rate_detail' => $rate_detail,
931 'minutes' => $minutes
933 # for now, usage pools deal only in whole minutes
934 $charge_sec -= $applied_min * 60;
937 if ( $charge_sec > 0 ) {
939 #NOW do connection charges here... right?
940 #my $conn_seconds = min($seconds_left, $rate_detail->conn_sec);
941 my $conn_seconds = 0;
942 unless ( $connection_charged++ ) { #only one connection charge
943 $conn_seconds = min($charge_sec, $rate_detail->conn_sec);
944 $seconds_left -= $conn_seconds;
945 $weektime += $conn_seconds;
946 $charge += $rate_detail->conn_charge;
949 #should preserve (display?) this
950 if ( $granularity == 0 ) { # per call rate
951 $charge += $rate_detail->min_charge;
953 my $charge_min = ( $charge_sec - $conn_seconds ) / 60;
954 $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
959 # choose next rate_detail
960 $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
961 'phonenum' => $number,
962 'weektime' => $etime,
963 'cdrtypenum' => $self->cdrtypenum })
965 # we have now moved forward to $etime
968 } #while $seconds_left
970 # this is why we need regionnum/rate_region....
971 warn " (rate region $rate_region)\n" if $DEBUG;
974 my $rounding = $part_pkg->option_cacheable('rounding') || 2;
975 my $sprintformat = '%.'. $rounding. 'f';
976 my $roundup = 10**(-3-$rounding);
977 my $price = sprintf($sprintformat, $charge + $roundup);
979 $self->set_status_and_rated_price(
983 'rated_pretty_dst' => $pretty_dst,
984 'rated_regionname' => $rate_region->regionname,
985 'rated_seconds' => $seconds,
986 'rated_granularity' => $rate_detail->sec_granularity, #$granularity
987 'rated_ratedetailnum' => $rate_detail->ratedetailnum,
988 'rated_classnum' => $rate_detail->classnum, #rated_ratedetailnum?
989 'rated_ratename' => $ratename, #not rate_detail - Intrastate/Interstate
994 sub rate_upstream_simple {
995 my( $self, %opt ) = @_;
997 $self->set_status_and_rated_price(
999 sprintf('%.3f', $self->upstream_price),
1001 'rated_classnum' => $self->calltypenum,
1002 'rated_seconds' => $self->billsec,
1003 # others? upstream_*_regionname => rated_regionname is possible
1007 sub rate_single_price {
1008 my( $self, %opt ) = @_;
1009 my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified";
1011 # a little false laziness w/abov
1012 # $rate_detail = new FS::rate_detail({sec_granularity => ... }) ?
1014 my $granularity = length($part_pkg->option_cacheable('sec_granularity'))
1015 ? $part_pkg->option_cacheable('sec_granularity')
1018 my $seconds = $part_pkg->option_cacheable('use_duration')
1022 $seconds += $granularity - ( $seconds % $granularity )
1023 if $seconds # don't granular-ize 0 billsec calls (bills them)
1024 && $granularity # 0 is per call
1025 && $seconds % $granularity;
1026 my $minutes = $granularity ? ($seconds / 60) : 1;
1028 my $charge_min = $minutes;
1030 ${$opt{plan_included_min}} -= $minutes;
1031 if ( ${$opt{plan_included_min}} > 0 ) {
1034 $charge_min = 0 - ${$opt{plan_included_min}};
1035 ${$opt{plan_included_min}} = 0;
1039 sprintf('%.4f', ( $part_pkg->option_cacheable('min_charge') * $charge_min )
1040 + 0.0000000001 ); #so 1.00005 rounds to 1.0001
1042 $self->set_status_and_rated_price(
1046 'rated_granularity' => $granularity,
1047 'rated_seconds' => $seconds,
1054 Rates an already-rated CDR according to the cost fields from the rate plan.
1063 return 0 unless $self->rated_ratedetailnum;
1066 qsearchs('rate_detail', { 'ratedetailnum' => $self->rated_ratedetailnum } );
1068 return $rate_detail->min_cost if $self->rated_granularity == 0;
1070 my $minutes = $self->rated_seconds / 60;
1071 my $charge = $rate_detail->conn_cost + $minutes * $rate_detail->min_cost;
1073 sprintf('%.2f', $charge + .00001 );
1077 =item cdr_termination [ TERMPART ]
1081 sub cdr_termination {
1084 if ( scalar(@_) && $_[0] ) {
1085 my $termpart = shift;
1087 qsearchs('cdr_termination', { acctid => $self->acctid,
1088 termpart => $termpart,
1094 qsearch('cdr_termination', { acctid => $self->acctid, } );
1102 Parses the calldate in SQL string format and returns a UNIX timestamp.
1107 str2time(shift->calldate);
1112 Parses the startdate in UNIX timestamp format and returns a string in SQL
1118 my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
1121 "$year-$mon-$mday $hour:$min:$sec";
1126 Returns the FS::cdr_carrier object associated with this CDR, or false if no
1127 carrierid is defined.
1131 my %carrier_cache = ();
1135 return '' unless $self->carrierid;
1136 $carrier_cache{$self->carrierid} ||=
1137 qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
1142 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
1143 no FS::cdr_carrier object is assocated with this CDR.
1149 my $cdr_carrier = $self->cdr_carrier;
1150 $cdr_carrier ? $cdr_carrier->carriername : '';
1155 Returns the FS::cdr_calltype object associated with this CDR, or false if no
1156 calltypenum is defined.
1160 my %calltype_cache = ();
1164 return '' unless $self->calltypenum;
1165 $calltype_cache{$self->calltypenum} ||=
1166 qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
1171 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
1172 no FS::cdr_calltype object is assocated with this CDR.
1178 my $cdr_calltype = $self->cdr_calltype;
1179 $cdr_calltype ? $cdr_calltype->calltypename : '';
1182 =item downstream_csv [ OPTION => VALUE, ... ]
1186 # in the future, load this dynamically from detail_format classes
1188 my %export_names = (
1191 'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
1194 'name' => 'Simple with source',
1195 'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
1196 #"Date,Time,Name,Called From,Destination,Duration,Price",
1198 'accountcode_simple' => {
1199 'name' => 'Simple with accountcode',
1200 'invoice_header' => "Date,Time,Called From,Account,Duration,Price",
1204 'invoice_header' => "Date/Time,Called Number,Min/Sec,Price",
1206 'basic_upstream_dst_regionname' => {
1207 'name' => 'Basic with upstream destination name',
1208 'invoice_header' => "Date/Time,Called Number,Destination,Min/Sec,Price",
1211 'name' => 'Default',
1212 'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
1214 'source_default' => {
1215 'name' => 'Default with source',
1216 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1218 'accountcode_default' => {
1219 'name' => 'Default plus accountcode',
1220 'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
1222 'description_default' => {
1223 'name' => 'Default with description field as destination',
1224 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
1227 'name' => 'Summary, one line per service',
1228 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1231 'name' => 'Number of calls, one line per service',
1232 'invoice_header' => 'Caller,Rate,Messages,Price',
1234 'sum_duration_prefix' => {
1235 'name' => 'Summary, one line per destination prefix',
1236 'invoice_header' => 'Caller,Rate,Calls,Minutes,Price',
1238 'sum_count_class' => {
1239 'name' => 'Summary, one line per usage class',
1240 'invoice_header' => 'Caller,Class,Calls,Price',
1244 my %export_formats = ();
1245 sub export_formats {
1248 return %export_formats if keys %export_formats;
1250 my $conf = new FS::Conf;
1251 my $date_format = $conf->config('date_format') || '%m/%d/%Y';
1253 # call duration in the largest units that accurately reflect the granularity
1254 my $duration_sub = sub {
1255 my($cdr, %opt) = @_;
1256 my $sec = $opt{seconds} || $cdr->billsec;
1257 if ( defined $opt{granularity} &&
1258 $opt{granularity} == 0 ) { #per call
1261 elsif ( defined $opt{granularity} && $opt{granularity} == 60 ) {#full minutes
1262 my $min = int($sec/60);
1266 else { #anything else
1267 return sprintf("%dm %ds", $sec/60, $sec%60);
1271 my $price_sub = sub {
1272 my ($cdr, %opt) = @_;
1274 if ( defined($opt{charge}) ) {
1275 $price = $opt{charge};
1277 elsif ( $opt{inbound} ) {
1278 my $term = $cdr->cdr_termination(1); # 1 = inbound
1279 $price = $term->rated_price if defined $term;
1282 $price = $cdr->rated_price;
1284 length($price) ? ($opt{money_char} . $price) : '';
1287 my $src_sub = sub { $_[0]->clid || $_[0]->src };
1291 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1292 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1294 'dst', #NUMBER_DIALED
1295 $duration_sub, #DURATION
1296 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1300 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1301 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1303 $src_sub, #called from
1304 'dst', #NUMBER_DIALED
1305 $duration_sub, #DURATION
1306 #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
1309 'accountcode_simple' => [
1310 sub { time2str($date_format, shift->calldate_unix ) }, #DATE
1311 sub { time2str('%r', shift->calldate_unix ) }, #TIME
1312 $src_sub, #called from
1313 'accountcode', #NUMBER_DIALED
1314 $duration_sub, #DURATION
1318 # for summary formats, the CDR is a fictitious object containing the
1319 # total billsec and the phone number of the service
1321 sub { my($cdr, %opt) = @_; $opt{ratename} },
1322 sub { my($cdr, %opt) = @_; $opt{count} },
1323 sub { my($cdr, %opt) = @_; int($opt{seconds}/60).'m' },
1328 sub { my($cdr, %opt) = @_; $opt{ratename} },
1329 sub { my($cdr, %opt) = @_; $opt{count} },
1333 sub { time2str('%d %b - %I:%M %p', shift->calldate_unix) },
1341 sub { time2str($date_format, shift->calldate_unix ) },
1342 # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
1345 sub { time2str('%r', shift->calldate_unix ) },
1346 # 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
1349 sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
1351 #REGIONNAME ("Destination")
1352 sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
1361 $export_formats{'source_default'} = [ $src_sub, @{ $export_formats{'default'} }, ];
1362 $export_formats{'accountcode_default'} =
1363 [ @{ $export_formats{'default'} }[0,1],
1365 @{ $export_formats{'default'} }[2..5],
1367 my @default = @{ $export_formats{'default'} };
1368 $export_formats{'description_default'} =
1369 [ $src_sub, @default[0..2],
1370 sub { my($cdr, %opt) = @_; $cdr->description },
1373 return %export_formats;
1376 =item downstream_csv OPTION => VALUE ...
1378 Returns a string of formatted call details for display on an invoice.
1384 charge - override the 'rated_price' field of the CDR
1386 seconds - override the 'billsec' field of the CDR
1388 count - number of usage events included in this record, for summary formats
1390 ratename - name of the rate table used to rate this call
1396 sub downstream_csv {
1397 my( $self, %opt ) = @_;
1399 my $format = $opt{'format'};
1400 my %formats = $self->export_formats;
1401 return "Unknown format $format" unless exists $formats{$format};
1403 #my $conf = new FS::Conf;
1404 #$opt{'money_char'} ||= $conf->config('money_char') || '$';
1405 $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
1407 my $csv = new Text::CSV_XS;
1411 ref($_) ? &{$_}($self, %opt) : $self->$_();
1413 @{ $formats{$format} };
1415 return @columns if defined $opt{'keeparray'};
1417 my $status = $csv->combine(@columns);
1418 die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
1427 =head1 CLASS METHODS
1431 =item invoice_formats
1433 Returns an ordered list of key value pairs containing invoice format names
1434 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
1438 # in the future, load this dynamically from detail_format classes
1440 sub invoice_formats {
1441 map { ($_ => $export_names{$_}->{'name'}) }
1442 grep { $export_names{$_}->{'invoice_header'} }
1446 =item invoice_header FORMAT
1448 Returns a scalar containing the CSV column header for invoice format FORMAT.
1452 sub invoice_header {
1454 $export_names{$format}->{'invoice_header'};
1459 Clears cdr and any associated cdr_termination statuses - used for
1468 local $SIG{HUP} = 'IGNORE';
1469 local $SIG{INT} = 'IGNORE';
1470 local $SIG{QUIT} = 'IGNORE';
1471 local $SIG{TERM} = 'IGNORE';
1472 local $SIG{TSTP} = 'IGNORE';
1473 local $SIG{PIPE} = 'IGNORE';
1475 my $oldAutoCommit = $FS::UID::AutoCommit;
1476 local $FS::UID::AutoCommit = 0;
1479 if ( $cdr_prerate && $cdr_prerate_cdrtypenums{$self->cdrtypenum}
1480 && $self->rated_ratedetailnum #avoid putting old CDRs back in "rated"
1481 && $self->freesidestatus eq 'done'
1485 $self->freesidestatus('rated');
1487 $self->freesidestatus('');
1490 my $error = $self->replace;
1492 $dbh->rollback if $oldAutoCommit;
1496 foreach my $cdr_termination ( $self->cdr_termination ) {
1497 #$cdr_termination->status('');
1498 #$error = $cdr_termination->replace;
1499 $error = $cdr_termination->delete;
1501 $dbh->rollback if $oldAutoCommit;
1506 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1511 =item import_formats
1513 Returns an ordered list of key value pairs containing import format names
1514 as keys (for use with batch_import) and "pretty" format names as values.
1518 #false laziness w/part_pkg & part_export
1521 foreach my $INC ( @INC ) {
1522 warn "globbing $INC/FS/cdr/*.pm\n" if $DEBUG;
1523 foreach my $file ( glob("$INC/FS/cdr/*.pm") ) {
1524 warn "attempting to load CDR format info from $file\n" if $DEBUG;
1525 $file =~ /\/(\w+)\.pm$/ or do {
1526 warn "unrecognized file in $INC/FS/cdr/: $file\n";
1530 my $info = eval "use FS::cdr::$mod; ".
1531 "\\%FS::cdr::$mod\::info;";
1533 die "error using FS::cdr::$mod (skipping): $@\n" if $@;
1536 unless ( keys %$info ) {
1537 warn "no %info hash found in FS::cdr::$mod, skipping\n";
1540 warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
1541 if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1542 warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
1545 $cdr_info{$mod} = $info;
1549 tie my %import_formats, 'Tie::IxHash',
1550 map { $_ => $cdr_info{$_}->{'name'} }
1551 sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
1552 grep { exists($cdr_info{$_}->{'import_fields'}) }
1555 sub import_formats {
1559 sub _cdr_min_parser_maker {
1561 my @fields = ref($field) ? @$field : ($field);
1562 @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
1564 my( $cdr, $min ) = @_;
1565 my $sec = eval { _cdr_min_parse($min) };
1566 die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
1567 $cdr->$_($sec) foreach @fields;
1571 sub _cdr_min_parse {
1573 sprintf('%.0f', $min * 60 );
1576 sub _cdr_date_parser_maker {
1579 my @fields = ref($field) ? @$field : ($field);
1581 my( $cdr, $datestring ) = @_;
1582 my $unixdate = eval { _cdr_date_parse($datestring, %options) };
1583 die "error parsing date for @fields from $datestring: $@\n" if $@;
1584 $cdr->$_($unixdate) foreach @fields;
1588 sub _cdr_date_parse {
1592 return '' unless length($date); #that's okay, it becomes NULL
1593 return '' if $date eq 'NA'; #sansay
1595 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 ) {
1596 my $time = str2time($date);
1597 return $time if $time > 100000; #just in case
1600 my($year, $mon, $day, $hour, $min, $sec);
1602 #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
1603 #taqua #2007-10-31 08:57:24.113000000
1605 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|$)/ ) {
1606 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1607 } 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|$)/ ) {
1608 # 8/26/2010 12:20:01
1609 # optionally without seconds
1610 ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1611 $sec = 0 if !defined($sec);
1612 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d+\.\d+)(\D|$)/ ) {
1613 # broadsoft: 20081223201938.314
1614 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1615 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\d+(\D|$)/ ) {
1616 # Taqua OM: 20050422203450943
1617 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1618 } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) {
1619 # WIP: 20100329121420
1620 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1621 } elsif ( $date =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z$/) {
1623 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
1626 die "unparsable date: $date"; #maybe we shouldn't die...
1629 return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
1630 && $hour == 0 && $min == 0 && $sec == 0;
1632 if ($options{gmt}) {
1633 timegm($sec, $min, $hour, $day, $mon-1, $year);
1635 timelocal($sec, $min, $hour, $day, $mon-1, $year);
1639 =item batch_import HASHREF
1641 Imports CDR records. Available options are:
1653 Hash reference of preset fields, typically cdrbatch
1657 Set true to prevent throwing an error on empty imports
1663 my %import_options = (
1666 'batch_keycol' => 'cdrbatchnum',
1667 'batch_table' => 'cdr_batch',
1668 'batch_namecol' => 'cdrbatch',
1670 'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
1674 #drop the || 'csv' to allow auto xls for csv types?
1675 'format_types' => { map { $_ => lc($cdr_info{$_}->{'type'} || 'csv'); }
1679 'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
1683 'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
1687 'format_fixedlength_formats' =>
1688 { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
1692 'format_xml_formats' =>
1693 { map { $_ => $cdr_info{$_}->{'xml_format'}; }
1697 'format_asn_formats' =>
1698 { map { $_ => $cdr_info{$_}->{'asn_format'}; }
1702 'format_row_callbacks' =>
1703 { map { $_ => $cdr_info{$_}->{'row_callback'}; }
1707 'format_parser_opts' =>
1708 { map { $_ => $cdr_info{$_}->{'parser_opt'}; }
1713 sub _import_options {
1720 my $iopt = _import_options;
1721 $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
1723 if ( defined $opt->{'cdrtypenum'} ) {
1724 $opt->{'preinsert_callback'} = sub {
1725 my($record,$param) = (shift,shift);
1726 $record->cdrtypenum($opt->{'cdrtypenum'});
1731 FS::Record::batch_import( $opt );
1735 =item process_batch_import
1739 sub process_batch_import {
1742 my $opt = _import_options;
1743 # $opt->{'params'} = [ 'format', 'cdrbatch' ];
1745 FS::Record::process_batch_import( $job, $opt, @_ );
1748 # if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
1749 # @columns = map { s/^ +//; $_; } @columns;
1754 # Used by FS::Upgrade to migrate to a new database.
1757 my ($class, %opts) = @_;
1759 warn "$me upgrading $class\n" if $DEBUG;
1761 my $sth = dbh->prepare(
1762 'SELECT DISTINCT(cdrbatch) FROM cdr WHERE cdrbatch IS NOT NULL'
1763 ) or die dbh->errstr;
1765 $sth->execute or die $sth->errstr;
1767 my %cdrbatchnum = ();
1768 while (my $row = $sth->fetchrow_arrayref) {
1770 my $cdr_batch = qsearchs( 'cdr_batch', { 'cdrbatch' => $row->[0] } );
1771 unless ( $cdr_batch ) {
1772 $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] };
1773 my $error = $cdr_batch->insert;
1774 die $error if $error;
1777 $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum;
1780 $sth = dbh->prepare('UPDATE cdr SET cdrbatch = NULL, cdrbatchnum = ? WHERE cdrbatch IS NOT NULL AND cdrbatch = ?') or die dbh->errstr;
1782 foreach my $cdrbatch (keys %cdrbatchnum) {
1783 $sth->execute($cdrbatchnum{$cdrbatch}, $cdrbatch) or die $sth->errstr;
1788 =item ip_addr_sql FIELD RANGE
1790 Returns an SQL condition to search for CDRs with an IP address
1791 within RANGE. FIELD is either 'src_ip_addr' or 'dst_ip_addr'. RANGE
1792 should be in the form "a.b.c.d-e.f.g.h' (dotted quads), where any of
1793 the leftmost octets of the second address can be omitted if they're
1794 the same as the first address.
1800 my ($field, $range) = @_;
1801 $range =~ /^[\d\.-]+$/ or die "bad ip address range '$range'";
1802 my @r = split('-', $range);
1803 my @saddr = split('\.', $r[0] || '');
1804 my @eaddr = split('\.', $r[1] || '');
1805 unshift @eaddr, (undef) x (4 - scalar @eaddr);
1807 $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
1809 "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
1810 "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
1819 L<FS::Record>, schema.html from the base documentation.