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,Number,Destination,Price',
 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',
 498                                       @{ $export_formats{'default'} }[0..2],
 499                                       @{ $export_formats{'default'} }[4..5],
 500                                       @{ $export_formats{'default'} }[3],
 501                                     ];
 502
 503 sub downstream_csv {
 504   my( $self, %opt ) = @_;
 505
 506   my $format = $opt{'format'}; # 'convergent';
 507   return "Unknown format $format" unless exists $export_formats{$format};
 508
 509   #my $conf = new FS::Conf;
 510   #$opt{'money_char'} ||= $conf->config('money_char') || '$';
 511   $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
 512
 513   eval "use Text::CSV_XS;";
 514   die $@ if $@;
 515   my $csv = new Text::CSV_XS;
 516
 517   my @columns =
 518     map {
 519           ref($_) ? &{$_}($self, %opt) : $self->$_();
 520         }
 521     @{ $export_formats{$format} };
 522
 523   my $status = $csv->combine(@columns);
 524   die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
 525     unless $status;
 526
 527   $csv->string;
 528
 529 }
 530
 531 =back
 532
 533 =head1 CLASS METHODS
 534
 535 =over 4
 536
 537 =item invoice_formats
 538
 539 Returns an ordered list of key value pairs containing invoice format names
 540 as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
 541
 542 =cut
 543
 544 sub invoice_formats {
 545   map { ($_ => $export_names{$_}->{'name'}) }
 546     grep { $export_names{$_}->{'invoice_header'} }
 547     keys %export_names;
 548 }
 549
 550 =item invoice_header FORMAT
 551
 552 Returns a scalar containing the CSV column header for invoice format FORMAT.
 553
 554 =cut
 555
 556 sub invoice_header {
 557   my $format = shift;
 558   $export_names{$format}->{'invoice_header'};
 559 }
 560
 561 =item import_formats
 562
 563 Returns an ordered list of key value pairs containing import format names
 564 as keys (for use with batch_import) and "pretty" format names as values.
 565
 566 =cut
 567
 568 #false laziness w/part_pkg & part_export
 569
 570 my %cdr_info;
 571 foreach my $INC ( @INC ) {
 572   warn "globbing $INC/FS/cdr/*.pm\n" if $DEBUG;
 573   foreach my $file ( glob("$INC/FS/cdr/*.pm") ) {
 574     warn "attempting to load CDR format info from $file\n" if $DEBUG;
 575     $file =~ /\/(\w+)\.pm$/ or do {
 576       warn "unrecognized file in $INC/FS/cdr/: $file\n";
 577       next;
 578     };
 579     my $mod = $1;
 580     my $info = eval "use FS::cdr::$mod; ".
 581                     "\\%FS::cdr::$mod\::info;";
 582     if ( $@ ) {
 583       die "error using FS::cdr::$mod (skipping): $@\n" if $@;
 584       next;
 585     }
 586     unless ( keys %$info ) {
 587       warn "no %info hash found in FS::cdr::$mod, skipping\n";
 588       next;
 589     }
 590     warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
 591     if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
 592       warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
 593       next;
 594     }
 595     $cdr_info{$mod} = $info;
 596   }
 597 }
 598
 599 tie my %import_formats, 'Tie::IxHash',
 600   map  { $_ => $cdr_info{$_}->{'name'} }
 601   sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
 602   grep { exists($cdr_info{$_}->{'import_fields'}) }
 603   keys %cdr_info;
 604
 605 sub import_formats {
 606   %import_formats;
 607 }
 608
 609 sub _cdr_min_parser_maker {
 610   my $field = shift;
 611   my @fields = ref($field) ? @$field : ($field);
 612   @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
 613   return sub {
 614     my( $cdr, $min ) = @_;
 615     my $sec = eval { _cdr_min_parse($min) };
 616     die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
 617     $cdr->$_($sec) foreach @fields;
 618   };
 619 }
 620
 621 sub _cdr_min_parse {
 622   my $min = shift;
 623   sprintf('%.0f', $min * 60 );
 624 }
 625
 626 sub _cdr_date_parser_maker {
 627   my $field = shift;
 628   return sub {
 629     my( $cdr, $date ) = @_;
 630     #$cdr->$field( _cdr_date_parse($date) );
 631     eval { $cdr->$field( _cdr_date_parse($date) ); };
 632     die "error parsing date for $field from $date: $@\n" if $@;
 633   };
 634 }
 635
 636 sub _cdr_date_parse {
 637   my $date = shift;
 638
 639   return '' unless length($date); #that's okay, it becomes NULL
 640
 641   my($year, $mon, $day, $hour, $min, $sec);
 642
 643   #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
 644   #taqua  #2007-10-31 08:57:24.113000000
 645
 646   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|$)/ ) {
 647     ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
 648   } 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|$)/ ) {
 649     ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
 650   } else {
 651      die "unparsable date: $date"; #maybe we shouldn't die...
 652   }
 653
 654   return '' if $year == 1900 && $mon == 1 && $day == 1
 655             && $hour == 0    && $min == 0 && $sec == 0;
 656
 657   timelocal($sec, $min, $hour, $day, $mon-1, $year);
 658 }
 659
 660 =item batch_import HASHREF
 661
 662 Imports CDR records.  Available options are:
 663
 664 =over 4
 665
 666 =item filehandle
 667
 668 =item format
 669
 670 =back
 671
 672 =cut
 673
 674 sub batch_import {
 675   my $param = shift;
 676
 677   my $fh = $param->{filehandle};
 678   my $format = $param->{format};
 679   my $cdrbatch = $param->{cdrbatch};
 680
 681   return "Unknown format $format"
 682     unless exists( $cdr_info{$format} )
 683         && exists( $cdr_info{$format}->{'import_fields'} );
 684
 685   my $info = $cdr_info{$format};
 686
 687   my $type = exists($info->{'type'}) ? lc($info->{'type'}) : 'csv';
 688
 689   my $parser;
 690   if ( $type eq 'csv' ) {
 691     eval "use Text::CSV_XS;";
 692     die $@ if $@;
 693     my %attr = ();
 694     foreach ( grep exists($info->{$_}), qw( sep_char ) ) {
 695       $attr{$_} = $info->{$_};
 696     }
 697     $parser = new Text::CSV_XS \%attr;
 698   } elsif ( $type eq 'fixedlength' ) {
 699     eval "use Parse::FixedLength;";
 700     die $@ if $@;
 701     $parser = new Parse::FixedLength $info->{'fixedlength_format'};
 702   } else {
 703     die "Unknown CDR format type $type for format $format\n";
 704   }
 705
 706   my $imported = 0;
 707   #my $columns;
 708
 709   local $SIG{HUP} = 'IGNORE';
 710   local $SIG{INT} = 'IGNORE';
 711   local $SIG{QUIT} = 'IGNORE';
 712   local $SIG{TERM} = 'IGNORE';
 713   local $SIG{TSTP} = 'IGNORE';
 714   local $SIG{PIPE} = 'IGNORE';
 715
 716   my $oldAutoCommit = $FS::UID::AutoCommit;
 717   local $FS::UID::AutoCommit = 0;
 718   my $dbh = dbh;
 719
 720   my $header_lines = exists($info->{'header'}) ? $info->{'header'} : 0;
 721
 722   my $line;
 723   while ( defined($line=<$fh>) ) {
 724
 725     next if $header_lines-- > 0; #&& $line =~ /^[\w, "]+$/
 726
 727     my @columns = ();
 728     if ( $type eq 'csv' ) {
 729
 730       $parser->parse($line) or do {
 731         $dbh->rollback if $oldAutoCommit;
 732         return "can't parse: ". $parser->error_input();
 733       };
 734
 735       @columns = $parser->fields();
 736
 737     } elsif ( $type eq 'fixedlength' ) {
 738
 739       @columns = $parser->parse($line);
 740
 741     } else {
 742       die "Unknown CDR format type $type for format $format\n";
 743     }
 744
 745     #warn join('-',@columns);
 746
 747     if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
 748       @columns = map { s/^ +//; $_; } @columns;
 749     }
 750
 751     my @later = ();
 752     my %cdr =
 753       map {
 754
 755         my $field_or_sub = $_;
 756         if ( ref($field_or_sub) ) {
 757           push @later, $field_or_sub, shift(@columns);
 758           ();
 759         } else {
 760           ( $field_or_sub => shift @columns );
 761         }
 762
 763       }
 764       @{ $info->{'import_fields'} }
 765     ;
 766
 767     $cdr{cdrbatch} = $cdrbatch;
 768
 769     my $cdr = new FS::cdr ( \%cdr );
 770
 771     while ( scalar(@later) ) {
 772       my $sub = shift @later;
 773       my $data = shift @later;
 774       &{$sub}($cdr, $data);  # $cdr->&{$sub}($data);
 775     }
 776
 777     if ( $format eq 'taqua' ) { #should be a callback or opt in FS::cdr::taqua
 778       if ( $cdr->enddate && $cdr->startdate  ) { #a bit more?
 779         $cdr->duration( $cdr->enddate - $cdr->startdate  );
 780       }
 781       if ( $cdr->enddate && $cdr->answerdate ) { #a bit more?
 782         $cdr->billsec(  $cdr->enddate - $cdr->answerdate );
 783       }
 784     }
 785
 786     my $error = $cdr->insert;
 787     if ( $error ) {
 788       $dbh->rollback if $oldAutoCommit;
 789       return $error;
 790
 791       #or just skip?
 792       #next;
 793     }
 794
 795     $imported++;
 796   }
 797
 798   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 799
 800   #might want to disable this if we skip records for any reason...
 801   return "Empty file!" unless $imported || $param->{empty_ok};
 802
 803   '';
 804
 805 }
 806
 807 =back
 808
 809 =head1 BUGS
 810
 811 =head1 SEE ALSO
 812
 813 L<FS::Record>, schema.html from the base documentation.
 814
 815 =cut
 816
 817 1;
 818