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 cdrbatch
 134
 135 =back
 136
 137 =head1 METHODS
 138
 139 =over 4
 140
 141 =item new HASHREF
 142
 143 Creates a new CDR.  To add the CDR to the database, see L<"insert">.
 144
 145 Note that this stores the hash reference, not a distinct copy of the hash it
 146 points to.  You can ask the object for a copy with the I<hash> method.
 147
 148 =cut
 149
 150 # the new method can be inherited from FS::Record, if a table method is defined
 151
 152 sub table { 'cdr'; }
 153
 154 =item insert
 155
 156 Adds this record to the database.  If there is an error, returns the error,
 157 otherwise returns false.
 158
 159 =cut
 160
 161 # the insert method can be inherited from FS::Record
 162
 163 =item delete
 164
 165 Delete this record from the database.
 166
 167 =cut
 168
 169 # the delete method can be inherited from FS::Record
 170
 171 =item replace OLD_RECORD
 172
 173 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 174 returns the error, otherwise returns false.
 175
 176 =cut
 177
 178 # the replace method can be inherited from FS::Record
 179
 180 =item check
 181
 182 Checks all fields to make sure this is a valid CDR.  If there is
 183 an error, returns the error, otherwise returns false.  Called by the insert
 184 and replace methods.
 185
 186 Note: Unlike most types of records, we don't want to "reject" a CDR and we want
 187 to process them as quickly as possible, so we allow the database to check most
 188 of the data.
 189
 190 =cut
 191
 192 sub check {
 193   my $self = shift;
 194
 195 # we don't want to "reject" a CDR like other sorts of input...
 196 #  my $error =
 197 #    $self->ut_numbern('acctid')
 198 ##    || $self->ut_('calldate')
 199 #    || $self->ut_text('clid')
 200 #    || $self->ut_text('src')
 201 #    || $self->ut_text('dst')
 202 #    || $self->ut_text('dcontext')
 203 #    || $self->ut_text('channel')
 204 #    || $self->ut_text('dstchannel')
 205 #    || $self->ut_text('lastapp')
 206 #    || $self->ut_text('lastdata')
 207 #    || $self->ut_numbern('startdate')
 208 #    || $self->ut_numbern('answerdate')
 209 #    || $self->ut_numbern('enddate')
 210 #    || $self->ut_number('duration')
 211 #    || $self->ut_number('billsec')
 212 #    || $self->ut_text('disposition')
 213 #    || $self->ut_number('amaflags')
 214 #    || $self->ut_text('accountcode')
 215 #    || $self->ut_text('uniqueid')
 216 #    || $self->ut_text('userfield')
 217 #    || $self->ut_numbern('cdrtypenum')
 218 #    || $self->ut_textn('charged_party')
 219 ##    || $self->ut_n('upstream_currency')
 220 ##    || $self->ut_n('upstream_price')
 221 #    || $self->ut_numbern('upstream_rateplanid')
 222 ##    || $self->ut_n('distance')
 223 #    || $self->ut_numbern('islocal')
 224 #    || $self->ut_numbern('calltypenum')
 225 #    || $self->ut_textn('description')
 226 #    || $self->ut_numbern('quantity')
 227 #    || $self->ut_numbern('carrierid')
 228 #    || $self->ut_numbern('upstream_rateid')
 229 #    || $self->ut_numbern('svcnum')
 230 #    || $self->ut_textn('freesidestatus')
 231 #  ;
 232 #  return $error if $error;
 233
 234   $self->calldate( $self->startdate_sql )
 235     if !$self->calldate && $self->startdate;
 236
 237   my $conf = new FS::Conf;
 238
 239   unless ( $self->charged_party ) {
 240
 241     if ( $conf->exists('cdr-charged_party-accountcode') && $self->accountcode ){
 242
 243       $self->charged_party( $self->accountcode );
 244
 245     } else {
 246
 247       if ( $self->dst =~ /^(\+?1)?8[02-8]{2}/ ) {
 248         $self->charged_party($self->dst);
 249       } else {
 250         $self->charged_party($self->src);
 251       }
 252
 253     }
 254
 255   }
 256
 257   #check the foreign keys even?
 258   #do we want to outright *reject* the CDR?
 259   my $error =
 260        $self->ut_numbern('acctid')
 261
 262   #add a config option to turn these back on if someone needs 'em
 263   #
 264   #  #Usage = 1, S&E = 7, OC&C = 8
 265   #  || $self->ut_foreign_keyn('cdrtypenum',  'cdr_type',     'cdrtypenum' )
 266   #
 267   #  #the big list in appendix 2
 268   #  || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
 269   #
 270   #  # Telstra =1, Optus = 2, RSL COM = 3
 271   #  || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
 272   ;
 273   return $error if $error;
 274
 275   $self->SUPER::check;
 276 }
 277
 278 =item set_status_and_rated_price STATUS [ RATED_PRICE ]
 279
 280 Sets the status to the provided string.  If there is an error, returns the
 281 error, otherwise returns false.
 282
 283 =cut
 284
 285 sub set_status_and_rated_price {
 286   my($self, $status, $rated_price) = @_;
 287   $self->freesidestatus($status);
 288   $self->rated_price($rated_price);
 289   $self->replace();
 290 }
 291
 292 =item calldate_unix
 293
 294 Parses the calldate in SQL string format and returns a UNIX timestamp.
 295
 296 =cut
 297
 298 sub calldate_unix {
 299   str2time(shift->calldate);
 300 }
 301
 302 =item startdate_sql
 303
 304 Parses the startdate in UNIX timestamp format and returns a string in SQL
 305 format.
 306
 307 =cut
 308
 309 sub startdate_sql {
 310   my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
 311   $mon++;
 312   $year += 1900;
 313   "$year-$mon-$mday $hour:$min:$sec";
 314 }
 315
 316 =item cdr_carrier
 317
 318 Returns the FS::cdr_carrier object associated with this CDR, or false if no
 319 carrierid is defined.
 320
 321 =cut
 322
 323 my %carrier_cache = ();
 324
 325 sub cdr_carrier {
 326   my $self = shift;
 327   return '' unless $self->carrierid;
 328   $carrier_cache{$self->carrierid} ||=
 329     qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
 330 }
 331
 332 =item carriername
 333
 334 Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
 335 no FS::cdr_carrier object is assocated with this CDR.
 336
 337 =cut
 338
 339 sub carriername {
 340   my $self = shift;
 341   my $cdr_carrier = $self->cdr_carrier;
 342   $cdr_carrier ? $cdr_carrier->carriername : '';
 343 }
 344
 345 =item cdr_calltype
 346
 347 Returns the FS::cdr_calltype object associated with this CDR, or false if no
 348 calltypenum is defined.
 349
 350 =cut
 351
 352 my %calltype_cache = ();
 353
 354 sub cdr_calltype {
 355   my $self = shift;
 356   return '' unless $self->calltypenum;
 357   $calltype_cache{$self->calltypenum} ||=
 358     qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
 359 }
 360
 361 =item calltypename
 362
 363 Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
 364 no FS::cdr_calltype object is assocated with this CDR.
 365
 366 =cut
 367
 368 sub calltypename {
 369   my $self = shift;
 370   my $cdr_calltype = $self->cdr_calltype;
 371   $cdr_calltype ? $cdr_calltype->calltypename : '';
 372 }
 373
 374 =item cdr_upstream_rate
 375
 376 Returns the upstream rate mapping (see L<FS::cdr_upstream_rate>), or the empty
 377 string if no FS::cdr_upstream_rate object is associated with this CDR.
 378
 379 =cut
 380
 381 sub cdr_upstream_rate {
 382   my $self = shift;
 383   return '' unless $self->upstream_rateid;
 384   qsearchs('cdr_upstream_rate', { 'upstream_rateid' => $self->upstream_rateid })
 385     or '';
 386 }
 387
 388 =item _convergent_format COLUMN [ COUNTRYCODE ]
 389
 390 Returns the number in COLUMN formatted as follows:
 391
 392 If the country code does not match COUNTRYCODE (default "61"), it is returned
 393 unchanged.
 394
 395 If the country code does match COUNTRYCODE (default "61"), it is removed.  In
 396 addiiton, "0" is prepended unless the number starts with 13, 18 or 19. (???)
 397
 398 =cut
 399
 400 sub _convergent_format {
 401   my( $self, $field ) = ( shift, shift );
 402   my $countrycode = scalar(@_) ? shift : '61'; #+61 = australia
 403   #my $number = $self->$field();
 404   my $number = $self->get($field);
 405   #if ( $number =~ s/^(\+|011)$countrycode// ) {
 406   if ( $number =~ s/^\+$countrycode// ) {
 407     $number = "0$number"
 408       unless $number =~ /^1[389]/; #???
 409   }
 410   $number;
 411 }
 412
 413 =item downstream_csv [ OPTION => VALUE, ... ]
 414
 415 =cut
 416
 417 my %export_names = (
 418   'convergent'      => {},
 419   'simple'  => {
 420     'name'           => 'Simple',
 421     'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
 422   },
 423   'simple2' => {
 424     'name'           => 'Simple with source',
 425     'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
 426                        #"Date,Time,Name,Called From,Destination,Duration,Price",
 427   },
 428   'default' => {
 429     'name'           => 'Default',
 430     'invoice_header' => 'Date,Time,Duration,Price,Number,Destination',
 431   },
 432   'source_default' => {
 433     'name'           => 'Default with source',
 434     'invoice_header' => 'Caller,Date,Time,Duration,Price,Number,Destination',
 435   },
 436 );
 437
 438 my %export_formats = (
 439   'convergent' => [
 440     'carriername', #CARRIER
 441     sub { shift->_convergent_format('src') }, #SERVICE_NUMBER
 442     sub { shift->_convergent_format('charged_party') }, #CHARGED_NUMBER
 443     sub { time2str('%Y-%m-%d', shift->calldate_unix ) }, #DATE
 444     sub { time2str('%T',       shift->calldate_unix ) }, #TIME
 445     'billsec', #'duration', #DURATION
 446     sub { shift->_convergent_format('dst') }, #NUMBER_DIALED
 447     '', #XXX add (from prefixes in most recent email) #FROM_DESC
 448     '', #XXX add (from prefixes in most recent email) #TO_DESC
 449     'calltypename', #CLASS_CODE
 450     'rated_price', #PRICE
 451     sub { shift->rated_price ? 'Y' : 'N' }, #RATED
 452     '', #OTHER_INFO
 453   ],
 454   'simple' => [
 455     sub { time2str('%D', shift->calldate_unix ) },   #DATE
 456     sub { time2str('%r', shift->calldate_unix ) },   #TIME
 457     'userfield',                                     #USER
 458     'dst',                                           #NUMBER_DIALED
 459     sub { sprintf('%.2fm', shift->billsec / 60 ) },  #DURATION
 460     sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
 461   ],
 462   'simple2' => [
 463     sub { time2str('%D', shift->calldate_unix ) },   #DATE
 464     sub { time2str('%r', shift->calldate_unix ) },   #TIME
 465     #'userfield',                                     #USER
 466     'dst',                                           #NUMBER_DIALED
 467     'src',                                           #called from
 468     sub { sprintf('%.2fm', shift->billsec / 60 ) },  #DURATION
 469     sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
 470   ],
 471   'default' => [
 472
 473     #DATE
 474     sub { time2str('%D', shift->calldate_unix ) },
 475           # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
 476
 477     #TIME
 478     sub { time2str('%r', shift->calldate_unix ) },
 479           # 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
 480
 481     #DURATION
 482     sub { my($cdr, %opt) = @_;
 483           $opt{minutes}. ( $opt{granularity} ? 'm' : ' call' );
 484         },
 485
 486     #PRICE
 487     sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; },
 488
 489     #DEST ("Number")
 490     sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
 491
 492     #REGIONNAME ("Destination")
 493     sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
 494
 495   ],
 496 );
 497 $export_formats{'source_default'} = [ 'src', @{ $export_formats{'default'} } ];
 498
 499 sub downstream_csv {
 500   my( $self, %opt ) = @_;
 501
 502   my $format = $opt{'format'}; # 'convergent';
 503   return "Unknown format $format" unless exists $export_formats{$format};
 504
 505   #my $conf = new FS::Conf;
 506   #$opt{'money_char'} ||= $conf->config('money_char') || '$';
 507   $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
 508
 509   eval "use Text::CSV_XS;";
 510   die $@ if $@;
 511   my $csv = new Text::CSV_XS;
 512
 513   my @columns =
 514     map {
 515           ref($_) ? &{$_}($self, %opt) : $self->$_();
 516         }
 517     @{ $export_formats{$format} };
 518
 519   my $status = $csv->combine(@columns);
 520   die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
 521     unless $status;
 522
 523   $csv->string;
 524
 525 }
 526
 527 =back
 528
 529 =head1 CLASS METHODS
 530
 531 =over 4
 532
 533 =item invoice_formats
 534
 535 Returns an ordered list of key value pairs containing invoice format names
 536 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
 537
 538 =cut
 539
 540 sub invoice_formats {
 541   map { ($_ => $export_names{$_}->{'name'}) }
 542     grep { $export_names{$_}->{'invoice_header'} }
 543     keys %export_names;
 544 }
 545
 546 =item invoice_header FORMAT
 547
 548 Returns a scalar containing the CSV column header for invoice format FORMAT.
 549
 550 =cut
 551
 552 sub invoice_header {
 553   my $format = shift;
 554   $export_names{$format}->{'invoice_header'};
 555 }
 556
 557 =item import_formats
 558
 559 Returns an ordered list of key value pairs containing import format names
 560 as keys (for use with batch_import) and "pretty" format names as values.
 561
 562 =cut
 563
 564 #false laziness w/part_pkg & part_export
 565
 566 my %cdr_info;
 567 foreach my $INC ( @INC ) {
 568   warn "globbing $INC/FS/cdr/*.pm\n" if $DEBUG;
 569   foreach my $file ( glob("$INC/FS/cdr/*.pm") ) {
 570     warn "attempting to load CDR format info from $file\n" if $DEBUG;
 571     $file =~ /\/(\w+)\.pm$/ or do {
 572       warn "unrecognized file in $INC/FS/cdr/: $file\n";
 573       next;
 574     };
 575     my $mod = $1;
 576     my $info = eval "use FS::cdr::$mod; ".
 577                     "\\%FS::cdr::$mod\::info;";
 578     if ( $@ ) {
 579       die "error using FS::cdr::$mod (skipping): $@\n" if $@;
 580       next;
 581     }
 582     unless ( keys %$info ) {
 583       warn "no %info hash found in FS::cdr::$mod, skipping\n";
 584       next;
 585     }
 586     warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
 587     if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
 588       warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
 589       next;
 590     }
 591     $cdr_info{$mod} = $info;
 592   }
 593 }
 594
 595 tie my %import_formats, 'Tie::IxHash',
 596   map  { $_ => $cdr_info{$_}->{'name'} }
 597   sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
 598   grep { exists($cdr_info{$_}->{'import_fields'}) }
 599   keys %cdr_info;
 600
 601 sub import_formats {
 602   %import_formats;
 603 }
 604
 605 sub _cdr_min_parser_maker {
 606   my $field = shift;
 607   my @fields = ref($field) ? @$field : ($field);
 608   @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
 609   return sub {
 610     my( $cdr, $min ) = @_;
 611     my $sec = eval { _cdr_min_parse($min) };
 612     die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
 613     $cdr->$_($sec) foreach @fields;
 614   };
 615 }
 616
 617 sub _cdr_min_parse {
 618   my $min = shift;
 619   sprintf('%.0f', $min * 60 );
 620 }
 621
 622 sub _cdr_date_parser_maker {
 623   my $field = shift;
 624   return sub {
 625     my( $cdr, $date ) = @_;
 626     #$cdr->$field( _cdr_date_parse($date) );
 627     eval { $cdr->$field( _cdr_date_parse($date) ); };
 628     die "error parsing date for $field from $date: $@\n" if $@;
 629   };
 630 }
 631
 632 sub _cdr_date_parse {
 633   my $date = shift;
 634
 635   return '' unless length($date); #that's okay, it becomes NULL
 636
 637   my($year, $mon, $day, $hour, $min, $sec);
 638
 639   #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
 640   #taqua  #2007-10-31 08:57:24.113000000
 641
 642   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|$)/ ) {
 643     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
 644   } 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|$)/ ) {
 645     ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
 646   } else {
 647      die "unparsable date: $date"; #maybe we shouldn't die...
 648   }
 649
 650   return '' if $year == 1900 && $mon == 1 && $day == 1
 651             && $hour == 0    && $min == 0 && $sec == 0;
 652
 653   timelocal($sec, $min, $hour, $day, $mon-1, $year);
 654 }
 655
 656 =item batch_import HASHREF
 657
 658 Imports CDR records.  Available options are:
 659
 660 =over 4
 661
 662 =item filehandle
 663
 664 =item format
 665
 666 =back
 667
 668 =cut
 669
 670 sub batch_import {
 671   my $param = shift;
 672
 673   my $fh = $param->{filehandle};
 674   my $format = $param->{format};
 675   my $cdrbatch = $param->{cdrbatch};
 676
 677   return "Unknown format $format"
 678     unless exists( $cdr_info{$format} )
 679         && exists( $cdr_info{$format}->{'import_fields'} );
 680
 681   my $info = $cdr_info{$format};
 682
 683   my $type = exists($info->{'type'}) ? lc($info->{'type'}) : 'csv';
 684
 685   my $parser;
 686   if ( $type eq 'csv' ) {
 687     eval "use Text::CSV_XS;";
 688     die $@ if $@;
 689     my %attr = ();
 690     foreach ( grep exists($info->{$_}), qw( sep_char ) ) {
 691       $attr{$_} = $info->{$_};
 692     }
 693     $parser = new Text::CSV_XS \%attr;
 694   } elsif ( $type eq 'fixedlength' ) {
 695     eval "use Parse::FixedLength;";
 696     die $@ if $@;
 697     $parser = new Parse::FixedLength $info->{'fixedlength_format'};
 698   } else {
 699     die "Unknown CDR format type $type for format $format\n";
 700   }
 701
 702   my $imported = 0;
 703   #my $columns;
 704
 705   local $SIG{HUP} = 'IGNORE';
 706   local $SIG{INT} = 'IGNORE';
 707   local $SIG{QUIT} = 'IGNORE';
 708   local $SIG{TERM} = 'IGNORE';
 709   local $SIG{TSTP} = 'IGNORE';
 710   local $SIG{PIPE} = 'IGNORE';
 711
 712   my $oldAutoCommit = $FS::UID::AutoCommit;
 713   local $FS::UID::AutoCommit = 0;
 714   my $dbh = dbh;
 715
 716   my $header_lines = exists($info->{'header'}) ? $info->{'header'} : 0;
 717
 718   my $line;
 719   while ( defined($line=<$fh>) ) {
 720
 721     next if $header_lines-- > 0; #&& $line =~ /^[\w, "]+$/
 722
 723     my @columns = ();
 724     if ( $type eq 'csv' ) {
 725
 726       $parser->parse($line) or do {
 727         $dbh->rollback if $oldAutoCommit;
 728         return "can't parse: ". $parser->error_input();
 729       };
 730
 731       @columns = $parser->fields();
 732
 733     } elsif ( $type eq 'fixedlength' ) {
 734
 735       @columns = $parser->parse($line);
 736
 737     } else {
 738       die "Unknown CDR format type $type for format $format\n";
 739     }
 740
 741     #warn join('-',@columns);
 742
 743     if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
 744       @columns = map { s/^ +//; $_; } @columns;
 745     }
 746
 747     my @later = ();
 748     my %cdr =
 749       map {
 750
 751         my $field_or_sub = $_;
 752         if ( ref($field_or_sub) ) {
 753           push @later, $field_or_sub, shift(@columns);
 754           ();
 755         } else {
 756           ( $field_or_sub => shift @columns );
 757         }
 758
 759       }
 760       @{ $info->{'import_fields'} }
 761     ;
 762
 763     $cdr{cdrbatch} = $cdrbatch;
 764
 765     my $cdr = new FS::cdr ( \%cdr );
 766
 767     while ( scalar(@later) ) {
 768       my $sub = shift @later;
 769       my $data = shift @later;
 770       &{$sub}($cdr, $data);  # $cdr->&{$sub}($data);
 771     }
 772
 773     if ( $format eq 'taqua' ) { #should be a callback or opt in FS::cdr::taqua
 774       if ( $cdr->enddate && $cdr->startdate  ) { #a bit more?
 775         $cdr->duration( $cdr->enddate - $cdr->startdate  );
 776       }
 777       if ( $cdr->enddate && $cdr->answerdate ) { #a bit more?
 778         $cdr->billsec(  $cdr->enddate - $cdr->answerdate );
 779       }
 780     }
 781
 782     my $error = $cdr->insert;
 783     if ( $error ) {
 784       $dbh->rollback if $oldAutoCommit;
 785       return $error;
 786
 787       #or just skip?
 788       #next;
 789     }
 790
 791     $imported++;
 792   }
 793
 794   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 795
 796   #might want to disable this if we skip records for any reason...
 797   return "Empty file!" unless $imported || $param->{empty_ok};
 798
 799   '';
 800
 801 }
 802
 803 =back
 804
 805 =head1 BUGS
 806
 807 =head1 SEE ALSO
 808
 809 L<FS::Record>, schema.html from the base documentation.
 810
 811 =cut
 812
 813 1;
 814