FS/FS/part_export/pbxware.pm

   1 package FS::part_export::pbxware;
   2
   3 use base qw( FS::part_export );
   4 use strict;
   5
   6 use Tie::IxHash;
   7 use LWP::UserAgent;
   8 use Cpanel::JSON::XS;
   9 use HTTP::Request::Common;
  10 use Digest::MD5 qw(md5_hex);
  11 use FS::Record qw(dbh);
  12 use FS::cdr_batch;
  13
  14 our $me = '[pbxware]';
  15 our $DEBUG = 0;
  16 # our $DEBUG = 1; # log requests
  17 # our $DEBUG = 2; # log requests and content of replies
  18
  19 tie my %options, 'Tie::IxHash',
  20   'apikey'   => { label => 'API key' },
  21   'debug'    => { label => 'Enable debugging', type => 'checkbox', value => 1 },
  22   'ext'      => { label => 'PBXware "ext" field in CDR download request', },
  23   'cdrtype'  => { label => 'PBXware "cdrtype" field in CDR download request', },
  24   'trunkdst' => { label => 'PBXware "trunkdst" field in CDR download request', },
  25 ;
  26
  27 our %info = (
  28   'svc'         => [qw(svc_phone)],
  29   'desc'        => 'Retrieve CDRs from Bicom PBXware',
  30   'options'     => \%options,
  31   'notes' => <<'END'
  32 <P>Export to <a href="www.bicomsystems.com/pbxware-3-8">Bicom PBXware</a>
  33 softswitch.</P>
  34 <P><I>This export does not yet provision services.</I> Currently you will need
  35 to provision trunks and extensions through PBXware. The export only downloads
  36 CDRs.</P>
  37 <P>Set the export machine to the name or IP address of your PBXware server,
  38 and the API key to your alphanumeric key.</P>
  39 END
  40 );
  41
  42 sub export_insert {}
  43 sub export_delete {}
  44 sub export_replace {}
  45 sub export_suspend {}
  46 sub export_unsuspend {}
  47
  48 ################
  49 # CALL DETAILS #
  50 ################
  51
  52 =item import_cdrs START, END
  53
  54 Retrieves CDRs for calls in the date range from START to END and inserts them
  55 as a new CDR batch. On success, returns a new cdr_batch object. On failure,
  56 returns an error message. If there are no new CDRs, returns nothing.
  57
  58 =cut
  59
  60 # map their column names to cdr fields
  61 # (warning: API docs are not quite accurate here)
  62 our %column_map = (
  63   'Tenant'      => 'accountcode',
  64   'From'        => 'src',
  65   'To'          => 'dst',
  66   'Date/Time'   => 'startdate',
  67   'Duration'    => 'duration',
  68   'Billing'     => 'billsec',
  69   'Cost'        => 'upstream_price', # might not be used
  70   'Status'      => 'disposition',
  71 );
  72
  73 sub import_cdrs {
  74   my ($self, $start, $end) = @_;
  75   $start ||= 0; # all CDRs ever
  76   $end ||= time;
  77   $DEBUG ||= $self->option('debug');
  78
  79   my $oldAutoCommit = $FS::UID::AutoCommit;
  80   local $FS::UID::AutoCommit = 0;
  81
  82   my $sd = DateTime->from_epoch(epoch => $start)->set_time_zone('local');
  83   my $ed = DateTime->from_epoch(epoch => $end)->set_time_zone('local');
  84
  85   my $error;
  86
  87   # Send a query.
  88   #
  89   # Other options supported:
  90   # - trunk, ext: filter by source trunk and extension
  91   # - trunkdst, extdst: filter by dest trunk and extension
  92   # - server: filter by server id
  93   # - status: filter by call status (answered, unanswered, busy, failed)
  94   # - cdrtype: filter by call direction
  95
  96   my %opt = (
  97     start     => $sd->strftime('%b-%d-%Y'),
  98     starttime => $sd->strftime('%H:%M:%S'),
  99     end       => $ed->strftime('%b-%d-%Y'),
 100     endtime   => $ed->strftime('%H:%M:%S'),
 101   );
 102
 103   $opt{$_} = $self->option($_)
 104     for grep length( $self->option($_) ), qw( ext cdrtype trunkdst );
 105
 106   # unlike Certain Other VoIP providers, this one does proper pagination if
 107   # the result set is too big to fit in a single chunk.
 108   my $page = 1;
 109   my $more = 1;
 110   my $cdr_batch;
 111
 112   do {
 113     my $result = $self->api_request('pbxware.cdr.download', \%opt);
 114     if ($result->{success} !~ /^success/i) {
 115       dbh->rollback if $oldAutoCommit;
 116       return "$me $result->{success} (downloading CDRs)";
 117     }
 118
 119     if ($result->{records} > 0 and !$cdr_batch) {
 120       # then create one
 121       my $cdrbatchname = 'pbxware-' . $self->exportnum . '-' . $ed->epoch;
 122       $cdr_batch = FS::cdr_batch->new({ cdrbatch => $cdrbatchname });
 123       $error = $cdr_batch->insert;
 124       if ( $error ) {
 125         dbh->rollback if $oldAutoCommit;
 126         return "$me $error (creating batch)";
 127       }
 128     }
 129
 130     my @names = map { $column_map{$_} } @{ $result->{header} };
 131     my $rows = $result->{csv}; # not really CSV
 132     CDR: while (my $row = shift @$rows) {
 133       # Detect duplicates. Pages are returned most-recent first, so if a
 134       # new CDR comes in between page fetches, the last row from the previous
 135       # page will get duplicated. This is normal; we just need to skip it.
 136       #
 137       # if this turns out to be too slow, we can keep a cache of the last
 138       # page's IDs or something.
 139       my $uniqueid = md5_hex(join(',',@$row));
 140       if ( FS::cdr->row_exists('uniqueid = ?', $uniqueid) ) {
 141         warn "skipped duplicate row in page $page\n" if $DEBUG;
 142         next CDR;
 143       }
 144
 145       my %hash = (
 146         cdrbatchnum => $cdr_batch->cdrbatchnum,
 147         uniqueid    => $uniqueid,
 148       );
 149       @hash{@names} = @$row;
 150       # strip non-numeric junk that sometimes gets appended to these (it
 151       # causes problems creating Freeside detail records)
 152       foreach (qw(src dst)) {
 153         $hash{$_} =~ s/\D*$//;
 154       }
 155
 156       my $cdr = FS::cdr->new(\%hash);
 157       $error = $cdr->insert;
 158       if ( $error ) {
 159         dbh->rollback if $oldAutoCommit;
 160         return "$me $error (inserting CDR: $row)";
 161       }
 162     }
 163
 164     $more = $result->{next_page};
 165     $page++;
 166     $opt{page} = $page;
 167
 168   } while ($more);
 169
 170   dbh->commit if $oldAutoCommit;
 171   return $cdr_batch;
 172 }
 173
 174 sub api_request {
 175   my $self = shift;
 176   my ($method, $content) = @_;
 177   $DEBUG ||= 1 if $self->option('debug');
 178
 179 # kludge to curb excessive paranoia in LWP 6.0+
 180 local $ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0;
 181
 182   my $url = 'https://' . $self->machine;
 183   my $request = POST($url,
 184     [ %$content,
 185       'apikey' => $self->option('apikey'),
 186       'action' => $method
 187     ]
 188   );
 189   warn "$me $method\n" if $DEBUG;
 190   warn $request->as_string."\n" if $DEBUG;
 191
 192   my $ua = LWP::UserAgent->new;
 193   my $response = $ua->request($request);
 194   if ( !$response->is_success ) {
 195     return { success => $response->content };
 196   }
 197
 198   local $@;
 199   my $decoded_response = eval { decode_json($response->content) };
 200   if ( $@ ) {
 201     die "Error parsing response:\n" . $response->content . "\n\n";
 202   }
 203   return $decoded_response;
 204 }
 205
 206 1;