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       my $charged_party = $self->accountcode;
 353       $charged_party =~ s/^0+//
 354         if $conf->exists('cdr-charged_party-accountcode-trim_leading_0s');
 355       $self->charged_party( $charged_party );
 356
 357     } else {
 358
 359       if ( $self->is_tollfree ) {
 360         $self->charged_party($self->dst);
 361       } else {
 362         $self->charged_party($self->src);
 363       }
 364
 365     }
 366
 367   }
 368
 369 #  my $prefix = $conf->config('cdr-charged_party-truncate_prefix');
 370 #  my $prefix_len = length($prefix);
 371 #  my $trunc_len = $conf->config('cdr-charged_party-truncate_length');
 372 #
 373 #  $self->charged_party( substr($self->charged_party, 0, $trunc_len) )
 374 #    if $prefix_len && $trunc_len
 375 #    && substr($self->charged_party, 0, $prefix_len) eq $prefix;
 376
 377 }
 378
 379 =item set_status_and_rated_price STATUS [ RATED_PRICE ]
 380
 381 Sets the status to the provided string.  If there is an error, returns the
 382 error, otherwise returns false.
 383
 384 =cut
 385
 386 sub set_status_and_rated_price {
 387   my($self, $status, $rated_price) = @_;
 388   $self->freesidestatus($status);
 389   $self->rated_price($rated_price);
 390   $self->replace();
 391 }
 392
 393 =item calldate_unix
 394
 395 Parses the calldate in SQL string format and returns a UNIX timestamp.
 396
 397 =cut
 398
 399 sub calldate_unix {
 400   str2time(shift->calldate);
 401 }
 402
 403 =item startdate_sql
 404
 405 Parses the startdate in UNIX timestamp format and returns a string in SQL
 406 format.
 407
 408 =cut
 409
 410 sub startdate_sql {
 411   my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
 412   $mon++;
 413   $year += 1900;
 414   "$year-$mon-$mday $hour:$min:$sec";
 415 }
 416
 417 =item cdr_carrier
 418
 419 Returns the FS::cdr_carrier object associated with this CDR, or false if no
 420 carrierid is defined.
 421
 422 =cut
 423
 424 my %carrier_cache = ();
 425
 426 sub cdr_carrier {
 427   my $self = shift;
 428   return '' unless $self->carrierid;
 429   $carrier_cache{$self->carrierid} ||=
 430     qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
 431 }
 432
 433 =item carriername
 434
 435 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
 436 no FS::cdr_carrier object is assocated with this CDR.
 437
 438 =cut
 439
 440 sub carriername {
 441   my $self = shift;
 442   my $cdr_carrier = $self->cdr_carrier;
 443   $cdr_carrier ? $cdr_carrier->carriername : '';
 444 }
 445
 446 =item cdr_calltype
 447
 448 Returns the FS::cdr_calltype object associated with this CDR, or false if no
 449 calltypenum is defined.
 450
 451 =cut
 452
 453 my %calltype_cache = ();
 454
 455 sub cdr_calltype {
 456   my $self = shift;
 457   return '' unless $self->calltypenum;
 458   $calltype_cache{$self->calltypenum} ||=
 459     qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
 460 }
 461
 462 =item calltypename
 463
 464 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
 465 no FS::cdr_calltype object is assocated with this CDR.
 466
 467 =cut
 468
 469 sub calltypename {
 470   my $self = shift;
 471   my $cdr_calltype = $self->cdr_calltype;
 472   $cdr_calltype ? $cdr_calltype->calltypename : '';
 473 }
 474
 475 =item cdr_upstream_rate
 476
 477 Returns the upstream rate mapping (see L<FS::cdr_upstream_rate>), or the empty
 478 string if no FS::cdr_upstream_rate object is associated with this CDR.
 479
 480 =cut
 481
 482 sub cdr_upstream_rate {
 483   my $self = shift;
 484   return '' unless $self->upstream_rateid;
 485   qsearchs('cdr_upstream_rate', { 'upstream_rateid' => $self->upstream_rateid })
 486     or '';
 487 }
 488
 489 =item _convergent_format COLUMN [ COUNTRYCODE ]
 490
 491 Returns the number in COLUMN formatted as follows:
 492
 493 If the country code does not match COUNTRYCODE (default "61"), it is returned
 494 unchanged.
 495
 496 If the country code does match COUNTRYCODE (default "61"), it is removed.  In
 497 addiiton, "0" is prepended unless the number starts with 13, 18 or 19. (???)
 498
 499 =cut
 500
 501 sub _convergent_format {
 502   my( $self, $field ) = ( shift, shift );
 503   my $countrycode = scalar(@_) ? shift : '61'; #+61 = australia
 504   #my $number = $self->$field();
 505   my $number = $self->get($field);
 506   #if ( $number =~ s/^(\+|011)$countrycode// ) {
 507   if ( $number =~ s/^\+$countrycode// ) {
 508     $number = "0$number"
 509       unless $number =~ /^1[389]/; #???
 510   }
 511   $number;
 512 }
 513
 514 =item downstream_csv [ OPTION => VALUE, ... ]
 515
 516 =cut
 517
 518 my %export_names = (
 519   'convergent'      => {},
 520   'simple'  => {
 521     'name'           => 'Simple',
 522     'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
 523   },
 524   'simple2' => {
 525     'name'           => 'Simple with source',
 526     'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
 527                        #"Date,Time,Name,Called From,Destination,Duration,Price",
 528   },
 529   'default' => {
 530     'name'           => 'Default',
 531     'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
 532   },
 533   'source_default' => {
 534     'name'           => 'Default with source',
 535     'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
 536   },
 537   'accountcode_default' => {
 538     'name'           => 'Default plus accountcode',
 539     'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
 540   },
 541 );
 542
 543 my $duration_sub = sub {
 544   my($cdr, %opt) = @_;
 545   if ( $opt{minutes} ) {
 546     $opt{minutes}. ( $opt{granularity} ? 'm' : ' call' );
 547   } else {
 548     sprintf('%.2fm', $cdr->billsec / 60 );
 549   }
 550 };
 551
 552 my %export_formats = (
 553   'convergent' => [
 554     'carriername', #CARRIER
 555     sub { shift->_convergent_format('src') }, #SERVICE_NUMBER
 556     sub { shift->_convergent_format('charged_party') }, #CHARGED_NUMBER
 557     sub { time2str('%Y-%m-%d', shift->calldate_unix ) }, #DATE
 558     sub { time2str('%T',       shift->calldate_unix ) }, #TIME
 559     'billsec', #'duration', #DURATION
 560     sub { shift->_convergent_format('dst') }, #NUMBER_DIALED
 561     '', #XXX add (from prefixes in most recent email) #FROM_DESC
 562     '', #XXX add (from prefixes in most recent email) #TO_DESC
 563     'calltypename', #CLASS_CODE
 564     'rated_price', #PRICE
 565     sub { shift->rated_price ? 'Y' : 'N' }, #RATED
 566     '', #OTHER_INFO
 567   ],
 568   'simple' => [
 569     sub { time2str('%D', shift->calldate_unix ) },   #DATE
 570     sub { time2str('%r', shift->calldate_unix ) },   #TIME
 571     'userfield',                                     #USER
 572     'dst',                                           #NUMBER_DIALED
 573     $duration_sub,                                   #DURATION
 574     #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
 575     sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, #PRICE
 576   ],
 577   'simple2' => [
 578     sub { time2str('%D', shift->calldate_unix ) },   #DATE
 579     sub { time2str('%r', shift->calldate_unix ) },   #TIME
 580     #'userfield',                                     #USER
 581     'src',                                           #called from
 582     'dst',                                           #NUMBER_DIALED
 583     $duration_sub,                                   #DURATION
 584     #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
 585     sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, #PRICE
 586   ],
 587   'default' => [
 588
 589     #DATE
 590     sub { time2str('%D', shift->calldate_unix ) },
 591           # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
 592
 593     #TIME
 594     sub { time2str('%r', shift->calldate_unix ) },
 595           # 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
 596
 597     #DEST ("Number")
 598     sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
 599
 600     #REGIONNAME ("Destination")
 601     sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
 602
 603     #DURATION
 604     $duration_sub,
 605
 606     #PRICE
 607     sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; },
 608
 609   ],
 610 );
 611 $export_formats{'source_default'} = [ 'src', @{ $export_formats{'default'} }, ];
 612 $export_formats{'accountcode_default'} =
 613   [ @{ $export_formats{'default'} }[0,1],
 614     'accountcode',
 615     @{ $export_formats{'default'} }[2..5],
 616   ];
 617
 618 sub downstream_csv {
 619   my( $self, %opt ) = @_;
 620
 621   my $format = $opt{'format'}; # 'convergent';
 622   return "Unknown format $format" unless exists $export_formats{$format};
 623
 624   #my $conf = new FS::Conf;
 625   #$opt{'money_char'} ||= $conf->config('money_char') || '$';
 626   $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
 627
 628   eval "use Text::CSV_XS;";
 629   die $@ if $@;
 630   my $csv = new Text::CSV_XS;
 631
 632   my @columns =
 633     map {
 634           ref($_) ? &{$_}($self, %opt) : $self->$_();
 635         }
 636     @{ $export_formats{$format} };
 637
 638   my $status = $csv->combine(@columns);
 639   die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
 640     unless $status;
 641
 642   $csv->string;
 643
 644 }
 645
 646 =back
 647
 648 =head1 CLASS METHODS
 649
 650 =over 4
 651
 652 =item invoice_formats
 653
 654 Returns an ordered list of key value pairs containing invoice format names
 655 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
 656
 657 =cut
 658
 659 sub invoice_formats {
 660   map { ($_ => $export_names{$_}->{'name'}) }
 661     grep { $export_names{$_}->{'invoice_header'} }
 662     keys %export_names;
 663 }
 664
 665 =item invoice_header FORMAT
 666
 667 Returns a scalar containing the CSV column header for invoice format FORMAT.
 668
 669 =cut
 670
 671 sub invoice_header {
 672   my $format = shift;
 673   $export_names{$format}->{'invoice_header'};
 674 }
 675
 676 =item import_formats
 677
 678 Returns an ordered list of key value pairs containing import format names
 679 as keys (for use with batch_import) and "pretty" format names as values.
 680
 681 =cut
 682
 683 #false laziness w/part_pkg & part_export
 684
 685 my %cdr_info;
 686 foreach my $INC ( @INC ) {
 687   warn "globbing $INC/FS/cdr/*.pm\n" if $DEBUG;
 688   foreach my $file ( glob("$INC/FS/cdr/*.pm") ) {
 689     warn "attempting to load CDR format info from $file\n" if $DEBUG;
 690     $file =~ /\/(\w+)\.pm$/ or do {
 691       warn "unrecognized file in $INC/FS/cdr/: $file\n";
 692       next;
 693     };
 694     my $mod = $1;
 695     my $info = eval "use FS::cdr::$mod; ".
 696                     "\\%FS::cdr::$mod\::info;";
 697     if ( $@ ) {
 698       die "error using FS::cdr::$mod (skipping): $@\n" if $@;
 699       next;
 700     }
 701     unless ( keys %$info ) {
 702       warn "no %info hash found in FS::cdr::$mod, skipping\n";
 703       next;
 704     }
 705     warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
 706     if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
 707       warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
 708       next;
 709     }
 710     $cdr_info{$mod} = $info;
 711   }
 712 }
 713
 714 tie my %import_formats, 'Tie::IxHash',
 715   map  { $_ => $cdr_info{$_}->{'name'} }
 716   sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
 717   grep { exists($cdr_info{$_}->{'import_fields'}) }
 718   keys %cdr_info;
 719
 720 sub import_formats {
 721   %import_formats;
 722 }
 723
 724 sub _cdr_min_parser_maker {
 725   my $field = shift;
 726   my @fields = ref($field) ? @$field : ($field);
 727   @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
 728   return sub {
 729     my( $cdr, $min ) = @_;
 730     my $sec = eval { _cdr_min_parse($min) };
 731     die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
 732     $cdr->$_($sec) foreach @fields;
 733   };
 734 }
 735
 736 sub _cdr_min_parse {
 737   my $min = shift;
 738   sprintf('%.0f', $min * 60 );
 739 }
 740
 741 sub _cdr_date_parser_maker {
 742   my $field = shift;
 743   my %options = @_;
 744   my @fields = ref($field) ? @$field : ($field);
 745   return sub {
 746     my( $cdr, $datestring ) = @_;
 747     my $unixdate = eval { _cdr_date_parse($datestring, %options) };
 748     die "error parsing date for @fields from $datestring: $@\n" if $@;
 749     $cdr->$_($unixdate) foreach @fields;
 750   };
 751 }
 752
 753 sub _cdr_date_parse {
 754   my $date = shift;
 755   my %options = @_;
 756
 757   return '' unless length($date); #that's okay, it becomes NULL
 758   return '' if $date eq 'NA'; #sansay
 759
 760   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 ) {
 761     my $time = str2time($date);
 762     return $time if $time > 100000; #just in case
 763   }
 764
 765   my($year, $mon, $day, $hour, $min, $sec);
 766
 767   #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
 768   #taqua  #2007-10-31 08:57:24.113000000
 769
 770   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|$)/ ) {
 771     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
 772   } 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|$)/ ) {
 773     ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
 774   } else {
 775      die "unparsable date: $date"; #maybe we shouldn't die...
 776   }
 777
 778   return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
 779             && $hour == 0 && $min == 0 && $sec == 0;
 780
 781   if ($options{gmt}) {
 782     timegm($sec, $min, $hour, $day, $mon-1, $year);
 783   } else {
 784     timelocal($sec, $min, $hour, $day, $mon-1, $year);
 785   }
 786 }
 787
 788 =item batch_import HASHREF
 789
 790 Imports CDR records.  Available options are:
 791
 792 =over 4
 793
 794 =item file
 795
 796 Filename
 797
 798 =item format
 799
 800 =item params
 801
 802 Hash reference of preset fields, typically cdrbatch
 803
 804 =item empty_ok
 805
 806 Set true to prevent throwing an error on empty imports
 807
 808 =back
 809
 810 =cut
 811
 812 my %import_options = (
 813   'table'   => 'cdr',
 814
 815   'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
 816                      keys %cdr_info
 817                },
 818
 819                           #drop the || 'csv' to allow auto xls for csv types?
 820   'format_types' => { map { $_ => ( lc($cdr_info{$_}->{'type'}) || 'csv' ); }
 821                           keys %cdr_info
 822                     },
 823
 824   'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
 825                             keys %cdr_info
 826                       },
 827
 828   'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
 829                               keys %cdr_info
 830                         },
 831
 832   'format_fixedlength_formats' =>
 833     { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
 834           keys %cdr_info
 835     },
 836 );
 837
 838 sub _import_options {
 839   \%import_options;
 840 }
 841
 842 sub batch_import {
 843   my $opt = shift;
 844
 845   my $iopt = _import_options;
 846   $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
 847
 848   FS::Record::batch_import( $opt );
 849
 850 }
 851
 852 =item process_batch_import
 853
 854 =cut
 855
 856 sub process_batch_import {
 857   my $job = shift;
 858
 859   my $opt = _import_options;
 860   $opt->{'params'} = [ 'format', 'cdrbatch' ];
 861
 862   FS::Record::process_batch_import( $job, $opt, @_ );
 863
 864 }
 865 #  if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
 866 #    @columns = map { s/^ +//; $_; } @columns;
 867 #  }
 868
 869 =back
 870
 871 =head1 BUGS
 872
 873 =head1 SEE ALSO
 874
 875 L<FS::Record>, schema.html from the base documentation.
 876
 877 =cut
 878
 879 1;
 880