4 use vars qw( @ISA @EXPORT_OK $DEBUG );
10 use FS::UID qw( dbh );
11 use FS::Record qw( qsearch qsearchs );
15 use FS::cdr_upstream_rate;
17 @ISA = qw(FS::Record);
18 @EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker );
24 FS::cdr - Object methods for cdr records
30 $record = new FS::cdr \%hash;
31 $record = new FS::cdr { 'column' => 'value' };
33 $error = $record->insert;
35 $error = $new_record->replace($old_record);
37 $error = $record->delete;
39 $error = $record->check;
43 An FS::cdr object represents an Call Data Record, typically from a telephony
44 system or provider of some sort. FS::cdr inherits from FS::Record. The
45 following fields are currently supported:
49 =item acctid - primary key
51 =item calldate - Call timestamp (SQL timestamp)
53 =item clid - Caller*ID with text
55 =item src - Caller*ID number / Source number
57 =item dst - Destination extension
59 =item dcontext - Destination context
61 =item channel - Channel used
63 =item dstchannel - Destination channel if appropriate
65 =item lastapp - Last application if appropriate
67 =item lastdata - Last application data
69 =item startdate - Start of call (UNIX-style integer timestamp)
71 =item answerdate - Answer time of call (UNIX-style integer timestamp)
73 =item enddate - End time of call (UNIX-style integer timestamp)
75 =item duration - Total time in system, in seconds
77 =item billsec - Total time call is up, in seconds
79 =item disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
81 =item amaflags - What flags to use: BILL, IGNORE etc, specified on a per channel basis like accountcode.
85 #ignore the "omit" and "documentation" AMAs??
86 #AMA = Automated Message Accounting.
87 #default: Sets the system default.
88 #omit: Do not record calls.
89 #billing: Mark the entry for billing
90 #documentation: Mark the entry for documentation.
92 =item accountcode - CDR account number to use: account
94 =item uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
96 =item userfield - CDR user-defined field
98 =item cdr_type - CDR type - see L<FS::cdr_type> (Usage = 1, S&E = 7, OC&C = 8)
100 =item charged_party - Service number to be billed
102 =item upstream_currency - Wholesale currency from upstream
104 =item upstream_price - Wholesale price from upstream
106 =item upstream_rateplanid - Upstream rate plan ID
108 =item rated_price - Rated (or re-rated) price
110 =item distance - km (need units field?)
112 =item islocal - Local - 1, Non Local = 0
114 =item calltypenum - Type of call - see L<FS::cdr_calltype>
116 =item description - Description (cdr_type 7&8 only) (used for cust_bill_pkg.itemdesc)
118 =item quantity - Number of items (cdr_type 7&8 only)
120 =item carrierid - Upstream Carrier ID (see L<FS::cdr_carrier>)
124 #Telstra =1, Optus = 2, RSL COM = 3
126 =item upstream_rateid - Upstream Rate ID
128 =item svcnum - Link to customer service (see L<FS::cust_svc>)
130 =item freesidestatus - NULL, done (or something)
140 Creates a new CDR. To add the CDR to the database, see L<"insert">.
142 Note that this stores the hash reference, not a distinct copy of the hash it
143 points to. You can ask the object for a copy with the I<hash> method.
147 # the new method can be inherited from FS::Record, if a table method is defined
153 Adds this record to the database. If there is an error, returns the error,
154 otherwise returns false.
158 # the insert method can be inherited from FS::Record
162 Delete this record from the database.
166 # the delete method can be inherited from FS::Record
168 =item replace OLD_RECORD
170 Replaces the OLD_RECORD with this one in the database. If there is an error,
171 returns the error, otherwise returns false.
175 # the replace method can be inherited from FS::Record
179 Checks all fields to make sure this is a valid CDR. If there is
180 an error, returns the error, otherwise returns false. Called by the insert
183 Note: Unlike most types of records, we don't want to "reject" a CDR and we want
184 to process them as quickly as possible, so we allow the database to check most
192 # we don't want to "reject" a CDR like other sorts of input...
194 # $self->ut_numbern('acctid')
195 ## || $self->ut_('calldate')
196 # || $self->ut_text('clid')
197 # || $self->ut_text('src')
198 # || $self->ut_text('dst')
199 # || $self->ut_text('dcontext')
200 # || $self->ut_text('channel')
201 # || $self->ut_text('dstchannel')
202 # || $self->ut_text('lastapp')
203 # || $self->ut_text('lastdata')
204 # || $self->ut_numbern('startdate')
205 # || $self->ut_numbern('answerdate')
206 # || $self->ut_numbern('enddate')
207 # || $self->ut_number('duration')
208 # || $self->ut_number('billsec')
209 # || $self->ut_text('disposition')
210 # || $self->ut_number('amaflags')
211 # || $self->ut_text('accountcode')
212 # || $self->ut_text('uniqueid')
213 # || $self->ut_text('userfield')
214 # || $self->ut_numbern('cdrtypenum')
215 # || $self->ut_textn('charged_party')
216 ## || $self->ut_n('upstream_currency')
217 ## || $self->ut_n('upstream_price')
218 # || $self->ut_numbern('upstream_rateplanid')
219 ## || $self->ut_n('distance')
220 # || $self->ut_numbern('islocal')
221 # || $self->ut_numbern('calltypenum')
222 # || $self->ut_textn('description')
223 # || $self->ut_numbern('quantity')
224 # || $self->ut_numbern('carrierid')
225 # || $self->ut_numbern('upstream_rateid')
226 # || $self->ut_numbern('svcnum')
227 # || $self->ut_textn('freesidestatus')
229 # return $error if $error;
231 $self->calldate( $self->startdate_sql )
232 if !$self->calldate && $self->startdate;
234 unless ( $self->charged_party ) {
235 if ( $self->dst =~ /^(\+?1)?8[02-8]{2}/ ) {
236 $self->charged_party($self->dst);
238 $self->charged_party($self->src);
242 #check the foreign keys even?
243 #do we want to outright *reject* the CDR?
245 $self->ut_numbern('acctid')
247 #Usage = 1, S&E = 7, OC&C = 8
248 || $self->ut_foreign_keyn('cdrtypenum', 'cdr_type', 'cdrtypenum' )
250 #the big list in appendix 2
251 || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
253 # Telstra =1, Optus = 2, RSL COM = 3
254 || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
256 return $error if $error;
261 =item set_status_and_rated_price STATUS [ RATED_PRICE ]
263 Sets the status to the provided string. If there is an error, returns the
264 error, otherwise returns false.
268 sub set_status_and_rated_price {
269 my($self, $status, $rated_price) = @_;
270 $self->freesidestatus($status);
271 $self->rated_price($rated_price);
277 Parses the calldate in SQL string format and returns a UNIX timestamp.
282 str2time(shift->calldate);
287 Parses the startdate in UNIX timestamp format and returns a string in SQL
293 my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
296 "$year-$mon-$mday $hour:$min:$sec";
301 Returns the FS::cdr_carrier object associated with this CDR, or false if no
302 carrierid is defined.
306 my %carrier_cache = ();
310 return '' unless $self->carrierid;
311 $carrier_cache{$self->carrierid} ||=
312 qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
317 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
318 no FS::cdr_carrier object is assocated with this CDR.
324 my $cdr_carrier = $self->cdr_carrier;
325 $cdr_carrier ? $cdr_carrier->carriername : '';
330 Returns the FS::cdr_calltype object associated with this CDR, or false if no
331 calltypenum is defined.
335 my %calltype_cache = ();
339 return '' unless $self->calltypenum;
340 $calltype_cache{$self->calltypenum} ||=
341 qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
346 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
347 no FS::cdr_calltype object is assocated with this CDR.
353 my $cdr_calltype = $self->cdr_calltype;
354 $cdr_calltype ? $cdr_calltype->calltypename : '';
357 =item cdr_upstream_rate
359 Returns the upstream rate mapping (see L<FS::cdr_upstream_rate>), or the empty
360 string if no FS::cdr_upstream_rate object is associated with this CDR.
364 sub cdr_upstream_rate {
366 return '' unless $self->upstream_rateid;
367 qsearchs('cdr_upstream_rate', { 'upstream_rateid' => $self->upstream_rateid })
371 =item _convergent_format COLUMN [ COUNTRYCODE ]
373 Returns the number in COLUMN formatted as follows:
375 If the country code does not match COUNTRYCODE (default "61"), it is returned
378 If the country code does match COUNTRYCODE (default "61"), it is removed. In
379 addiiton, "0" is prepended unless the number starts with 13, 18 or 19. (???)
383 sub _convergent_format {
384 my( $self, $field ) = ( shift, shift );
385 my $countrycode = scalar(@_) ? shift : '61'; #+61 = australia
386 #my $number = $self->$field();
387 my $number = $self->get($field);
388 #if ( $number =~ s/^(\+|011)$countrycode// ) {
389 if ( $number =~ s/^\+$countrycode// ) {
391 unless $number =~ /^1[389]/; #???
396 =item downstream_csv [ OPTION => VALUE, ... ]
402 'simple' => { 'name' => 'Simple',
404 "Date,Time,Name,Destination,Duration,Price",
406 'simple2' => { 'name' => 'Simple with source',
408 #"Date,Time,Name,Called From,Destination,Duration,Price",
409 "Date,Time,Called From,Destination,Duration,Price",
413 my %export_formats = (
415 'carriername', #CARRIER
416 sub { shift->_convergent_format('src') }, #SERVICE_NUMBER
417 sub { shift->_convergent_format('charged_party') }, #CHARGED_NUMBER
418 sub { time2str('%Y-%m-%d', shift->calldate_unix ) }, #DATE
419 sub { time2str('%T', shift->calldate_unix ) }, #TIME
420 'billsec', #'duration', #DURATION
421 sub { shift->_convergent_format('dst') }, #NUMBER_DIALED
422 '', #XXX add (from prefixes in most recent email) #FROM_DESC
423 '', #XXX add (from prefixes in most recent email) #TO_DESC
424 'calltypename', #CLASS_CODE
425 'rated_price', #PRICE
426 sub { shift->rated_price ? 'Y' : 'N' }, #RATED
430 sub { time2str('%D', shift->calldate_unix ) }, #DATE
431 sub { time2str('%r', shift->calldate_unix ) }, #TIME
433 'dst', #NUMBER_DIALED
434 sub { sprintf('%.2fm', shift->billsec / 60 ) }, #DURATION
435 sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
438 sub { time2str('%D', shift->calldate_unix ) }, #DATE
439 sub { time2str('%r', shift->calldate_unix ) }, #TIME
441 'dst', #NUMBER_DIALED
443 sub { sprintf('%.2fm', shift->billsec / 60 ) }, #DURATION
444 sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
449 my( $self, %opt ) = @_;
451 my $format = $opt{'format'}; # 'convergent';
452 return "Unknown format $format" unless exists $export_formats{$format};
454 eval "use Text::CSV_XS;";
456 my $csv = new Text::CSV_XS;
460 ref($_) ? &{$_}($self) : $self->$_();
462 @{ $export_formats{$format} };
464 my $status = $csv->combine(@columns);
465 die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
478 =item invoice_formats
480 Returns an ordered list of key value pairs containing invoice format names
481 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
485 sub invoice_formats {
486 map { ($_ => $export_names{$_}->{'name'}) }
487 grep { $export_names{$_}->{'invoice_header'} }
491 =item invoice_header FORMAT
493 Returns a scalar containing the CSV column header for invoice format FORMAT.
499 $export_names{$format}->{'invoice_header'};
504 Returns an ordered list of key value pairs containing import format names
505 as keys (for use with batch_import) and "pretty" format names as values.
509 #false laziness w/part_pkg & part_export
512 foreach my $INC ( @INC ) {
513 warn "globbing $INC/FS/cdr/*.pm\n" if $DEBUG;
514 foreach my $file ( glob("$INC/FS/cdr/*.pm") ) {
515 warn "attempting to load CDR format info from $file\n" if $DEBUG;
516 $file =~ /\/(\w+)\.pm$/ or do {
517 warn "unrecognized file in $INC/FS/cdr/: $file\n";
521 my $info = eval "use FS::cdr::$mod; ".
522 "\\%FS::cdr::$mod\::info;";
524 die "error using FS::cdr::$mod (skipping): $@\n" if $@;
527 unless ( keys %$info ) {
528 warn "no %info hash found in FS::cdr::$mod, skipping\n";
531 warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
532 if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
533 warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
536 $cdr_info{$mod} = $info;
540 tie my %import_formats, 'Tie::IxHash',
541 map { $_ => $cdr_info{$_}->{'name'} }
542 sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
543 grep { exists($cdr_info{$_}->{'import_fields'}) }
550 sub _cdr_min_parser_maker {
552 my @fields = ref($field) ? @$field : ($field);
553 @fields = qw( billsec duration ) unless scalar(@fields);
555 my( $cdr, $min ) = @_;
556 my $sec = eval { _cdr_min_parse($min) };
557 die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
558 $cdr->$_($sec) foreach @fields;
564 sprintf('%.0f', $min * 60 );
567 sub _cdr_date_parser_maker {
570 my( $cdr, $date ) = @_;
571 #$cdr->$field( _cdr_date_parse($date) );
572 eval { $cdr->$field( _cdr_date_parse($date) ); };
573 die "error parsing date for $field from $date: $@\n" if $@;
577 sub _cdr_date_parse {
580 return '' unless length($date); #that's okay, it becomes NULL
582 my($year, $mon, $day, $hour, $min, $sec);
584 #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
585 #taqua #2007-10-31 08:57:24.113000000
587 if ( $date =~ /^\s*(\d{4})\D(\d{1,2})\D(\d{1,2})\s+(\d{1,2})\D(\d{1,2})\D(\d{1,2})(\D|$)/ ) {
588 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
589 } 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|$)/ ) {
590 ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
592 die "unparsable date: $date"; #maybe we shouldn't die...
595 return '' if $year == 1900 && $mon == 1 && $day == 1
596 && $hour == 0 && $min == 0 && $sec == 0;
598 timelocal($sec, $min, $hour, $day, $mon-1, $year);
601 =item batch_import HASHREF
603 Imports CDR records. Available options are:
618 my $fh = $param->{filehandle};
619 my $format = $param->{format};
621 return "Unknown format $format"
622 unless exists( $cdr_info{$format} )
623 && exists( $cdr_info{$format}->{'import_fields'} );
625 my $info = $cdr_info{$format};
627 my $type = exists($info->{'type'}) ? lc($info->{'type'}) : 'csv';
630 if ( $type eq 'csv' ) {
631 eval "use Text::CSV_XS;";
633 $parser = new Text::CSV_XS;
634 } elsif ( $type eq 'fixedlength' ) {
635 eval "use Parse::FixedLength;";
637 $parser = new Parse::FixedLength $info->{'fixedlength_format'};
639 die "Unknown CDR format type $type for format $format\n";
645 local $SIG{HUP} = 'IGNORE';
646 local $SIG{INT} = 'IGNORE';
647 local $SIG{QUIT} = 'IGNORE';
648 local $SIG{TERM} = 'IGNORE';
649 local $SIG{TSTP} = 'IGNORE';
650 local $SIG{PIPE} = 'IGNORE';
652 my $oldAutoCommit = $FS::UID::AutoCommit;
653 local $FS::UID::AutoCommit = 0;
656 my $header_lines = exists($info->{'header'}) ? $info->{'header'} : 0;
659 while ( defined($line=<$fh>) ) {
661 next if $header_lines-- > 0; #&& $line =~ /^[\w, "]+$/
664 if ( $type eq 'csv' ) {
666 $parser->parse($line) or do {
667 $dbh->rollback if $oldAutoCommit;
668 return "can't parse: ". $parser->error_input();
671 @columns = $parser->fields();
673 } elsif ( $type eq 'fixedlength' ) {
675 @columns = $parser->parse($line);
678 die "Unknown CDR format type $type for format $format\n";
681 #warn join('-',@columns);
683 if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
684 @columns = map { s/^ +//; $_; } @columns;
691 my $field_or_sub = $_;
692 if ( ref($field_or_sub) ) {
693 push @later, $field_or_sub, shift(@columns);
696 ( $field_or_sub => shift @columns );
700 @{ $info->{'import_fields'} }
703 my $cdr = new FS::cdr ( \%cdr );
705 while ( scalar(@later) ) {
706 my $sub = shift @later;
707 my $data = shift @later;
708 &{$sub}($cdr, $data); # $cdr->&{$sub}($data);
711 if ( $format eq 'taqua' ) { #should be a callback or opt in FS::cdr::taqua
712 if ( $cdr->enddate && $cdr->startdate ) { #a bit more?
713 $cdr->duration( $cdr->enddate - $cdr->startdate );
715 if ( $cdr->enddate && $cdr->answerdate ) { #a bit more?
716 $cdr->billsec( $cdr->enddate - $cdr->answerdate );
720 my $error = $cdr->insert;
722 $dbh->rollback if $oldAutoCommit;
732 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
734 #might want to disable this if we skip records for any reason...
735 return "Empty file!" unless $imported;
747 L<FS::Record>, schema.html from the base documentation.