FS/FS/cdr.pm

   1 package FS::cdr;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK $DEBUG );
   5 use Exporter;
   6 use Tie::IxHash;
   7 use Date::Parse;
   8 use Date::Format;
   9 use Time::Local;
  10 use FS::UID qw( dbh );
  11 use FS::Conf;
  12 use FS::Record qw( qsearch qsearchs );
  13 use FS::cdr_type;
  14 use FS::cdr_calltype;
  15 use FS::cdr_carrier;
  16 use FS::cdr_upstream_rate;
  17
  18 @ISA = qw(FS::Record);
  19 @EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker );
  20
  21 $DEBUG = 0;
  22
  23 =head1 NAME
  24
  25 FS::cdr - Object methods for cdr records
  26
  27 =head1 SYNOPSIS
  28
  29   use FS::cdr;
  30
  31   $record = new FS::cdr \%hash;
  32   $record = new FS::cdr { 'column' => 'value' };
  33
  34   $error = $record->insert;
  35
  36   $error = $new_record->replace($old_record);
  37
  38   $error = $record->delete;
  39
  40   $error = $record->check;
  41
  42 =head1 DESCRIPTION
  43
  44 An FS::cdr object represents an Call Data Record, typically from a telephony
  45 system or provider of some sort.  FS::cdr inherits from FS::Record.  The
  46 following fields are currently supported:
  47
  48 =over 4
  49
  50 =item acctid - primary key
  51
  52 =item calldate - Call timestamp (SQL timestamp)
  53
  54 =item clid - Caller*ID with text
  55
  56 =item src - Caller*ID number / Source number
  57
  58 =item dst - Destination extension
  59
  60 =item dcontext - Destination context
  61
  62 =item channel - Channel used
  63
  64 =item dstchannel - Destination channel if appropriate
  65
  66 =item lastapp - Last application if appropriate
  67
  68 =item lastdata - Last application data
  69
  70 =item startdate - Start of call (UNIX-style integer timestamp)
  71
  72 =item answerdate - Answer time of call (UNIX-style integer timestamp)
  73
  74 =item enddate - End time of call (UNIX-style integer timestamp)
  75
  76 =item duration - Total time in system, in seconds
  77
  78 =item billsec - Total time call is up, in seconds
  79
  80 =item disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
  81
  82 =item amaflags - What flags to use: BILL, IGNORE etc, specified on a per channel basis like accountcode.
  83
  84 =cut
  85
  86   #ignore the "omit" and "documentation" AMAs??
  87   #AMA = Automated Message Accounting.
  88   #default: Sets the system default.
  89   #omit: Do not record calls.
  90   #billing: Mark the entry for billing
  91   #documentation: Mark the entry for documentation.
  92
  93 =item accountcode - CDR account number to use: account
  94
  95 =item uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
  96
  97 =item userfield - CDR user-defined field
  98
  99 =item cdr_type - CDR type - see L<FS::cdr_type> (Usage = 1, S&E = 7, OC&C = 8)
 100
 101 =item charged_party - Service number to be billed
 102
 103 =item upstream_currency - Wholesale currency from upstream
 104
 105 =item upstream_price - Wholesale price from upstream
 106
 107 =item upstream_rateplanid - Upstream rate plan ID
 108
 109 =item rated_price - Rated (or re-rated) price
 110
 111 =item distance - km (need units field?)
 112
 113 =item islocal - Local - 1, Non Local = 0
 114
 115 =item calltypenum - Type of call - see L<FS::cdr_calltype>
 116
 117 =item description - Description (cdr_type 7&8 only) (used for cust_bill_pkg.itemdesc)
 118
 119 =item quantity - Number of items (cdr_type 7&8 only)
 120
 121 =item carrierid - Upstream Carrier ID (see L<FS::cdr_carrier>)
 122
 123 =cut
 124
 125 #Telstra =1, Optus = 2, RSL COM = 3
 126
 127 =item upstream_rateid - Upstream Rate ID
 128
 129 =item svcnum - Link to customer service (see L<FS::cust_svc>)
 130
 131 =item freesidestatus - NULL, done (or something)
 132
 133 =item freesiderewritestatus - NULL, done (or something)
 134
 135 =item cdrbatch
 136
 137 =back
 138
 139 =head1 METHODS
 140
 141 =over 4
 142
 143 =item new HASHREF
 144
 145 Creates a new CDR.  To add the CDR to the database, see L<"insert">.
 146
 147 Note that this stores the hash reference, not a distinct copy of the hash it
 148 points to.  You can ask the object for a copy with the I<hash> method.
 149
 150 =cut
 151
 152 # the new method can be inherited from FS::Record, if a table method is defined
 153
 154 sub table { 'cdr'; }
 155
 156 sub table_info {
 157   {
 158     'fields' => {
 159 #XXX fill in some (more) nice names
 160         #'acctid'                => '',
 161         'calldate'              => 'Call date',
 162         'clid'                  => 'Caller ID',
 163         'src'                   => 'Source',
 164         'dst'                   => 'Destination',
 165         'dcontext'              => 'Dest. context',
 166         'channel'               => 'Channel',
 167         'dstchannel'            => 'Destination channel',
 168         #'lastapp'               => '',
 169         #'lastdata'              => '',
 170         'startdate'             => 'Start date',
 171         'answerdate'            => 'Answer date',
 172         'enddate'               => 'End date',
 173         'duration'              => 'Duration',
 174         'billsec'               => 'Billable seconds',
 175         'disposition'           => 'Disposition',
 176         'amaflags'              => 'AMA flags',
 177         'accountcode'           => 'Account code',
 178         #'uniqueid'              => '',
 179         'userfield'             => 'User field',
 180         #'cdrtypenum'            => '',
 181         'charged_party'         => 'Charged party',
 182         #'upstream_currency'     => '',
 183         'upstream_price'        => 'Upstream price',
 184         #'upstream_rateplanid'   => '',
 185         #'ratedetailnum'         => '',
 186         'rated_price'           => 'Rated price',
 187         #'distance'              => '',
 188         #'islocal'               => '',
 189         #'calltypenum'           => '',
 190         #'description'           => '',
 191         #'quantity'              => '',
 192         'carrierid'             => 'Carrier ID',
 193         #'upstream_rateid'       => '',
 194         'svcnum'                => 'Freeside service',
 195         'freesidestatus'        => 'Freeside status',
 196         'freesiderewritestatus' => 'Freeside rewrite status',
 197         'cdrbatch'              => 'Batch',
 198     },
 199
 200   };
 201
 202 }
 203
 204 =item insert
 205
 206 Adds this record to the database.  If there is an error, returns the error,
 207 otherwise returns false.
 208
 209 =cut
 210
 211 # the insert method can be inherited from FS::Record
 212
 213 =item delete
 214
 215 Delete this record from the database.
 216
 217 =cut
 218
 219 # the delete method can be inherited from FS::Record
 220
 221 =item replace OLD_RECORD
 222
 223 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 224 returns the error, otherwise returns false.
 225
 226 =cut
 227
 228 # the replace method can be inherited from FS::Record
 229
 230 =item check
 231
 232 Checks all fields to make sure this is a valid CDR.  If there is
 233 an error, returns the error, otherwise returns false.  Called by the insert
 234 and replace methods.
 235
 236 Note: Unlike most types of records, we don't want to "reject" a CDR and we want
 237 to process them as quickly as possible, so we allow the database to check most
 238 of the data.
 239
 240 =cut
 241
 242 sub check {
 243   my $self = shift;
 244
 245 # we don't want to "reject" a CDR like other sorts of input...
 246 #  my $error =
 247 #    $self->ut_numbern('acctid')
 248 ##    || $self->ut_('calldate')
 249 #    || $self->ut_text('clid')
 250 #    || $self->ut_text('src')
 251 #    || $self->ut_text('dst')
 252 #    || $self->ut_text('dcontext')
 253 #    || $self->ut_text('channel')
 254 #    || $self->ut_text('dstchannel')
 255 #    || $self->ut_text('lastapp')
 256 #    || $self->ut_text('lastdata')
 257 #    || $self->ut_numbern('startdate')
 258 #    || $self->ut_numbern('answerdate')
 259 #    || $self->ut_numbern('enddate')
 260 #    || $self->ut_number('duration')
 261 #    || $self->ut_number('billsec')
 262 #    || $self->ut_text('disposition')
 263 #    || $self->ut_number('amaflags')
 264 #    || $self->ut_text('accountcode')
 265 #    || $self->ut_text('uniqueid')
 266 #    || $self->ut_text('userfield')
 267 #    || $self->ut_numbern('cdrtypenum')
 268 #    || $self->ut_textn('charged_party')
 269 ##    || $self->ut_n('upstream_currency')
 270 ##    || $self->ut_n('upstream_price')
 271 #    || $self->ut_numbern('upstream_rateplanid')
 272 ##    || $self->ut_n('distance')
 273 #    || $self->ut_numbern('islocal')
 274 #    || $self->ut_numbern('calltypenum')
 275 #    || $self->ut_textn('description')
 276 #    || $self->ut_numbern('quantity')
 277 #    || $self->ut_numbern('carrierid')
 278 #    || $self->ut_numbern('upstream_rateid')
 279 #    || $self->ut_numbern('svcnum')
 280 #    || $self->ut_textn('freesidestatus')
 281 #    || $self->ut_textn('freesiderewritestatus')
 282 #  ;
 283 #  return $error if $error;
 284
 285   $self->calldate( $self->startdate_sql )
 286     if !$self->calldate && $self->startdate;
 287
 288   #was just for $format eq 'taqua' but can't see the harm... add something to
 289   #disable if it becomes a problem
 290   if ( $self->duration eq '' && $self->enddate && $self->startdate ) {
 291     $self->duration( $self->enddate - $self->startdate  );
 292   }
 293   if ( $self->billsec eq '' && $self->enddate && $self->answerdate ) {
 294     $self->billsec(  $self->enddate - $self->answerdate );
 295   }
 296
 297   $self->set_charged_party;
 298
 299   #check the foreign keys even?
 300   #do we want to outright *reject* the CDR?
 301   my $error =
 302        $self->ut_numbern('acctid')
 303
 304   #add a config option to turn these back on if someone needs 'em
 305   #
 306   #  #Usage = 1, S&E = 7, OC&C = 8
 307   #  || $self->ut_foreign_keyn('cdrtypenum',  'cdr_type',     'cdrtypenum' )
 308   #
 309   #  #the big list in appendix 2
 310   #  || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
 311   #
 312   #  # Telstra =1, Optus = 2, RSL COM = 3
 313   #  || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
 314   ;
 315   return $error if $error;
 316
 317   $self->SUPER::check;
 318 }
 319
 320 =item is_tollfree
 321
 322   Returns true when the cdr represents a toll free number and false otherwise.
 323
 324 =cut
 325
 326 sub is_tollfree {
 327   my $self = shift;
 328   ( $self->dst =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0;
 329 }
 330
 331 =item set_charged_party
 332
 333 If the charged_party field is already set, does nothing.  Otherwise:
 334
 335 If the cdr-charged_party-accountcode config option is enabled, sets the
 336 charged_party to the accountcode.
 337
 338 Otherwise sets the charged_party normally: to the src field in most cases,
 339 or to the dst field if it is a toll free number.
 340
 341 =cut
 342
 343 sub set_charged_party {
 344   my $self = shift;
 345
 346   my $conf = new FS::Conf;
 347
 348   unless ( $self->charged_party ) {
 349
 350     if ( $conf->exists('cdr-charged_party-accountcode') && $self->accountcode ){
 351
 352       $self->charged_party( $self->accountcode );
 353
 354     } else {
 355
 356       if ( $self->is_tollfree ) {
 357         $self->charged_party($self->dst);
 358       } else {
 359         $self->charged_party($self->src);
 360       }
 361
 362     }
 363
 364   }
 365
 366 #  my $prefix = $conf->config('cdr-charged_party-truncate_prefix');
 367 #  my $prefix_len = length($prefix);
 368 #  my $trunc_len = $conf->config('cdr-charged_party-truncate_length');
 369 #
 370 #  $self->charged_party( substr($self->charged_party, 0, $trunc_len) )
 371 #    if $prefix_len && $trunc_len
 372 #    && substr($self->charged_party, 0, $prefix_len) eq $prefix;
 373
 374 }
 375
 376 =item set_status_and_rated_price STATUS [ RATED_PRICE ]
 377
 378 Sets the status to the provided string.  If there is an error, returns the
 379 error, otherwise returns false.
 380
 381 =cut
 382
 383 sub set_status_and_rated_price {
 384   my($self, $status, $rated_price) = @_;
 385   $self->freesidestatus($status);
 386   $self->rated_price($rated_price);
 387   $self->replace();
 388 }
 389
 390 =item calldate_unix
 391
 392 Parses the calldate in SQL string format and returns a UNIX timestamp.
 393
 394 =cut
 395
 396 sub calldate_unix {
 397   str2time(shift->calldate);
 398 }
 399
 400 =item startdate_sql
 401
 402 Parses the startdate in UNIX timestamp format and returns a string in SQL
 403 format.
 404
 405 =cut
 406
 407 sub startdate_sql {
 408   my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
 409   $mon++;
 410   $year += 1900;
 411   "$year-$mon-$mday $hour:$min:$sec";
 412 }
 413
 414 =item cdr_carrier
 415
 416 Returns the FS::cdr_carrier object associated with this CDR, or false if no
 417 carrierid is defined.
 418
 419 =cut
 420
 421 my %carrier_cache = ();
 422
 423 sub cdr_carrier {
 424   my $self = shift;
 425   return '' unless $self->carrierid;
 426   $carrier_cache{$self->carrierid} ||=
 427     qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
 428 }
 429
 430 =item carriername
 431
 432 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
 433 no FS::cdr_carrier object is assocated with this CDR.
 434
 435 =cut
 436
 437 sub carriername {
 438   my $self = shift;
 439   my $cdr_carrier = $self->cdr_carrier;
 440   $cdr_carrier ? $cdr_carrier->carriername : '';
 441 }
 442
 443 =item cdr_calltype
 444
 445 Returns the FS::cdr_calltype object associated with this CDR, or false if no
 446 calltypenum is defined.
 447
 448 =cut
 449
 450 my %calltype_cache = ();
 451
 452 sub cdr_calltype {
 453   my $self = shift;
 454   return '' unless $self->calltypenum;
 455   $calltype_cache{$self->calltypenum} ||=
 456     qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
 457 }
 458
 459 =item calltypename
 460
 461 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
 462 no FS::cdr_calltype object is assocated with this CDR.
 463
 464 =cut
 465
 466 sub calltypename {
 467   my $self = shift;
 468   my $cdr_calltype = $self->cdr_calltype;
 469   $cdr_calltype ? $cdr_calltype->calltypename : '';
 470 }
 471
 472 =item cdr_upstream_rate
 473
 474 Returns the upstream rate mapping (see L<FS::cdr_upstream_rate>), or the empty
 475 string if no FS::cdr_upstream_rate object is associated with this CDR.
 476
 477 =cut
 478
 479 sub cdr_upstream_rate {
 480   my $self = shift;
 481   return '' unless $self->upstream_rateid;
 482   qsearchs('cdr_upstream_rate', { 'upstream_rateid' => $self->upstream_rateid })
 483     or '';
 484 }
 485
 486 =item _convergent_format COLUMN [ COUNTRYCODE ]
 487
 488 Returns the number in COLUMN formatted as follows:
 489
 490 If the country code does not match COUNTRYCODE (default "61"), it is returned
 491 unchanged.
 492
 493 If the country code does match COUNTRYCODE (default "61"), it is removed.  In
 494 addiiton, "0" is prepended unless the number starts with 13, 18 or 19. (???)
 495
 496 =cut
 497
 498 sub _convergent_format {
 499   my( $self, $field ) = ( shift, shift );
 500   my $countrycode = scalar(@_) ? shift : '61'; #+61 = australia
 501   #my $number = $self->$field();
 502   my $number = $self->get($field);
 503   #if ( $number =~ s/^(\+|011)$countrycode// ) {
 504   if ( $number =~ s/^\+$countrycode// ) {
 505     $number = "0$number"
 506       unless $number =~ /^1[389]/; #???
 507   }
 508   $number;
 509 }
 510
 511 =item downstream_csv [ OPTION => VALUE, ... ]
 512
 513 =cut
 514
 515 my %export_names = (
 516   'convergent'      => {},
 517   'simple'  => {
 518     'name'           => 'Simple',
 519     'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
 520   },
 521   'simple2' => {
 522     'name'           => 'Simple with source',
 523     'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
 524                        #"Date,Time,Name,Called From,Destination,Duration,Price",
 525   },
 526   'default' => {
 527     'name'           => 'Default',
 528     'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
 529   },
 530   'source_default' => {
 531     'name'           => 'Default with source',
 532     'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
 533   },
 534   'accountcode_default' => {
 535     'name'           => 'Default plus accountcode',
 536     'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
 537   },
 538 );
 539
 540 my $duration_sub = sub {
 541   my($cdr, %opt) = @_;
 542   if ( $opt{minutes} ) {
 543     $opt{minutes}. ( $opt{granularity} ? 'm' : ' call' );
 544   } else {
 545     sprintf('%.2fm', $cdr->billsec / 60 );
 546   }
 547 };
 548
 549 my %export_formats = (
 550   'convergent' => [
 551     'carriername', #CARRIER
 552     sub { shift->_convergent_format('src') }, #SERVICE_NUMBER
 553     sub { shift->_convergent_format('charged_party') }, #CHARGED_NUMBER
 554     sub { time2str('%Y-%m-%d', shift->calldate_unix ) }, #DATE
 555     sub { time2str('%T',       shift->calldate_unix ) }, #TIME
 556     'billsec', #'duration', #DURATION
 557     sub { shift->_convergent_format('dst') }, #NUMBER_DIALED
 558     '', #XXX add (from prefixes in most recent email) #FROM_DESC
 559     '', #XXX add (from prefixes in most recent email) #TO_DESC
 560     'calltypename', #CLASS_CODE
 561     'rated_price', #PRICE
 562     sub { shift->rated_price ? 'Y' : 'N' }, #RATED
 563     '', #OTHER_INFO
 564   ],
 565   'simple' => [
 566     sub { time2str('%D', shift->calldate_unix ) },   #DATE
 567     sub { time2str('%r', shift->calldate_unix ) },   #TIME
 568     'userfield',                                     #USER
 569     'dst',                                           #NUMBER_DIALED
 570     $duration_sub,                                   #DURATION
 571     #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
 572     sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, #PRICE
 573   ],
 574   'simple2' => [
 575     sub { time2str('%D', shift->calldate_unix ) },   #DATE
 576     sub { time2str('%r', shift->calldate_unix ) },   #TIME
 577     #'userfield',                                     #USER
 578     'src',                                           #called from
 579     'dst',                                           #NUMBER_DIALED
 580     $duration_sub,                                   #DURATION
 581     #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
 582     sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, #PRICE
 583   ],
 584   'default' => [
 585
 586     #DATE
 587     sub { time2str('%D', shift->calldate_unix ) },
 588           # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
 589
 590     #TIME
 591     sub { time2str('%r', shift->calldate_unix ) },
 592           # 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
 593
 594     #DEST ("Number")
 595     sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
 596
 597     #REGIONNAME ("Destination")
 598     sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
 599
 600     #DURATION
 601     $duration_sub,
 602
 603     #PRICE
 604     sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; },
 605
 606   ],
 607 );
 608 $export_formats{'source_default'} = [ 'src', @{ $export_formats{'default'} }, ];
 609 $export_formats{'accountcode_default'} =
 610   [ @{ $export_formats{'default'} }[0,1],
 611     'accountcode',
 612     @{ $export_formats{'default'} }[2..5],
 613   ];
 614
 615 sub downstream_csv {
 616   my( $self, %opt ) = @_;
 617
 618   my $format = $opt{'format'}; # 'convergent';
 619   return "Unknown format $format" unless exists $export_formats{$format};
 620
 621   #my $conf = new FS::Conf;
 622   #$opt{'money_char'} ||= $conf->config('money_char') || '$';
 623   $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
 624
 625   eval "use Text::CSV_XS;";
 626   die $@ if $@;
 627   my $csv = new Text::CSV_XS;
 628
 629   my @columns =
 630     map {
 631           ref($_) ? &{$_}($self, %opt) : $self->$_();
 632         }
 633     @{ $export_formats{$format} };
 634
 635   my $status = $csv->combine(@columns);
 636   die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
 637     unless $status;
 638
 639   $csv->string;
 640
 641 }
 642
 643 =back
 644
 645 =head1 CLASS METHODS
 646
 647 =over 4
 648
 649 =item invoice_formats
 650
 651 Returns an ordered list of key value pairs containing invoice format names
 652 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
 653
 654 =cut
 655
 656 sub invoice_formats {
 657   map { ($_ => $export_names{$_}->{'name'}) }
 658     grep { $export_names{$_}->{'invoice_header'} }
 659     keys %export_names;
 660 }
 661
 662 =item invoice_header FORMAT
 663
 664 Returns a scalar containing the CSV column header for invoice format FORMAT.
 665
 666 =cut
 667
 668 sub invoice_header {
 669   my $format = shift;
 670   $export_names{$format}->{'invoice_header'};
 671 }
 672
 673 =item import_formats
 674
 675 Returns an ordered list of key value pairs containing import format names
 676 as keys (for use with batch_import) and "pretty" format names as values.
 677
 678 =cut
 679
 680 #false laziness w/part_pkg & part_export
 681
 682 my %cdr_info;
 683 foreach my $INC ( @INC ) {
 684   warn "globbing $INC/FS/cdr/*.pm\n" if $DEBUG;
 685   foreach my $file ( glob("$INC/FS/cdr/*.pm") ) {
 686     warn "attempting to load CDR format info from $file\n" if $DEBUG;
 687     $file =~ /\/(\w+)\.pm$/ or do {
 688       warn "unrecognized file in $INC/FS/cdr/: $file\n";
 689       next;
 690     };
 691     my $mod = $1;
 692     my $info = eval "use FS::cdr::$mod; ".
 693                     "\\%FS::cdr::$mod\::info;";
 694     if ( $@ ) {
 695       die "error using FS::cdr::$mod (skipping): $@\n" if $@;
 696       next;
 697     }
 698     unless ( keys %$info ) {
 699       warn "no %info hash found in FS::cdr::$mod, skipping\n";
 700       next;
 701     }
 702     warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
 703     if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
 704       warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
 705       next;
 706     }
 707     $cdr_info{$mod} = $info;
 708   }
 709 }
 710
 711 tie my %import_formats, 'Tie::IxHash',
 712   map  { $_ => $cdr_info{$_}->{'name'} }
 713   sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
 714   grep { exists($cdr_info{$_}->{'import_fields'}) }
 715   keys %cdr_info;
 716
 717 sub import_formats {
 718   %import_formats;
 719 }
 720
 721 sub _cdr_min_parser_maker {
 722   my $field = shift;
 723   my @fields = ref($field) ? @$field : ($field);
 724   @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
 725   return sub {
 726     my( $cdr, $min ) = @_;
 727     my $sec = eval { _cdr_min_parse($min) };
 728     die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
 729     $cdr->$_($sec) foreach @fields;
 730   };
 731 }
 732
 733 sub _cdr_min_parse {
 734   my $min = shift;
 735   sprintf('%.0f', $min * 60 );
 736 }
 737
 738 sub _cdr_date_parser_maker {
 739   my $field = shift;
 740   my %options = @_;
 741   my @fields = ref($field) ? @$field : ($field);
 742   return sub {
 743     my( $cdr, $datestring ) = @_;
 744     my $unixdate = eval { _cdr_date_parse($datestring, %options) };
 745     die "error parsing date for @fields from $datestring: $@\n" if $@;
 746     $cdr->$_($unixdate) foreach @fields;
 747   };
 748 }
 749
 750 sub _cdr_date_parse {
 751   my $date = shift;
 752   my %options = @_;
 753
 754   return '' unless length($date); #that's okay, it becomes NULL
 755
 756   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 ) {
 757     my $time = str2time($date);
 758     return $time if $time > 100000; #just in case
 759   }
 760
 761   my($year, $mon, $day, $hour, $min, $sec);
 762
 763   #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
 764   #taqua  #2007-10-31 08:57:24.113000000
 765
 766   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|$)/ ) {
 767     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
 768   } 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|$)/ ) {
 769     ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
 770   } else {
 771      die "unparsable date: $date"; #maybe we shouldn't die...
 772   }
 773
 774   return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
 775             && $hour == 0 && $min == 0 && $sec == 0;
 776
 777   if ($options{gmt}) {
 778     timegm($sec, $min, $hour, $day, $mon-1, $year);
 779   } else {
 780     timelocal($sec, $min, $hour, $day, $mon-1, $year);
 781   }
 782 }
 783
 784 =item batch_import HASHREF
 785
 786 Imports CDR records.  Available options are:
 787
 788 =over 4
 789
 790 =item file
 791
 792 Filename
 793
 794 =item format
 795
 796 =item params
 797
 798 Hash reference of preset fields, typically cdrbatch
 799
 800 =item empty_ok
 801
 802 Set true to prevent throwing an error on empty imports
 803
 804 =back
 805
 806 =cut
 807
 808 my %import_options = (
 809   'table'   => 'cdr',
 810
 811   'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
 812                      keys %cdr_info
 813                },
 814
 815                           #drop the || 'csv' to allow auto xls for csv types?
 816   'format_types' => { map { $_ => ( lc($cdr_info{$_}->{'type'}) || 'csv' ); }
 817                           keys %cdr_info
 818                     },
 819
 820   'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
 821                             keys %cdr_info
 822                       },
 823
 824   'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
 825                               keys %cdr_info
 826                         },
 827
 828   'format_fixedlength_formats' =>
 829     { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
 830           keys %cdr_info
 831     },
 832 );
 833
 834 sub _import_options {
 835   \%import_options;
 836 }
 837
 838 sub batch_import {
 839   my $opt = shift;
 840
 841   my $iopt = _import_options;
 842   $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
 843
 844   FS::Record::batch_import( $opt );
 845
 846 }
 847
 848 =item process_batch_import
 849
 850 =cut
 851
 852 sub process_batch_import {
 853   my $job = shift;
 854
 855   my $opt = _import_options;
 856   $opt->{'params'} = [ 'format', 'cdrbatch' ];
 857
 858   FS::Record::process_batch_import( $job, $opt, @_ );
 859
 860 }
 861 #  if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
 862 #    @columns = map { s/^ +//; $_; } @columns;
 863 #  }
 864
 865 =back
 866
 867 =head1 BUGS
 868
 869 =head1 SEE ALSO
 870
 871 L<FS::Record>, schema.html from the base documentation.
 872
 873 =cut
 874
 875 1;
 876