optionally calculate Suretax taxes based only on the service location, #32043
[freeside.git] / 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;