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 JSON;
  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     description         => $desc,
 412     %auth,
 413     device_type         => $self->option('device_type'),
 414     canada_routing      => $self->option('canada_routing'),
 415     lock_international  => $lockintl,
 416     international_route => $intl,
 417     # sensible defaults for these
 418     music_on_hold       => 'default', # silence
 419     allowed_codecs      => 'ulaw;g729;gsm',
 420     dtmf_mode           => 'AUTO',
 421     nat                 => 'yes',
 422   };
 423 }
 424
 425 sub did_content {
 426   my ($self, $svc_phone, $svc_acct) = @_;
 427
 428   my $account = $self->option('account') . '_' . $svc_acct->username;
 429   my $phonenum = $svc_phone->phonenum;
 430   # look up POP number (for some reason this is assigned per DID...)
 431   my $sip_server = $svc_phone->sip_server
 432     or return "SIP server required";
 433   my $popnum = $self->cache('server_popnum')->{ $svc_phone->sip_server }
 434     or return "SIP server '$sip_server' is unknown";
 435   return {
 436     did                 => $phonenum,
 437     routing             => "account:$account",
 438     # secondary routing options (failovers, voicemail) are outside our
 439     # scope here
 440     # though we could support them using the "forwarddst" field?
 441     pop                 => $popnum,
 442     dialtime            => 60, # sensible default, add an option if needed
 443     cnam                => ($self->option('cnam_lookup') ? 1 : 0),
 444     note                => $svc_phone->phone_name,
 445     billing_type        => $self->option('billing_type'),
 446   };
 447 }
 448
 449 #################
 450 # DID SELECTION #
 451 #################
 452
 453 sub get_dids_npa_select { 0 } # all Canadian VoIP providers seem to have this
 454
 455 sub get_dids {
 456   my $self = shift;
 457   my %opt = @_;
 458
 459   my ($exportnum) = $self->exportnum =~ /^(\d+)$/;
 460
 461   if ( $opt{'region'} ) {
 462
 463     # return numbers (probably shouldn't cache this)
 464     my ($ratecenter, $province) = $opt{'region'} =~ /^(.*), (..)$/;
 465     my $country = $self->cache('province_country')->{ $province };
 466     my $result;
 467     if ( $country eq 'CAN' ) {
 468       $result = $self->api_insist('getDIDsCAN',
 469                                   { province => $province,
 470                                     ratecenter => $ratecenter
 471                                   }
 472                                  );
 473     } elsif ( $country eq 'USA' ) {
 474       $result = $self->api_insist('getDIDsUSA',
 475                                   { state => $province,
 476                                     ratecenter => $ratecenter
 477                                   }
 478                                  );
 479     }
 480     my @return = map { $_->{did} } @{ $result->{dids} };
 481     return \@return;
 482   } else {
 483
 484     if ( $opt{'state'} ) {
 485       my $province = $opt{'state'};
 486
 487       # cache() will refresh the cache if necessary, and die on failure.
 488       # default here is only in case someone gives us a state that
 489       # doesn't exist.
 490       return $self->cache('province_city', $province) || [];
 491
 492     } else {
 493
 494       # return a list of provinces
 495       return [
 496         @{ $self->cache('country_province')->{CAN} },
 497         @{ $self->cache('country_province')->{USA} },
 498       ];
 499     }
 500   }
 501 }
 502
 503 sub get_sip_servers {
 504   my $self = shift;
 505   return [ sort keys %{ $self->cache('server_popnum') } ];
 506 }
 507
 508 sub cache {
 509   my $self = shift;
 510   my $element = shift or return;
 511   my $province = shift;
 512
 513   $CACHE ||= Cache::FileCache->new({
 514     'cache_root' => $FS::UID::cache_dir.'/cache.'.$FS::UID::datasrc,
 515     'namespace'  => __PACKAGE__,
 516     'default_expires_in' => $cache_timeout,
 517   });
 518
 519   if ( $element eq 'province_city' ) {
 520     $element .= ".$province";
 521   }
 522   return $CACHE->get($element) || $self->reload_cache($element);
 523 }
 524
 525 sub reload_cache {
 526   my $self = shift;
 527   my $element = shift;
 528   if ( $element eq 'province_country' or $element eq 'country_province' ) {
 529     # populate provinces/states
 530
 531     my %province_country;
 532     my %country_province = ( CAN => [], USA => [] );
 533
 534     my $result = $self->api_insist('getProvinces');
 535     foreach my $province (map { $_->{province} } @{ $result->{provinces} }) {
 536       $province_country{$province} = 'CAN';
 537       push @{ $country_province{CAN} }, $province;
 538     }
 539
 540     $result = $self->api_insist('getStates');
 541     foreach my $state (map { $_->{state} } @{ $result->{states} }) {
 542       $province_country{$state} = 'USA';
 543       push @{ $country_province{USA} }, $state;
 544     }
 545
 546     $CACHE->set('province_country', \%province_country);
 547     $CACHE->set('country_province', \%country_province);
 548     return $CACHE->get($element);
 549
 550   } elsif ( $element eq 'server_popnum' ) {
 551
 552     my $result = $self->api_insist('getServersInfo');
 553     my %server_popnum;
 554     foreach (@{ $result->{servers} }) {
 555       $server_popnum{ $_->{server_hostname} } = $_->{server_pop};
 556     }
 557
 558     $CACHE->set('server_popnum', \%server_popnum);
 559     return \%server_popnum;
 560
 561   } elsif ( $element =~ /^province_city\.(\w+)$/ ) {
 562
 563     my $province = $1;
 564
 565     # then get the ratecenters for that province
 566     my $country = $self->cache('province_country')->{$province};
 567     my @ratecenters;
 568
 569     if ( $country eq 'CAN' ) {
 570
 571       my $result = $self->api_insist('getRateCentersCAN',
 572                                    { province => $province });
 573
 574       foreach (@{ $result->{ratecenters} }) {
 575         my $ratecenter = $_->{ratecenter} . ", $province"; # disambiguate
 576         push @ratecenters, $ratecenter;
 577       }
 578
 579     } elsif ( $country eq 'USA' ) {
 580
 581       my $result = $self->api_insist('getRateCentersUSA',
 582                                    { state => $province });
 583       foreach (@{ $result->{ratecenters} }) {
 584         my $ratecenter = $_->{ratecenter} . ", $province";
 585         push @ratecenters, $ratecenter;
 586       }
 587
 588     }
 589
 590     $CACHE->set($element, \@ratecenters);
 591     return \@ratecenters;
 592
 593   } else {
 594     return;
 595   }
 596 }
 597
 598 ################
 599 # CALL DETAILS #
 600 ################
 601
 602 =item import_cdrs START, END
 603
 604 Retrieves CDRs for calls in the date range from START to END and inserts them
 605 as a new CDR batch. On success, returns a new cdr_batch object. On failure,
 606 returns an error message. If there are no new CDRs, returns nothing.
 607
 608 =cut
 609
 610 sub import_cdrs {
 611   my ($self, $start, $end) = @_;
 612   $start ||= 0; # all CDRs ever
 613   $end ||= time;
 614   $DEBUG ||= $self->option('debug');
 615
 616   my $oldAutoCommit = $FS::UID::AutoCommit;
 617   local $FS::UID::AutoCommit = 0;
 618
 619   ($start, $end) = ($end, $start) if $end < $start;
 620   $start = DateTime->from_epoch(epoch => $start, time_zone => 'local');
 621   $end = DateTime->from_epoch(epoch => $end, time_zone => 'local');
 622   my $accountnum = $self->option('account');
 623   my $cdr_batch;
 624   # can't retrieve more than 92 days at a time
 625   # actually, it's even less than that; on large batches their server
 626   # sometimes cuts off in mid-sentence. so set the chunk size smaller.
 627   while ( $start < $end ) {
 628
 629     my $this_end = $start->clone;
 630     $this_end->add(days => 14);
 631     if ($this_end > $end) {
 632       $this_end = $end;
 633     }
 634
 635     my $date_from = $start->strftime('%F');
 636     my $date_to = $this_end->strftime('%F');
 637     warn "retrieving CDRs from $date_from to $date_to\n" if $DEBUG;
 638     my $timezone = $start->strftime('%z') / 100; # integer number of hours
 639     my $result = $self->api_request('getCDR', {
 640         date_from => $date_from,
 641         date_to   => $date_to,
 642         answered  => 1,
 643         noanswer  => 1,
 644         busy      => 1,
 645         failed    => 1,
 646         timezone  => $timezone,
 647     });
 648     if ( $result->{status} eq 'success' ) {
 649       if (!$cdr_batch) {
 650         # then create one
 651         my $cdrbatchname = 'voip_ms-' . $self->exportnum . '-' . $end->epoch;
 652         $cdr_batch = FS::cdr_batch->new({ cdrbatch => $cdrbatchname });
 653         my $error = $cdr_batch->insert;
 654         if ( $error ) {
 655           dbh->rollback if $oldAutoCommit;
 656           return $error;
 657         }
 658       }
 659
 660       foreach ( @{ $result->{cdr} } ) {
 661         my $uniqueid = $_->{uniqueid};
 662         # download ranges may overlap; avoid double-importing CDRs
 663         if ( FS::cdr->row_exists("uniqueid = ?", $uniqueid) ) {
 664           warn "skipped call with uniqueid = '$uniqueid' (already imported)\n"
 665             if $DEBUG;
 666           next;
 667         }
 668         # in this case, and probably in other cases in the near future,
 669         # easier to do this than to create a FS::cdr::* format module
 670         my $hash = {
 671           disposition             => $_->{disposition},
 672           calldate                => $_->{date},
 673           dst                     => $_->{destination},
 674           uniqueid                => $_->{uniqueid},
 675           upstream_price          => $_->{total},
 676           upstream_dst_regionname => $_->{description},
 677           clid                    => $_->{callerid},
 678           duration                => $_->{seconds},
 679           billsec                 => $_->{seconds},
 680           cdrbatchnum             => $cdr_batch->cdrbatchnum,
 681         };
 682         if ( $_->{date} ) {
 683           $hash->{startdate} = parse_datetime($_->{date});
 684         }
 685         if ( $_->{account} eq $accountnum ) {
 686           # calls made from the master account, not a subaccount
 687           # charged_party will be set to the source number
 688           $hash->{charged_party} = '';
 689         } elsif ( $_->{account} =~ /^${accountnum}_(\w+)$/ ) {
 690           $hash->{charged_party} = $1;
 691         } else {
 692           warn "skipped call with account = '$_->{account}'\n";
 693           next;
 694         }
 695         if ( $_->{callerid} =~ /<(\w+)>$/ ) {
 696           $hash->{src} = $1;
 697         } elsif ( $_->{callerid} =~ /^(\w+)$/ ) {
 698           $hash->{src} = $1;
 699         } else {
 700           # else what? they don't have a source number anywhere else
 701           warn "skipped call with unparseable callerid '$_->{callerid}'\n";
 702           next;
 703         }
 704
 705         my $cdr = FS::cdr->new($hash);
 706         my $error = $cdr->insert;
 707         if ( $error ) {
 708           dbh->rollback if $oldAutoCommit;
 709           return "$error (uniqueid $_->{uniqueid})";
 710         }
 711       } # foreach @{ $result->{cdr} }
 712
 713     } elsif ( $result->{status} eq 'no_cdr' ) {
 714       # normal result if there are no CDRs, duh
 715       next; # there may still be more CDRs later
 716     } else {
 717       dbh->rollback if $oldAutoCommit;
 718       return "$me error retrieving CDRs: $result->{status}";
 719     }
 720
 721     # we've retrieved and inserted this sub-batch of CDRs
 722     $start->add(days => 15);
 723   } # while ( $start < $end )
 724
 725   if ( $cdr_batch ) {
 726     dbh->commit if $oldAutoCommit;
 727     return $cdr_batch;
 728   } else {
 729     # no CDRs were ever found
 730     return;
 731   }
 732 }
 733
 734 ##############
 735 # API ACCESS #
 736 ##############
 737
 738 =item api_request METHOD, CONTENT
 739
 740 Makes a REST request with method name METHOD, and POST content CONTENT (as
 741 a hashref).
 742
 743 =cut
 744
 745 sub api_request {
 746   my $self = shift;
 747   my ($method, $content) = @_;
 748   $DEBUG ||= 1 if $self->option('debug');
 749   my $url = URI->new($base_url);
 750   $url->query_form(
 751     'method'        => $method,
 752     'api_username'  => $self->option('username'),
 753     'api_password'  => $self->option('password'),
 754     %$content
 755   );
 756
 757   my $request = GET($url,
 758     'Accept'        => 'text/json',
 759   );
 760
 761   warn "$me $method\n" if $DEBUG;
 762   warn $request->as_string ."\n" if $DEBUG > 1;
 763   my $ua = LWP::UserAgent->new;
 764   my $response = $ua->request($request);
 765   warn "$me received\n" . $response->as_string ."\n" if $DEBUG > 1;
 766   if ( !$response->is_success ) {
 767     return { status => $response->content };
 768   }
 769
 770   local $@;
 771   my $decoded_response = eval { decode_json($response->content) };
 772   if ( $@ ) {
 773     die "Error parsing response:\n" . $response->content . "\n\n";
 774   }
 775   return $decoded_response;
 776 }
 777
 778 =item api_insist METHOD, CONTENT
 779
 780 Exactly like L</api_request>, but if the returned "status" is not "success",
 781 throws an exception.
 782
 783 =cut
 784
 785 sub api_insist {
 786   my $self = shift;
 787   my $method = $_[0];
 788   my $result = $self->api_request(@_);
 789   if ( $result->{status} eq 'success' ) {
 790     return $result;
 791   } elsif ( $result->{status} ) {
 792     die "$me $method: $result->{status}\n";
 793   } else {
 794     die "$me $method: no status returned\n";
 795   }
 796 }
 797
 798 1;