fix duration on simple/simple2 CDR formats
[freeside.git] / FS / FS / cdr.pm
index 5078ff6..439d5ae 100644 (file)
@@ -1,7 +1,9 @@
 package FS::cdr;
 
 use strict;
-use vars qw( @ISA );
+use vars qw( @ISA @EXPORT_OK $DEBUG );
+use Exporter;
+use Tie::IxHash;
 use Date::Parse;
 use Date::Format;
 use Time::Local;
@@ -13,6 +15,9 @@ use FS::cdr_carrier;
 use FS::cdr_upstream_rate;
 
 @ISA = qw(FS::Record);
+@EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker );
+
+$DEBUG = 0;
 
 =head1 NAME
 
@@ -392,6 +397,19 @@ sub _convergent_format {
 
 =cut
 
+my %export_names = (
+  'convergent'      => {},
+  'simple'  => { 'name'           => 'Simple',
+                 'invoice_header' =>
+                     "Date,Time,Name,Destination,Duration,Price",
+               },
+  'simple2' => { 'name'           => 'Simple with source',
+                 'invoice_header' =>
+                     #"Date,Time,Name,Called From,Destination,Duration,Price",
+                     "Date,Time,Called From,Destination,Duration,Price",
+               },
+);
+
 my %export_formats = (
   'convergent' => [
     'carriername', #CARRIER
@@ -408,6 +426,23 @@ my %export_formats = (
     sub { shift->rated_price ? 'Y' : 'N' }, #RATED
     '', #OTHER_INFO
   ],
+  'simple' => [
+    sub { time2str('%D', shift->calldate_unix ) },   #DATE
+    sub { time2str('%r', shift->calldate_unix ) },   #TIME
+    'userfield',                                     #USER
+    'dst',                                           #NUMBER_DIALED
+    sub { sprintf('%.2fm', shift->billsec / 60 ) },  #DURATION
+    sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
+  ],
+  'simple2' => [
+    sub { time2str('%D', shift->calldate_unix ) },   #DATE
+    sub { time2str('%r', shift->calldate_unix ) },   #TIME
+    #'userfield',                                     #USER
+    'dst',                                           #NUMBER_DIALED
+    'src',                                           #called from
+    sub { sprintf('%.2fm', shift->billsec / 60 ) },  #DURATION
+    sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
+  ],
 );
 
 sub downstream_csv {
@@ -440,17 +475,102 @@ sub downstream_csv {
 
 =over 4
 
-=item batch_import
+=item invoice_formats
+
+Returns an ordered list of key value pairs containing invoice format names
+as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
+
+=cut
+
+sub invoice_formats {
+  map { ($_ => $export_names{$_}->{'name'}) }
+    grep { $export_names{$_}->{'invoice_header'} }
+    keys %export_names;
+}
+
+=item invoice_header FORMAT
+
+Returns a scalar containing the CSV column header for invoice format FORMAT.
+
+=cut
+
+sub invoice_header {
+  my $format = shift;
+  $export_names{$format}->{'invoice_header'};
+}
+
+=item import_formats
+
+Returns an ordered list of key value pairs containing import format names
+as keys (for use with batch_import) and "pretty" format names as values.
 
 =cut
 
-my($tmp_mday, $tmp_mon, $tmp_year);
+#false laziness w/part_pkg & part_export
+
+my %cdr_info;
+foreach my $INC ( @INC ) {
+  warn "globbing $INC/FS/cdr/*.pm\n" if $DEBUG;
+  foreach my $file ( glob("$INC/FS/cdr/*.pm") ) {
+    warn "attempting to load CDR format info from $file\n" if $DEBUG;
+    $file =~ /\/(\w+)\.pm$/ or do {
+      warn "unrecognized file in $INC/FS/cdr/: $file\n";
+      next;
+    };
+    my $mod = $1;
+    my $info = eval "use FS::cdr::$mod; ".
+                    "\\%FS::cdr::$mod\::info;";
+    if ( $@ ) {
+      die "error using FS::cdr::$mod (skipping): $@\n" if $@;
+      next;
+    }
+    unless ( keys %$info ) {
+      warn "no %info hash found in FS::cdr::$mod, skipping\n";
+      next;
+    }
+    warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
+    if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
+      warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
+      next;
+    }
+    $cdr_info{$mod} = $info;
+  }
+}
+
+tie my %import_formats, 'Tie::IxHash',
+  map  { $_ => $cdr_info{$_}->{'name'} }
+  sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
+  grep { exists($cdr_info{$_}->{'import_fields'}) }
+  keys %cdr_info;
+
+sub import_formats {
+  %import_formats;
+}
+
+sub _cdr_min_parser_maker {
+  my $field = shift;
+  my @fields = ref($field) ? @$field : ($field);
+  @fields = qw( billsec duration ) unless scalar(@fields);
+  return sub {
+    my( $cdr, $min ) = @_;
+    my $sec = eval { _cdr_min_parse($min) };
+    die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
+    $cdr->$_($sec) foreach @fields;
+  };
+}
+
+sub _cdr_min_parse {
+  my $min = shift;
+  sprintf('%.0f', $min * 60 );
+}
 
 sub _cdr_date_parser_maker {
   my $field = shift;
   return sub {
     my( $cdr, $date ) = @_;
-    $cdr->$field( _cdr_date_parse($date) );
+    #$cdr->$field( _cdr_date_parse($date) );
+    eval { $cdr->$field( _cdr_date_parse($date) ); };
+    die "error parsing date for $field from $date: $@\n" if $@;
   };
 }
 
@@ -459,107 +579,38 @@ sub _cdr_date_parse {
 
   return '' unless length($date); #that's okay, it becomes NULL
 
+  my($year, $mon, $day, $hour, $min, $sec);
+
   #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
-  $date =~ /^\s*(\d{4})\D(\d{1,2})\D(\d{1,2})\s+(\d{1,2})\D(\d{1,2})\D(\d{1,2})\s*$/
-    or die "unparsable date: $date"; #maybe we shouldn't die...
-  my($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
+  #taqua  #2007-10-31 08:57:24.113000000
+
+  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|$)/ ) {
+    ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
+  } 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|$)/ ) {
+    ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
+  } else {
+     die "unparsable date: $date"; #maybe we shouldn't die...
+  }
+
+  return '' if $year == 1900 && $mon == 1 && $day == 1
+            && $hour == 0    && $min == 0 && $sec == 0;
 
   timelocal($sec, $min, $hour, $day, $mon-1, $year);
 }
 
-#http://www.the-asterisk-book.com/unstable/funktionen-cdr.html
-my %amaflags = (
-  DEFAULT       => 0,
-  OMIT          => 1, #asterisk 1.4+
-  IGNORE        => 1, #asterisk 1.2
-  BILLING       => 2, #asterisk 1.4+
-  BILL          => 2, #asterisk 1.2
-  DOCUMENTATION => 3,
-  #? '' => 0,
-);
+=item batch_import HASHREF
 
-my %import_formats = (
-  'asterisk' => [
-    'accountcode',
-    'src',
-    'dst',
-    'dcontext',
-    'clid',
-    'channel',
-    'dstchannel',
-    'lastapp',
-    'lastdata',
-    _cdr_date_parser_maker('startdate'),
-    _cdr_date_parser_maker('answerdate'),
-    _cdr_date_parser_maker('enddate'),
-    'duration',
-    'billsec',
-    'disposition',
-    sub { my($cdr, $amaflags) = @_; $cdr->amaflags($amaflags{$amaflags}); },
-    'uniqueid',
-    'userfield',
-  ],
-  'unitel' => [
-    'uniqueid',
-    #'cdr_type',
-    'cdrtypenum',
-    'calldate', # may need massaging?  huh maybe not...
-    #'billsec', #XXX duration and billsec?
-                sub { $_[0]->billsec(  $_[1] );
-                      $_[0]->duration( $_[1] );
-                    },
-    'src',
-    'dst', # XXX needs to have "+61" prepended unless /^\+/ ???
-    'charged_party',
-    'upstream_currency',
-    'upstream_price',
-    'upstream_rateplanid',
-    'distance',
-    'islocal',
-    'calltypenum',
-    'startdate',  #XXX needs massaging
-    'enddate',    #XXX same
-    'description',
-    'quantity',
-    'carrierid',
-    'upstream_rateid',
-  ],
-  'simple' => [
+Imports CDR records.  Available options are:
 
-    # Date
-    sub { my($cdr, $date) = @_;
-          $date =~ /^(\d{1,2})\/(\d{1,2})\/(\d\d(\d\d)?)$/
-            or die "unparsable date: $date"; #maybe we shouldn't die...
-          #$cdr->startdate( timelocal(0, 0, 0 ,$2, $1-1, $3) );
-          ($tmp_mday, $tmp_mon, $tmp_year) = ( $2, $1-1, $3 );
-        },
-
-    # Time
-    sub { my($cdr, $time) = @_;
-          #my($sec, $min, $hour, $mday, $mon, $year)= localtime($cdr->startdate);
-          $time =~ /^(\d{1,2}):(\d{1,2}):(\d{1,2})$/
-            or die "unparsable time: $time"; #maybe we shouldn't die...
-          #$cdr->startdate( timelocal($3, $2, $1 ,$mday, $mon, $year) );
-          $cdr->startdate(
-            timelocal($3, $2, $1 ,$tmp_mday, $tmp_mon, $tmp_year)
-          );
-        },
-
-    # Source_Number
-    'src',
-
-    # Terminating_Number
-    'dst',
-
-    # Duration
-    sub { my($cdr, $min) = @_;
-          my $sec = sprintf('%.0f', $min * 60 );
-          $cdr->billsec(  $sec );
-          $cdr->duration( $sec );
-        },
+=over 4
 
-  ],
-);
+=item filehandle
+
+=item format
+
+=back
+
+=cut
 
 sub batch_import {
   my $param = shift;
@@ -567,12 +618,26 @@ sub batch_import {
   my $fh = $param->{filehandle};
   my $format = $param->{format};
 
-  return "Unknown format $format" unless exists $import_formats{$format};
-
-  eval "use Text::CSV_XS;";
-  die $@ if $@;
-
-  my $csv = new Text::CSV_XS;
+  return "Unknown format $format"
+    unless exists( $cdr_info{$format} )
+        && exists( $cdr_info{$format}->{'import_fields'} );
+
+  my $info = $cdr_info{$format};
+
+  my $type = exists($info->{'type'}) ? lc($info->{'type'}) : 'csv';
+
+  my $parser;
+  if ( $type eq 'csv' ) {
+    eval "use Text::CSV_XS;";
+    die $@ if $@;
+    $parser = new Text::CSV_XS;
+  } elsif ( $type eq 'fixedlength' ) {
+    eval "use Parse::FixedLength;";
+    die $@ if $@;
+    $parser = new Parse::FixedLength $info->{'fixedlength_format'};
+  } else {
+    die "Unknown CDR format type $type for format $format\n";
+  }
 
   my $imported = 0;
   #my $columns;
@@ -588,28 +653,34 @@ sub batch_import {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  if ( $format eq 'simple' ) { # and other formats with a header too?
-
-  }
+  my $header_lines = exists($info->{'header'}) ? $info->{'header'} : 0;
 
-  my $body = 0;
   my $line;
   while ( defined($line=<$fh>) ) {
 
-    #skip header...
-    if ( ! $body++ && $format eq 'simple' && $line =~ /^[\w\, ]+$/ ) {
-      next;
-    }
+    next if $header_lines-- > 0; #&& $line =~ /^[\w, "]+$/ 
 
-    $csv->parse($line) or do {
-      $dbh->rollback if $oldAutoCommit;
-      return "can't parse: ". $csv->error_input();
-    };
+    my @columns = ();
+    if ( $type eq 'csv' ) {
+
+      $parser->parse($line) or do {
+        $dbh->rollback if $oldAutoCommit;
+        return "can't parse: ". $parser->error_input();
+      };
+
+      @columns = $parser->fields();
+
+    } elsif ( $type eq 'fixedlength' ) {
+
+      @columns = $parser->parse($line);
+
+    } else {
+      die "Unknown CDR format type $type for format $format\n";
+    }
 
-    my @columns = $csv->fields();
     #warn join('-',@columns);
 
-    if ( $format eq 'simple' ) {
+    if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
       @columns = map { s/^ +//; $_; } @columns;
     }
 
@@ -626,7 +697,7 @@ sub batch_import {
         }
 
       }
-      @{ $import_formats{$format} }
+      @{ $info->{'import_fields'} }
     ;
 
     my $cdr = new FS::cdr ( \%cdr );
@@ -637,6 +708,15 @@ sub batch_import {
       &{$sub}($cdr, $data);  # $cdr->&{$sub}($data); 
     }
 
+    if ( $format eq 'taqua' ) { #should be a callback or opt in FS::cdr::taqua
+      if ( $cdr->enddate && $cdr->startdate  ) { #a bit more?
+        $cdr->duration( $cdr->enddate - $cdr->startdate  );
+      }
+      if ( $cdr->enddate && $cdr->answerdate ) { #a bit more?
+        $cdr->billsec(  $cdr->enddate - $cdr->answerdate );
+      } 
+    }
+
     my $error = $cdr->insert;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;