FS/FS/part_export/voip_ms.pm

   1 package FS::part_export::voip_ms;
   2
   3 use base qw( FS::part_export );
   4 use strict;
   5
   6 use Tie::IxHash;
   7 use LWP::UserAgent;
   8 use URI;
   9 use URI::Escape;
  10 use Cpanel::JSON::XS;
  11 use HTTP::Request::Common;
  12 use Cache::FileCache;
  13 use FS::Record qw(dbh);
  14 use FS::Misc::DateTime qw(parse_datetime);
  15 use DateTime;
  16
  17 our $me = '[voip.ms]';
  18 our $DEBUG = 0;
  19 # our $DEBUG = 1; # log requests
  20 # our $DEBUG = 2; # log requests and content of replies
  21 our $base_url = 'https://voip.ms/api/v1/rest.php';
  22
  23 # cache cities and provinces
  24 our $CACHE; # a FileCache; their API is not as quick as I'd like
  25 our $cache_timeout = 86400; # seconds
  26
  27 tie my %options, 'Tie::IxHash',
  28   'account'         => { label => 'Main account ID' },
  29   'username'        => { label => 'API username', },
  30   'password'        => { label => 'API password', },
  31   'debug'           => { label => 'Enable debugging', type => 'checkbox', value => 1 },
  32   # could dynamically pull this from the API...
  33   'protocol'        => {
  34     label             => 'Protocol',
  35     type              => 'select',
  36     options           => [ 1, 3 ],
  37     option_labels     => { 1 => 'SIP', 3 => 'IAX' },
  38   },
  39   'auth_type'       => {
  40     label             => 'Authorization type',
  41     type              => 'select',
  42     options           => [ 1, 2 ],
  43     option_labels     => { 1 => 'User/Password', 2 => 'Static IP' },
  44   },
  45   'billing_type'    => {
  46     label             => 'DID billing mode',
  47     type              => 'select',
  48     options           => [ 1, 2 ],
  49     option_labels     => { 1 => 'Per minute', 2 => 'Flat rate' },
  50   },
  51   'device_type'     => {
  52     label             => 'Device type',
  53     type              => 'select',
  54     options           => [ 1, 2 ],
  55     option_labels     => { 1 => 'IP PBX, e.g. Asterisk',
  56                            2 => 'IP phone or softphone',
  57                          },
  58   },
  59   'canada_routing'    => {
  60     label             => 'Canada routing policy',
  61     type              => 'select',
  62     options           => [ 1, 2 ],
  63     option_labels     => { 1 => 'Value (lowest price)',
  64                            2 => 'Premium (highest quality)'
  65                          },
  66   },
  67   'international_route' => { # yes, 'route'
  68     label             => 'International routing policy',
  69     type              => 'select',
  70     options           => [ 0, 1, 2 ],
  71     option_labels     => { 0 => 'Disable international calls',
  72                            1 => 'Value (lowest price)',
  73                            2 => 'Premium (highest quality)'
  74                          },
  75   },
  76   'cnam_lookup' => {
  77     label             => 'Enable CNAM lookup on incoming calls',
  78     type              => 'checkbox',
  79   },
  80
  81 ;
  82
  83 tie my %roles, 'Tie::IxHash',
  84   'subacct'       => {  label     => 'SIP client',
  85                         svcdb     => 'svc_acct',
  86                      },
  87   'did'           => {  label     => 'DID',
  88                         svcdb     => 'svc_phone',
  89                         multiple  => 1,
  90                      },
  91 ;
  92
  93 our %info = (
  94   'svc'      => [qw( svc_acct svc_phone )],
  95   'desc'     =>
  96     'Provision subaccounts and DIDs to voip.ms wholesale',
  97   'options'  => \%options,
  98   'roles'    => \%roles,
  99   'no_machine' => 1,
 100   'notes'    => <<'END'
 101 <P>Export to <b>voip.ms</b> hosted PBX service.</P>
 102 <P>This requires two service definitions to be configured on the same package:
 103   <OL>
 104     <LI>An account service for the subaccount (the "login" used by the
 105     customer's PBX or IP phone, and the call routing service). This should
 106     be attached to the export in the "subacct" role. If you are using
 107     password authentication, the <i>username</i> and <i>_password</i> will
 108     be used to authenticate to voip.ms. If you are using static IP
 109     authentication, the <i>slipip</I> (IP address) field should be set to
 110     the address.</LI>
 111     <LI>A phone service for a DID, attached to the export in the DID role.
 112     You must select a server for the "SIP Host" field. Calls from this DID
 113     will be routed to the customer via that server.</LI>
 114   </OL>
 115 </P>
 116 <P>Export options:
 117   <UL>
 118     <LI>Main account ID: the numeric ID for the master account.
 119     Subaccount usernames will be prefixed with this number and an underscore,
 120     so if you create a subaccount in Freeside with a username of "myuser",
 121     the SIP device will have to authenticate as something like
 122     "123456_myuser".</LI>
 123     <LI>API username/password: your API login; see
 124     <a href="https://www.voip.ms/m/api.php">this page</a> to configure it
 125     if you haven't done so yet.</LI>
 126     <LI>Enable debugging: writes all traffic with the API server to the log.
 127     This includes passwords.</LI>
 128   </UL>
 129   The other options correspond to options in either the subaccount or DID
 130   configuration menu in the voip.ms portal; see documentation there for
 131   details.
 132 </P>
 133 END
 134 );
 135
 136 sub export_insert {
 137   my($self, $svc_x) = (shift, shift);
 138
 139   my $role = $self->svc_role($svc_x);
 140   if ( $role eq 'subacct' ) {
 141
 142     my $error = $self->insert_subacct($svc_x);
 143     return "$me $error" if $error;
 144
 145     my @existing_dids = ( $self->svc_with_role($svc_x, 'did') );
 146
 147     foreach my $svc_phone (@existing_dids) {
 148       $error = $self->insert_did($svc_phone, $svc_x);
 149       return "$me $error ordering DID ".$svc_phone->phonenum
 150         if $error;
 151     }
 152
 153   } elsif ( $role eq 'did' ) {
 154
 155     my $svc_acct = $self->svc_with_role($svc_x, 'subacct');
 156     return if !$svc_acct;
 157
 158     my $error = $self->insert_did($svc_x, $svc_acct);
 159     return "$me $error" if $error;
 160
 161   }
 162   '';
 163 }
 164
 165 sub export_replace {
 166   my ($self, $svc_new, $svc_old) = @_;
 167   my $role = $self->svc_role($svc_new);
 168   my $error;
 169   if ( $role eq 'subacct' ) {
 170     $error = $self->replace_subacct($svc_new, $svc_old);
 171   } elsif ( $role eq 'did' ) {
 172     $error = $self->replace_did($svc_new, $svc_old);
 173   }
 174   return "$me $error" if $error;
 175   '';
 176 }
 177
 178 sub export_delete {
 179   my ($self, $svc_x) = (shift, shift);
 180   my $role = $self->svc_role($svc_x);
 181   if ( $role eq 'subacct' ) {
 182
 183     my @existing_dids = ( $self->svc_with_role($svc_x, 'did') );
 184
 185     my $error;
 186     foreach my $svc_phone (@existing_dids) {
 187       $error = $self->delete_did($svc_phone);
 188       return "$me $error canceling DID ".$svc_phone->phonenum
 189         if $error;
 190     }
 191
 192     $error = $self->delete_subacct($svc_x);
 193     return "$me $error" if $error;
 194
 195   } elsif ( $role eq 'did' ) {
 196
 197     my $svc_acct = $self->svc_with_role($svc_x, 'subacct');
 198     return if !$svc_acct;
 199
 200     my $error = $self->delete_did($svc_x);
 201     return "$me $error" if $error;
 202
 203   }
 204   '';
 205 }
 206
 207 sub export_suspend {
 208   my $self = shift;
 209   my $svc_x = shift;
 210   my $role = $self->svc_role($svc_x);
 211   return if $role ne 'subacct'; # can't suspend DIDs directly
 212
 213   my $error = $self->replace_subacct($svc_x, $svc_x); # will disable it
 214   return "$me $error" if $error;
 215   '';
 216 }
 217
 218 sub export_unsuspend {
 219   my $self = shift;
 220   my $svc_x = shift;
 221   my $role = $self->svc_role($svc_x);
 222   return if $role ne 'subacct'; # can't suspend DIDs directly
 223
 224   $svc_x->set('unsuspended', 1); # hack to tell replace_subacct to do it
 225   my $error = $self->replace_subacct($svc_x, $svc_x); #same
 226   return "$me $error" if $error;
 227   '';
 228 }
 229
 230 ################
 231 # PROVISIONING #
 232 ################
 233
 234 sub insert_subacct {
 235   my ($self, $svc_acct) = @_;
 236   my $method = 'createSubAccount';
 237   my $content = $self->subacct_content($svc_acct);
 238
 239   my $result = $self->api_request($method, $content);
 240   if ( $result->{status} ne 'success' ) {
 241     return $result->{status}; # or look up the error message string?
 242   }
 243
 244   # result includes the account ID and the full username, but we don't
 245   # really need to keep those; we can look them up later
 246   '';
 247 }
 248
 249 sub insert_did {
 250   my ($self, $svc_phone, $svc_acct) = @_;
 251   my $method = 'orderDID';
 252   my $content = $self->did_content($svc_phone, $svc_acct);
 253   my $result = $self->api_request($method, $content);
 254   if ( $result->{status} ne 'success' ) {
 255     return $result->{status}; # or look up the error message string?
 256   }
 257   '';
 258 }
 259
 260 sub delete_subacct {
 261   my ($self, $svc_acct) = @_;
 262   my $account = $self->option('account') . '_' . $svc_acct->username;
 263
 264   my $id = $self->subacct_id($svc_acct);
 265   if ( $id =~ /\D/ ) {
 266
 267     return $id; # it's an error
 268
 269   } elsif ( $id eq '' ) {
 270
 271     return ''; # account doesn't exist, don't need to delete
 272
 273   } # else it's numeric
 274
 275   warn "$me deleting account $account with ID $id\n" if $DEBUG;
 276   my $result = $self->api_request('delSubAccount', { id => $id });
 277   if ( $result->{status} ne 'success' ) {
 278     return $result->{status};
 279   }
 280   '';
 281 }
 282
 283 sub delete_did {
 284   my ($self, $svc_phone) = @_;
 285   my $phonenum = $svc_phone->phonenum;
 286
 287   my $result = $self->api_request('cancelDID', { did => $phonenum });
 288   if ( $result->{status} ne 'success' and $result->{status} ne 'invalid_did' )
 289   {
 290     return $result->{status};
 291   }
 292   '';
 293 }
 294
 295 sub replace_subacct {
 296   my ($self, $svc_new, $svc_old) = @_;
 297   if ( $svc_new->username ne $svc_old->username ) {
 298     return "can't change account username; delete and recreate the account instead";
 299   }
 300
 301   my $id = $self->subacct_id($svc_new);
 302   if ( $id =~ /\D/ ) {
 303
 304     return $id;
 305
 306   } elsif ( $id eq '' ) {
 307
 308     # account doesn't exist; provision it anew
 309     return $self->insert_subacct($svc_new);
 310
 311   }
 312
 313   my $content = $self->subacct_content($svc_new);
 314   delete $content->{username};
 315   $content->{id} = $id;
 316
 317   my $result = $self->api_request('setSubAccount', $content);
 318   if ( $result->{status} ne 'success' ) {
 319     return $result->{status};
 320   }
 321
 322   '';
 323 }
 324
 325 sub replace_did {
 326   my ($self, $svc_new, $svc_old) = @_;
 327   if ( $svc_new->phonenum ne $svc_old->phonenum ) {
 328     return "can't change DID phone number";
 329   }
 330   # check that there's a subacct set up
 331   my $svc_acct = $self->svc_with_role($svc_new, 'subacct')
 332     or return '';
 333
 334   # check for the existing DID
 335   my $result = $self->api_request('getDIDsInfo',
 336     { did => $svc_new->phonenum }
 337   );
 338   if ( $result->{status} eq 'invalid_did' ) {
 339
 340     # provision the DID
 341     return $self->insert_did($svc_new, $svc_acct);
 342
 343   } elsif ( $result->{status} ne 'success' ) {
 344
 345     return $result->{status};
 346
 347   }
 348
 349   my $existing = $result->{dids}[0];
 350
 351   my $content = $self->did_content($svc_new, $svc_acct);
 352   if ( $content->{billing_type} == $existing->{billing_type} ) {
 353     delete $content->{billing_type}; # confuses the server otherwise
 354   }
 355   $result = $self->api_request('setDIDInfo', $content);
 356   if ( $result->{status} ne 'success' ) {
 357     return $result->{status};
 358   }
 359
 360   return '';
 361 }
 362
 363 #######################
 364 # CONVENIENCE METHODS #
 365 #######################
 366
 367 sub subacct_id {
 368   my ($self, $svc_acct) = @_;
 369   my $account = $self->option('account') . '_' . $svc_acct->username;
 370
 371   # look up the subaccount's numeric ID
 372   my $result = $self->api_request('getSubAccounts', { account => $account });
 373   if ( $result->{status} eq 'invalid_account' ) {
 374     return '';
 375   } elsif ( $result->{status} ne 'success' ) {
 376     return "$result->{status} looking up account ID";
 377   } else {
 378     return $result->{accounts}[0]{id};
 379   }
 380 }
 381
 382 sub subacct_content {
 383   my ($self, $svc_acct) = @_;
 384
 385   my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
 386
 387   my $desc = $svc_acct->finger || $svc_acct->username;
 388   my $intl = $self->option('international_route');
 389   my $lockintl = 0;
 390   if ($intl == 0) {
 391     $intl = 1; # can't send zero
 392     $lockintl = 1;
 393   }
 394
 395   my %auth;
 396   if ( $cust_pkg and $cust_pkg->susp > 0 and !$svc_acct->get('unsuspended') ) {
 397     # we can't explicitly suspend their account, so just set its password to
 398     # a partially random string that satisfies the password rules
 399     # (we still have their real password in the svc_acct record)
 400     %auth = ( auth_type => 1,
 401               password  => sprintf('Suspend-%08d', int(rand(100000000)) ),
 402             );
 403   } else {
 404     %auth = ( auth_type => $self->option('auth_type'),
 405               password  => $svc_acct->_password,
 406               ip        => $svc_acct->slipip,
 407             );
 408   }
 409   return {
 410     username            => $svc_acct->username,
 411     protocol            => $self->option('protocol'),
 412     description         => $desc,
 413     %auth,
 414     device_type         => $self->option('device_type'),
 415     canada_routing      => $self->option('canada_routing'),
 416     lock_international  => $lockintl,
 417     international_route => $intl,
 418     # sensible defaults for these
 419     music_on_hold       => 'default', # silence
 420     allowed_codecs      => 'ulaw;g729;gsm',
 421     dtmf_mode           => 'AUTO',
 422     nat                 => 'yes',
 423   };
 424 }
 425
 426 sub did_content {
 427   my ($self, $svc_phone, $svc_acct) = @_;
 428
 429   my $account = $self->option('account') . '_' . $svc_acct->username;
 430   my $phonenum = $svc_phone->phonenum;
 431   # look up POP number (for some reason this is assigned per DID...)
 432   my $sip_server = $svc_phone->sip_server
 433     or return "SIP server required";
 434   my $popnum = $self->cache('server_popnum')->{ $svc_phone->sip_server }
 435     or return "SIP server '$sip_server' is unknown";
 436   return {
 437     did                 => $phonenum,
 438     routing             => "account:$account",
 439     # secondary routing options (failovers, voicemail) are outside our
 440     # scope here
 441     # though we could support them using the "forwarddst" field?
 442     pop                 => $popnum,
 443     dialtime            => 60, # sensible default, add an option if needed
 444     cnam                => ($self->option('cnam_lookup') ? 1 : 0),
 445     note                => $svc_phone->phone_name,
 446     billing_type        => $self->option('billing_type'),
 447   };
 448 }
 449
 450 #################
 451 # DID SELECTION #
 452 #################
 453
 454 sub get_dids_npa_select { 0 } # all Canadian VoIP providers seem to have this
 455
 456 sub get_dids {
 457   my $self = shift;
 458   my %opt = @_;
 459
 460   my ($exportnum) = $self->exportnum =~ /^(\d+)$/;
 461
 462   if ( $opt{'region'} ) {
 463
 464     # return numbers (probably shouldn't cache this)
 465     my ($ratecenter, $province) = $opt{'region'} =~ /^(.*), (..)$/;
 466     my $country = $self->cache('province_country')->{ $province };
 467     my $result;
 468     if ( $country eq 'CAN' ) {
 469       $result = $self->api_insist('getDIDsCAN',
 470                                   { province => $province,
 471                                     ratecenter => $ratecenter
 472                                   }
 473                                  );
 474     } elsif ( $country eq 'USA' ) {
 475       $result = $self->api_insist('getDIDsUSA',
 476                                   { state => $province,
 477                                     ratecenter => $ratecenter
 478                                   }
 479                                  );
 480     }
 481     my @return = map { $_->{did} } @{ $result->{dids} };
 482     return \@return;
 483   } else {
 484
 485     if ( $opt{'state'} ) {
 486       my $province = $opt{'state'};
 487
 488       # cache() will refresh the cache if necessary, and die on failure.
 489       # default here is only in case someone gives us a state that
 490       # doesn't exist.
 491       return $self->cache('province_city', $province) || [];
 492
 493     } else {
 494
 495       # return a list of provinces
 496       return [
 497         @{ $self->cache('country_province')->{CAN} },
 498         @{ $self->cache('country_province')->{USA} },
 499       ];
 500     }
 501   }
 502 }
 503
 504 sub get_sip_servers {
 505   my $self = shift;
 506   return [ sort keys %{ $self->cache('server_popnum') } ];
 507 }
 508
 509 sub cache {
 510   my $self = shift;
 511   my $element = shift or return;
 512   my $province = shift;
 513
 514   $CACHE ||= Cache::FileCache->new({
 515     'cache_root' => $FS::UID::cache_dir.'/cache.'.$FS::UID::datasrc,
 516     'namespace'  => __PACKAGE__,
 517     'default_expires_in' => $cache_timeout,
 518   });
 519
 520   if ( $element eq 'province_city' ) {
 521     $element .= ".$province";
 522   }
 523   return $CACHE->get($element) || $self->reload_cache($element);
 524 }
 525
 526 sub reload_cache {
 527   my $self = shift;
 528   my $element = shift;
 529   if ( $element eq 'province_country' or $element eq 'country_province' ) {
 530     # populate provinces/states
 531
 532     my %province_country;
 533     my %country_province = ( CAN => [], USA => [] );
 534
 535     my $result = $self->api_insist('getProvinces');
 536     foreach my $province (map { $_->{province} } @{ $result->{provinces} }) {
 537       $province_country{$province} = 'CAN';
 538       push @{ $country_province{CAN} }, $province;
 539     }
 540
 541     $result = $self->api_insist('getStates');
 542     foreach my $state (map { $_->{state} } @{ $result->{states} }) {
 543       $province_country{$state} = 'USA';
 544       push @{ $country_province{USA} }, $state;
 545     }
 546
 547     $CACHE->set('province_country', \%province_country);
 548     $CACHE->set('country_province', \%country_province);
 549     return $CACHE->get($element);
 550
 551   } elsif ( $element eq 'server_popnum' ) {
 552
 553     my $result = $self->api_insist('getServersInfo');
 554     my %server_popnum;
 555     foreach (@{ $result->{servers} }) {
 556       $server_popnum{ $_->{server_hostname} } = $_->{server_pop};
 557     }
 558
 559     $CACHE->set('server_popnum', \%server_popnum);
 560     return \%server_popnum;
 561
 562   } elsif ( $element =~ /^province_city\.(\w+)$/ ) {
 563
 564     my $province = $1;
 565
 566     # then get the ratecenters for that province
 567     my $country = $self->cache('province_country')->{$province};
 568     my @ratecenters;
 569
 570     if ( $country eq 'CAN' ) {
 571
 572       my $result = $self->api_insist('getRateCentersCAN',
 573                                    { province => $province });
 574
 575       foreach (@{ $result->{ratecenters} }) {
 576         my $ratecenter = $_->{ratecenter} . ", $province"; # disambiguate
 577         push @ratecenters, $ratecenter;
 578       }
 579
 580     } elsif ( $country eq 'USA' ) {
 581
 582       my $result = $self->api_insist('getRateCentersUSA',
 583                                    { state => $province });
 584       foreach (@{ $result->{ratecenters} }) {
 585         my $ratecenter = $_->{ratecenter} . ", $province";
 586         push @ratecenters, $ratecenter;
 587       }
 588
 589     }
 590
 591     $CACHE->set($element, \@ratecenters);
 592     return \@ratecenters;
 593
 594   } else {
 595     return;
 596   }
 597 }
 598
 599 ################
 600 # CALL DETAILS #
 601 ################
 602
 603 =item import_cdrs START, END
 604
 605 Retrieves CDRs for calls in the date range from START to END and inserts them
 606 as a new CDR batch. On success, returns a new cdr_batch object. On failure,
 607 returns an error message. If there are no new CDRs, returns nothing.
 608
 609 =cut
 610
 611 sub import_cdrs {
 612   my ($self, $start, $end) = @_;
 613   $start ||= 0; # all CDRs ever
 614   $end ||= time;
 615   $DEBUG ||= $self->option('debug');
 616
 617   my $oldAutoCommit = $FS::UID::AutoCommit;
 618   local $FS::UID::AutoCommit = 0;
 619
 620   ($start, $end) = ($end, $start) if $end < $start;
 621   $start = DateTime->from_epoch(epoch => $start, time_zone => 'local');
 622   $end = DateTime->from_epoch(epoch => $end, time_zone => 'local');
 623   my $accountnum = $self->option('account');
 624   my $cdr_batch;
 625   # can't retrieve more than 92 days at a time
 626   # actually, it's even less than that; on large batches their server
 627   # sometimes cuts off in mid-sentence. so set the chunk size smaller.
 628   while ( $start < $end ) {
 629
 630     my $this_end = $start->clone;
 631     $this_end->add(days => 14);
 632     if ($this_end > $end) {
 633       $this_end = $end;
 634     }
 635
 636     my $date_from = $start->strftime('%F');
 637     my $date_to = $this_end->strftime('%F');
 638     warn "retrieving CDRs from $date_from to $date_to\n" if $DEBUG;
 639     my $timezone = $start->strftime('%z') / 100; # integer number of hours
 640     my $result = $self->api_request('getCDR', {
 641         date_from => $date_from,
 642         date_to   => $date_to,
 643         answered  => 1,
 644         noanswer  => 1,
 645         busy      => 1,
 646         failed    => 1,
 647         timezone  => $timezone,
 648     });
 649     if ( $result->{status} eq 'success' ) {
 650       if (!$cdr_batch) {
 651         # then create one
 652         my $cdrbatchname = 'voip_ms-' . $self->exportnum . '-' . $end->epoch;
 653         $cdr_batch = FS::cdr_batch->new({ cdrbatch => $cdrbatchname });
 654         my $error = $cdr_batch->insert;
 655         if ( $error ) {
 656           dbh->rollback if $oldAutoCommit;
 657           return $error;
 658         }
 659       }
 660
 661       foreach ( @{ $result->{cdr} } ) {
 662         my $uniqueid = $_->{uniqueid};
 663         # download ranges may overlap; avoid double-importing CDRs
 664         if ( FS::cdr->row_exists("uniqueid = ?", $uniqueid) ) {
 665           warn "skipped call with uniqueid = '$uniqueid' (already imported)\n"
 666             if $DEBUG;
 667           next;
 668         }
 669         # in this case, and probably in other cases in the near future,
 670         # easier to do this than to create a FS::cdr::* format module
 671         my $hash = {
 672           disposition             => $_->{disposition},
 673           calldate                => $_->{date},
 674           dst                     => $_->{destination},
 675           uniqueid                => $_->{uniqueid},
 676           upstream_price          => $_->{total},
 677           upstream_dst_regionname => $_->{description},
 678           clid                    => $_->{callerid},
 679           duration                => $_->{seconds},
 680           billsec                 => $_->{seconds},
 681           cdrbatchnum             => $cdr_batch->cdrbatchnum,
 682         };
 683         if ( $_->{date} ) {
 684           $hash->{startdate} = parse_datetime($_->{date});
 685         }
 686         if ( $_->{account} eq $accountnum ) {
 687           # calls made from the master account, not a subaccount
 688           # charged_party will be set to the source number
 689           $hash->{charged_party} = '';
 690         } elsif ( $_->{account} =~ /^${accountnum}_(\w+)$/ ) {
 691           $hash->{charged_party} = $1;
 692         } else {
 693           warn "skipped call with account = '$_->{account}'\n";
 694           next;
 695         }
 696         if ( $_->{callerid} =~ /<(\w+)>$/ ) {
 697           $hash->{src} = $1;
 698         } elsif ( $_->{callerid} =~ /^(\w+)$/ ) {
 699           $hash->{src} = $1;
 700         } else {
 701           # else what? they don't have a source number anywhere else
 702           warn "skipped call with unparseable callerid '$_->{callerid}'\n";
 703           next;
 704         }
 705
 706         my $cdr = FS::cdr->new($hash);
 707         my $error = $cdr->insert;
 708         if ( $error ) {
 709           dbh->rollback if $oldAutoCommit;
 710           return "$error (uniqueid $_->{uniqueid})";
 711         }
 712       } # foreach @{ $result->{cdr} }
 713
 714     } elsif ( $result->{status} eq 'no_cdr' ) {
 715       # normal result if there are no CDRs, duh
 716       next; # there may still be more CDRs later
 717     } else {
 718       dbh->rollback if $oldAutoCommit;
 719       return "$me error retrieving CDRs: $result->{status}";
 720     }
 721
 722     # we've retrieved and inserted this sub-batch of CDRs
 723     $start->add(days => 15);
 724   } # while ( $start < $end )
 725
 726   if ( $cdr_batch ) {
 727     dbh->commit if $oldAutoCommit;
 728     return $cdr_batch;
 729   } else {
 730     # no CDRs were ever found
 731     return;
 732   }
 733 }
 734
 735 ##############
 736 # API ACCESS #
 737 ##############
 738
 739 =item api_request METHOD, CONTENT
 740
 741 Makes a REST request with method name METHOD, and POST content CONTENT (as
 742 a hashref).
 743
 744 =cut
 745
 746 sub api_request {
 747   my $self = shift;
 748   my ($method, $content) = @_;
 749   $DEBUG ||= 1 if $self->option('debug');
 750   my $url = URI->new($base_url);
 751   $url->query_form(
 752     'method'        => $method,
 753     'api_username'  => $self->option('username'),
 754     'api_password'  => $self->option('password'),
 755     %$content
 756   );
 757
 758   my $request = GET($url,
 759     'Accept'        => 'text/json',
 760   );
 761
 762   warn "$me $method\n" if $DEBUG;
 763   warn $request->as_string ."\n" if $DEBUG > 1;
 764   my $ua = LWP::UserAgent->new;
 765   my $response = $ua->request($request);
 766   warn "$me received\n" . $response->as_string ."\n" if $DEBUG > 1;
 767   if ( !$response->is_success ) {
 768     return { status => $response->content };
 769   }
 770
 771   local $@;
 772   my $decoded_response = eval { decode_json($response->content) };
 773   if ( $@ ) {
 774     die "Error parsing response:\n" . $response->content . "\n\n";
 775   }
 776   return $decoded_response;
 777 }
 778
 779 =item api_insist METHOD, CONTENT
 780
 781 Exactly like L</api_request>, but if the returned "status" is not "success",
 782 throws an exception.
 783
 784 =cut
 785
 786 sub api_insist {
 787   my $self = shift;
 788   my $method = $_[0];
 789   my $result = $self->api_request(@_);
 790   if ( $result->{status} eq 'success' ) {
 791     return $result;
 792   } elsif ( $result->{status} ) {
 793     die "$me $method: $result->{status}\n";
 794   } else {
 795     die "$me $method: no status returned\n";
 796   }
 797 }
 798
 799 1;