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 );
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_date_parser_maker {
553 my( $cdr, $date ) = @_;
554 #$cdr->$field( _cdr_date_parse($date) );
555 eval { $cdr->$field( _cdr_date_parse($date) ); };
556 die "error parsing date for $field from $date: $@\n" if $@;
560 sub _cdr_date_parse {
563 return '' unless length($date); #that's okay, it becomes NULL
565 my($year, $mon, $day, $hour, $min, $sec);
567 #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
568 #taqua #2007-10-31 08:57:24.113000000
570 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|$)/ ) {
571 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
572 } 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|$)/ ) {
573 ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
575 die "unparsable date: $date"; #maybe we shouldn't die...
578 return '' if $year == 1900 && $mon == 1 && $day == 1
579 && $hour == 0 && $min == 0 && $sec == 0;
581 timelocal($sec, $min, $hour, $day, $mon-1, $year);
584 =item batch_import HASHREF
586 Imports CDR records. Available options are:
601 my $fh = $param->{filehandle};
602 my $format = $param->{format};
604 return "Unknown format $format"
605 unless exists( $cdr_info{$format} )
606 && exists( $cdr_info{$format}->{'import_fields'} );
608 my $info = $cdr_info{$format};
610 my $type = exists($info->{'type'}) ? lc($info->{'type'}) : 'csv';
613 if ( $type eq 'csv' ) {
614 eval "use Text::CSV_XS;";
616 my $parser = new Text::CSV_XS;
617 } elsif ( $type eq 'fixedlength' ) {
618 eval "use Parse::FixedLength;";
620 my $parser = new Parse::FixedLength $info->{'fixedlength_format'};
622 die "Unknown CDR format type $type for format $format\n";
628 local $SIG{HUP} = 'IGNORE';
629 local $SIG{INT} = 'IGNORE';
630 local $SIG{QUIT} = 'IGNORE';
631 local $SIG{TERM} = 'IGNORE';
632 local $SIG{TSTP} = 'IGNORE';
633 local $SIG{PIPE} = 'IGNORE';
635 my $oldAutoCommit = $FS::UID::AutoCommit;
636 local $FS::UID::AutoCommit = 0;
639 my $header_lines = exists($info->{'header'}) ? $info->{'header'} : 0;
642 while ( defined($line=<$fh>) ) {
644 next if $header_lines-- > 0; #&& $line =~ /^[\w, "]+$/
647 if ( $type eq 'csv' ) {
649 $parser->parse($line) or do {
650 $dbh->rollback if $oldAutoCommit;
651 return "can't parse: ". $parser->error_input();
654 @columns = $parser->fields();
656 } elsif ( $type eq 'fixedlength' ) {
658 @columns = $parser->parse($line);
661 die "Unknown CDR format type $type for format $format\n";
664 #warn join('-',@columns);
666 if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
667 @columns = map { s/^ +//; $_; } @columns;
674 my $field_or_sub = $_;
675 if ( ref($field_or_sub) ) {
676 push @later, $field_or_sub, shift(@columns);
679 ( $field_or_sub => shift @columns );
683 @{ $info->{'import_fields'} }
686 my $cdr = new FS::cdr ( \%cdr );
688 while ( scalar(@later) ) {
689 my $sub = shift @later;
690 my $data = shift @later;
691 &{$sub}($cdr, $data); # $cdr->&{$sub}($data);
694 if ( $format eq 'taqua' ) { #should be a callback or opt in FS::cdr::taqua
695 if ( $cdr->enddate && $cdr->startdate ) { #a bit more?
696 $cdr->duration( $cdr->enddate - $cdr->startdate );
698 if ( $cdr->enddate && $cdr->answerdate ) { #a bit more?
699 $cdr->billsec( $cdr->enddate - $cdr->answerdate );
703 my $error = $cdr->insert;
705 $dbh->rollback if $oldAutoCommit;
715 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
717 #might want to disable this if we skip records for any reason...
718 return "Empty file!" unless $imported;
730 L<FS::Record>, schema.html from the base documentation.