export host selection per service, RT#17914
[freeside.git] / FS / FS / part_export / globalpops_voip.pm
1 package FS::part_export::globalpops_voip;
2
3 use vars qw(@ISA %info);
4 use Tie::IxHash;
5 use FS::Record qw(qsearch dbh);
6 use FS::part_export;
7 use FS::phone_avail;
8
9 @ISA = qw(FS::part_export);
10
11 tie my %options, 'Tie::IxHash',
12   'login'         => { label=>'VoIP Innovations API login' },
13   'password'      => { label=>'VoIP Innovations API password' },
14   'endpointgroup' => { label=>'VoIP Innovations endpoint group number' },
15   'dry_run'       => { label=>"Test mode - don't actually provision" },
16 ;
17
18 %info = (
19   'svc'     => 'svc_phone',
20   'desc'    => 'Provision phone numbers to VoIP Innovations (formerly GlobalPOPs VoIP)',
21   'options' => \%options,
22   'no_machine' => 1,
23   'notes'   => <<'END'
24 Requires installation of
25 <a href="http://search.cpan.org/dist/Net-GlobalPOPs-MediaServicesAPI">Net::GlobalPOPs::MediaServicesAPI</a>
26 from CPAN.
27 END
28 );
29
30 sub rebless { shift; }
31
32 sub get_dids {
33   my $self = shift;
34   my %opt = ref($_[0]) ? %{$_[0]} : @_;
35
36   my %getdids = ();
37   #  'orderby' => 'npa', #but it doesn't seem to work :/
38
39   if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers
40     %getdids = ( 'npa'   => $opt{'areacode'},
41                  'nxx'   => $opt{'exchange'},
42                );
43   } elsif ( $opt{'areacode'} ) { #return city (npa-nxx-XXXX)
44     %getdids = ( 'npa'   => $opt{'areacode'} );
45   } elsif ( $opt{'state'} ) {
46
47     my @avail = qsearch({
48       'table'    => 'phone_avail',
49       'hashref'  => { 'exportnum'   => $self->exportnum,
50                       'countrycode' => '1', #don't hardcode me when gp goes int'l
51                       'state'       => $opt{'state'},
52                     },
53       'order_by' => 'ORDER BY npa',
54     });
55
56     return [ map $_->npa, @avail ] if @avail; #return cached area codes instead
57
58     #otherwise, search for em
59     %getdids = ( 'state' => $opt{'state'} );
60
61   }
62
63   my $dids = $self->gp_command('getDIDs', %getdids);
64
65   if ( $dids->{'type'} eq 'Error' ) {
66     my $error =  "Error running VoIP Innovations getDIDs: ".
67         $dids->{'statuscode'}. ': '. $dids->{'status'}. "\n";
68     warn $error;
69     die $error;
70   }
71
72   my $search = $dids->{'search'};
73
74   if ( $search->{'statuscode'} == 302200 ) {
75     return [];
76   } elsif ( $search->{'statuscode'} != 100 ) {
77     my $error = "Error running VoIP Innovations getDIDs: ".
78                  $search->{'statuscode'}. ': '. $search->{'status'}. "\n";
79     warn $error;
80     die $error;
81   }
82
83   my @return = ();
84
85   #my $latas = $search->{state}{lata};
86   my %latas;
87   if ( grep $search->{state}{lata}{$_}, qw(name rate_center) ) {
88     %latas = map $search->{state}{lata}{$_},
89                  qw(name rate_center);
90   } else {
91     %latas = %{ $search->{state}{lata} };
92   } 
93
94   foreach my $lata ( keys %latas ) {
95
96     #warn "LATA $lata";
97     
98     #my $l = $latas{$lata};
99     #$l = $l->{rate_center} if exists $l->{rate_center};
100     
101     my $lata_dids = $self->gp_command('getDIDs', %getdids, 'lata'=>$lata);
102     my $lata_search = $lata_dids->{'search'};
103     unless ( $lata_search->{'statuscode'} == 100 ) {
104       die "Error running VoIP Innovations getDIDs: ". $lata_search->{'status'}; #die??
105     }
106    
107     my $l = $lata_search->{state}{lata}{'rate_center'};
108
109     #use Data::Dumper;
110     #warn Dumper($l);
111
112     my %rate_center;
113     if ( grep $l->{$_}, qw(name friendlyname) ) {
114       %rate_center = map $l->{$_},
115                          qw(name friendlyname);
116     } else {
117       %rate_center = %$l;
118     } 
119
120     foreach my $rate_center ( keys %rate_center ) {
121       
122       #warn "rate center $rate_center";
123
124       my $rc = $rate_center{$rate_center}; 
125       $rc = $rc->{friendlyname} if exists $rc->{friendlyname};
126
127       my @r = ();
128       if ( exists($rc->{npa}) ) {
129         @r = ($rc);
130       } else {
131         @r = map { { 'name'=>$_, %{ $rc->{$_} } }; } keys %$rc
132       }
133
134       foreach my $r (@r) {
135
136         my @npa = ();
137         if ( exists($r->{npa}{name}) ) {
138           @npa = ($r->{npa})
139         } else {
140           @npa = map { { 'name'=>$_, %{ $r->{npa}{$_} } } } keys %{ $r->{npa} };
141         }
142
143         foreach my $npa (@npa) {
144
145           if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers
146
147             #warn Dumper($npa);
148
149             my $tn = $npa->{nxx}{tn} || $npa->{nxx}{$opt{'exchange'}}{tn};
150
151             my @tn = ref($tn) eq 'ARRAY' ? @$tn : ($tn);
152             #push @return, @tn;
153             push @return,
154               map {
155                     if ( /^\s*(\d{3})(\d{3})(\d{4})\s*$/ ) {
156                       "$1-$2-$3";
157                     } else {
158                       $_;
159                     }
160                   }
161                map { ref($_) eq 'HASH' ? $_->{'content'} : $_ } #tier always 2?
162                @tn;
163
164           } elsif ( $opt{'areacode'} ) { #return city (npa-nxx-XXXX)
165
166             if ( $npa->{nxx}{name} ) {
167               @nxx = ( $npa->{nxx}{name} );
168             } else {
169               @nxx = keys %{ $npa->{nxx} };
170             }
171
172             push @return, map { $r->{name}. ' ('. $npa->{name}. "-$_-XXXX)"; }
173                               @nxx;
174
175           } elsif ( $opt{'state'} ) { #and not other things, then return areacode
176             #my $ac = $npa->{name};
177             #use Data::Dumper;
178             #warn Dumper($r) unless length($ac) == 3;
179
180             push @return, $npa->{name}
181               unless grep { $_ eq $npa->{name} } @return;
182
183           } else {
184             warn "WARNING: returning nothing for get_dids without known options"; #?
185           }
186
187         } #foreach my $npa
188
189       } #foreach my $r
190
191     } #foreach my $rate_center
192
193   } #foreach my $lata
194
195   if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers
196     @return = sort { $a cmp $b } @return; #string comparison actually dwiw
197   } elsif ( $opt{'areacode'} ) { #return city (npa-nxx-XXXX)
198     @return = sort { lc($a) cmp lc($b) } @return;
199   } elsif ( $opt{'state'} ) { #and not other things, then return areacode
200
201     #populate cache
202
203     local $SIG{HUP} = 'IGNORE';
204     local $SIG{INT} = 'IGNORE';
205     local $SIG{QUIT} = 'IGNORE';
206     local $SIG{TERM} = 'IGNORE';
207     local $SIG{TSTP} = 'IGNORE';
208     local $SIG{PIPE} = 'IGNORE';
209
210     my $oldAutoCommit = $FS::UID::AutoCommit;
211     local $FS::UID::AutoCommit = 0;
212     my $dbh = dbh;
213
214     my $errmsg = 'WARNING: error populating phone availability cache: ';
215     my $error = '';
216     foreach my $return (@return) {
217       my $phone_avail = new FS::phone_avail {
218         'exportnum'   => $self->exportnum,
219         'countrycode' => '1', #don't hardcode me when gp goes int'l
220         'state'       => $opt{'state'},
221         'npa'         => $return,
222       };
223       $error = $phone_avail->insert();
224       if ( $error ) {
225         warn $errmsg.$error;
226         last;
227       }
228     }
229
230     if ( $error ) {
231       $dbh->rollback if $oldAutoCommit;
232     } else {
233       $dbh->commit or warn $errmsg.$dbh->errstr if $oldAutoCommit;
234     }
235
236     #end populate cache
237
238     #@return = sort { (split(' ', $a))[0] <=> (split(' ', $b))[0] } @return;
239     @return = sort { $a <=> $b } @return;
240   } else {
241     warn "WARNING: returning nothing for get_dids without known options"; #?
242   }
243
244   \@return;
245
246 }
247
248 sub gp_command {
249   my( $self, $command, @args ) = @_;
250
251   eval "use Net::GlobalPOPs::MediaServicesAPI 0.03;";
252   if ( $@ ) {
253     warn $@;
254     die $@;
255   }
256
257   my $gp = Net::GlobalPOPs::MediaServicesAPI->new(
258     'login'    => $self->option('login'),
259     'password' => $self->option('password'),
260     #'debug'    => $debug,
261   );
262
263   $gp->$command(@args);
264 }
265
266
267 sub _export_insert {
268   my( $self, $svc_phone ) = (shift, shift);
269
270   return '' if $self->option('dry_run');
271
272   #we want to provision and catch errors now, not queue
273
274   my $r = $self->gp_command('reserveDID',
275     'did'           => $svc_phone->phonenum,
276     'minutes'       => 1,
277     'endpointgroup' => $self->option('endpointgroup'),
278   );
279
280   my $rdid = $r->{did};
281
282   if ( $rdid->{'statuscode'} != 100 ) {
283     return "Error running VoIP Innovations reserveDID: ".
284            $rdid->{'statuscode'}. ': '. $rdid->{'status'};
285   }
286
287   my $a = $self->gp_command('assignDID',
288     'did'           => $svc_phone->phonenum,
289     'endpointgroup' => $self->option('endpointgroup'),
290     #'rewrite'
291     #'cnam'
292   );
293
294   my $adid = $a->{did};
295
296   if ( $adid->{'statuscode'} != 100 ) {
297     return "Error running VoIP Innovations assignDID: ".
298            $adid->{'statuscode'}. ': '. $adid->{'status'};
299   }
300
301   '';
302 }
303
304 sub _export_replace {
305   my( $self, $new, $old ) = (shift, shift, shift);
306
307   #hmm, what's to change?
308   '';
309 }
310
311 sub _export_delete {
312   my( $self, $svc_phone ) = (shift, shift);
313
314   return '' if $self->option('dry_run');
315
316   #probably okay to queue the deletion...?
317   #but hell, let's do it inline anyway, who wants phone numbers hanging around
318
319   my $r = $self->gp_command('releaseDID',
320     'did'           => $svc_phone->phonenum,
321   );
322
323   my $rdid = $r->{did};
324
325   if ( $rdid->{'statuscode'} != 100 ) {
326     return "Error running VoIP Innovations releaseDID: ".
327            $rdid->{'statuscode'}. ': '. $rdid->{'status'};
328   }
329
330   '';
331 }
332
333 sub _export_suspend {
334   my( $self, $svc_phone ) = (shift, shift);
335   #nop for now
336   '';
337 }
338
339 sub _export_unsuspend {
340   my( $self, $svc_phone ) = (shift, shift);
341   #nop for now
342   '';
343 }
344
345 #hmm, might forgo queueing entirely for most things, data is too much of a pita
346 #sub globalpops_voip_queue {
347 #  my( $self, $svcnum, $method ) = (shift, shift, shift);
348 #  my $queue = new FS::queue {
349 #    'svcnum' => $svcnum,
350 #    'job'    => 'FS::part_export::globalpops_voip::globalpops_voip_command',
351 #  };
352 #  $queue->insert(
353 #    $self->option('login'),
354 #    $self->option('password'),
355 #    $method,
356 #    @_,
357 #  );
358 #}
359
360 sub globalpops_voip_command {
361   my($login, $password, $method, @args) = @_;
362
363   eval "use Net::GlobalPOPs::MediaServicesAPI 0.03;";
364   die $@ if $@;
365
366   my $gp = new Net::GlobalPOPs
367                  'login'    => $login,
368                  'password' => $password,
369                  #'debug'    => 1,
370                ;
371
372   my $return = $gp->$method( @args );
373
374   #$return->{'status'} 
375   #$return->{'statuscode'} 
376
377   die $return->{'status'} if $return->{'statuscode'};
378
379 }
380
381 1;
382