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