summaryrefslogtreecommitdiff
path: root/FS/FS/part_export/voipnow_did.pm
diff options
context:
space:
mode:
authormark <mark>2011-03-01 04:09:22 +0000
committermark <mark>2011-03-01 04:09:22 +0000
commite3a2ca0a7ef6e0931283136321ba8c1494b37c19 (patch)
tree76a8c61c906152b8b88a558b7c79f918b13e0722 /FS/FS/part_export/voipnow_did.pm
parent39bf086cae20fa746336953f46ae7b9245f3891f (diff)
VoipNow export, #11170
Diffstat (limited to 'FS/FS/part_export/voipnow_did.pm')
-rw-r--r--FS/FS/part_export/voipnow_did.pm369
1 files changed, 369 insertions, 0 deletions
diff --git a/FS/FS/part_export/voipnow_did.pm b/FS/FS/part_export/voipnow_did.pm
new file mode 100644
index 0000000..cd13a44
--- /dev/null
+++ b/FS/FS/part_export/voipnow_did.pm
@@ -0,0 +1,369 @@
+package FS::part_export::voipnow_did;
+
+use vars qw(@ISA %info $DEBUG $CACHE);
+use Tie::IxHash;
+use FS::Record qw(qsearch qsearchs dbh);
+use FS::part_export;
+use FS::areacode;
+use XML::Writer;
+use XML::Simple 'XMLin';
+use Net::SSLeay 'post_https';
+use Cache::FileCache;
+
+use strict;
+
+$DEBUG = 0; # 1 = trace operations, 2 = dump XML
+@ISA = qw(FS::part_export);
+
+tie my %options, 'Tie::IxHash',
+ 'login' => { label=>'VoipNow client login' },
+ 'password' => { label=>'VoipNow client password' },
+ 'country' => { label=>'Country (two-letter code)' },
+;
+
+%info = (
+ 'svc' => 'svc_phone',
+ 'desc' => 'Provision phone numbers to 4PSA VoipNow softswitch',
+ 'options' => \%options,
+ 'notes' => <<'END'
+Requires installation of
+<a href="http://search.cpan.org/dist/XML-Writer">XML::Writer</a>
+from CPAN.
+END
+);
+
+sub rebless { shift; }
+
+sub did_cache {
+ my $self = shift;
+ $CACHE ||= new Cache::FileCache( {
+ 'namespace' => __PACKAGE__,
+ 'default_expires_in' => 300,
+ } );
+ return $CACHE->get($self->exportnum) || $self->reload_cache;
+}
+
+sub get_dids {
+ my $self = shift;
+ my %opt = @_;
+
+ return [] if $opt{'tollfree'}; # currently not supported
+
+ my %search = ( 'exportnum' => $self->exportnum );
+
+ my $dids = $self->did_cache;
+
+ my ($state, $npa, $nxx) = @opt{'state', 'areacode', 'exchange'};
+ $state ||= (FS::areacode->locate($npa))[1];
+
+ if ($nxx) {
+ return [ sort keys %{ $dids->{$state}->{$npa}->{"$npa-$nxx"} } ];
+ }
+ elsif ($npa) {
+ return [ sort map { "($_-XXXX)" } keys %{ $dids->{$state}->{$npa} } ];
+ }
+ elsif ($state) {
+ return [ sort keys %{ $dids->{$state} } ];
+ }
+ else {
+ return []; # nothing really to do without state
+ }
+}
+
+sub reload_cache {
+ my $self = shift;
+ warn "updating DID cache\n" if $DEBUG;
+
+ my ($response, $error) =
+ $self->voipnow_command('channel', 'GetPublicNoPoll',
+ { 'userID' => $self->userID }
+ );
+
+ warn "error updating DID cache: $error\n" if $error;
+
+ my $dids = {};
+
+ my $avail = $response->{'publicNo'}{'available'}
+ or return []; # no available numbers
+ foreach ( ref($avail) eq 'ARRAY' ? @{ $avail } : $avail ) {
+ my $did = $_->{'externalNo'};
+ $did =~ /^(\d{3})(\d{3})(\d{4})/ or die "unparseable did $did\n";
+ my $state = (FS::areacode->locate($1))[1];
+ $dids->{$state}->{$1}->{"$1-$2"}->{"$1-$2-$3"} = $_->{'ID'};
+ }
+
+ $CACHE->set($self->exportnum, $dids);
+ return $dids;
+}
+
+sub _export_insert {
+ my( $self, $svc_phone ) = (shift, shift);
+
+ # find remote DID name
+ my $phonenum = $svc_phone->phonenum;
+ $phonenum =~ /^(\d{3})(\d{3})(\d{4})/
+ or die "unparseable phone number: $phonenum";
+
+ warn "checking DID $1-$2-$3\n" if $DEBUG;
+ my $state = (FS::areacode->locate($1))[1];
+
+ my $dids = $self->did_cache;
+ my $assign_did = $dids->{$state}->{$1}->{"$1-$2"}->{"$1-$2-$3"};
+ if ( !defined($assign_did) ) {
+ $self->reload_cache; # since it's clearly out of date
+ return "phone number $phonenum not available";
+ }
+
+ # need to check existence of parent objects?
+ my $cust_pkg = $svc_phone->cust_svc->cust_pkg;
+ my $cust_main = $cust_pkg->cust_main;
+
+ # this is subject to change
+ my %add_extension = (
+ namespace('client_data',
+ name => $svc_phone->phone_name || $cust_main->contact_firstlast,
+ company => $cust_main->company,
+# to avoid collision with phone numbers, etc.--would be better to store the
+# remote identifier somewhere
+ login => 'S'.$svc_phone->svcnum,
+ password => $svc_phone->sip_password,
+ phone => $cust_main->phone,
+ fax => $cust_main->fax,
+ addresss => $cust_main->address1,
+ city => $cust_main->city,
+ pcode => $cust_main->zip,
+ country => $cust_main->country,
+ ),
+ parentID => $self->userID,
+ #region--this is a problem
+ # Other options named in the documentation:
+ #
+ # passwordAuto passwordStrength forceUpdate
+ # timezone interfaceLang notes serverID chargingIdentifier
+ # phoneLang channelRuleId templateID extensionNo extensionType
+ # parentIdentifier parentLogin fromUser fromUserIdentifier
+ # chargingPlanID chargingPlanIdentifier verbose notifyOnly
+ # scope dku accountFlag
+ );
+ my ($response, $error) =
+ $self->voipnow_command('extension', 'AddExtension', \%add_extension);
+ return "[AddExtension] $error" if $error;
+
+ my $eid = $response->{'ID'};
+ warn "Extension created with id=$eid\n" if $DEBUG;
+
+ ($response, $error) =
+ $self->voipnow_command('channel', 'AssignPublicNo',
+ { didID => $assign_did, userID => $eid }
+ );
+ return "[AssignPublicNo] $error" if $error;
+ '';
+}
+
+sub _export_replace {
+ my( $self, $new, $old ) = (shift, shift, shift);
+
+ # this could be implemented later
+ '';
+}
+
+sub _export_delete {
+ my( $self, $svc_phone ) = (shift, shift);
+
+ my $eid = $self->extensionID($svc_phone);
+ my ($response, $error) =
+ $self->voipnow_command('extension', 'DelExtension', { ID => $eid });
+ return "[DelExtension] $error" if $error;
+ # don't need to de-assign the DID separately.
+
+ '';
+}
+
+sub _export_suspend {
+ my( $self, $svc_phone ) = (shift, shift);
+ #nop for now
+ '';
+}
+
+sub _export_unsuspend {
+ my( $self, $svc_phone ) = (shift, shift);
+ #nop for now
+ '';
+}
+
+sub userID {
+ my $self = shift;
+ return $self->{'userID'} if $self->{'userID'};
+
+ my ($response, $error) = $self->voipnow_command('client', 'GetClients', {});
+ # GetClients run on a client's login returns only that client.
+ die "couldn't get userID: $error" if $error;
+ die "non-Client login specified: ".$self->option('login') if
+ ref($response->{'client'}) ne 'HASH'
+ or $response->{'client'}->{'login'} ne $self->option('login');
+ return $self->{'userID'} = $response->{'client'}->{'ID'};
+}
+
+sub extensionID {
+ # technically this returns the "extension user ID" rather than
+ # "extension ID".
+ my $self = shift;
+ my $svc_phone = shift;
+
+ my $login = 'S'.$svc_phone->svcnum;
+ my ($response, $error) =
+ $self->voipnow_command('extension', 'GetExtensions',
+ { 'filter' => $login,
+ 'parentID' => $self->userID }
+ );
+ die "couldn't get extensionID for $login: $error" if $error;
+ my $extension = '';
+
+ if ( ref($response->{'extension'}) eq 'HASH' ) {
+ $extension = $response->{'extension'};
+ }
+ elsif ( ref($response->{'extension'}) eq 'ARRAY' ) {
+ ($extension) = grep { $_->{'login'} eq $login }
+ @{ $response->{'extension'} };
+ }
+
+ die "extension $login not found" if !$extension;
+
+ warn "[extensionID] found ID ".$response->{'extension'}->{'ID'}."\n"
+ if $DEBUG;
+ return $response->{'extension'}->{'ID'};
+}
+
+my $API_VERSION = '2.5.1';
+my %namespaces = (
+ 'envelope' => 'http://schemas.xmlsoap.org/soap/envelope/',
+ 'header' => 'http://4psa.com/HeaderData.xsd/'.$API_VERSION,
+ 'channel' => 'http://4psa.com/ChannelMessages.xsd/'.$API_VERSION,
+ 'extension' => 'http://4psa.com/ExtensionMessages.xsd/'.$API_VERSION,
+ 'client' => 'http://4psa.com/ClientMessages.xsd/'.$API_VERSION,
+ 'client_data' => 'http://4psa.com/ClientData.xsd/'.$API_VERSION,
+);
+
+# Infrastructure
+# example:
+# ($result, $error) =
+# $self->voipnow_command('endpoint', 'MethodFoo', { argument => 'value' });
+# The third argument will be enclosed in a MethodFooRequest and serialized.
+# $result is everything inside the MethodFooResponse element, as a tree.
+
+sub voipnow_command {
+ my $self = shift;
+ my $endpoint = shift; # 'channel' or 'extension'
+ my $method = shift;
+ my $data = shift;
+ my $host = $self->machine;
+ my $path = "/soap2/${endpoint}_agent.php";
+
+ warn "[$method] constructing request\n" if $DEBUG;
+ my $soap_request;
+ my $writer = XML::Writer->new(
+ OUTPUT => \$soap_request,
+ NAMESPACES => 1,
+ PREFIX_MAP => { reverse %namespaces },
+ FORCED_NS_DECLS => [ values %namespaces ],
+ ENCODING => 'utf-8',
+ );
+
+ my $header = {
+ '#NS' => 'header',
+ 'userCredentials' => {
+ 'username' => $self->option('login'),
+ 'password' => $self->option('password'),
+ }
+ };
+ my $body = {
+ '#NS' => $endpoint,
+ $method.'Request' => $data,
+ };
+
+ # build the request
+ descend( $writer,
+ { Envelope => { Header => $header, Body => $body } },
+ 'envelope' #start in this namespace
+ );
+
+ warn "SENDING:\n$soap_request\n" if $DEBUG > 1;
+ my ($soap_response, $status) =
+ post_https($host, 443, $path, '', $soap_request);
+ warn "STATUS: $status\nRECEIVED:\n$soap_response\n" if $DEBUG > 1;
+ if ( !length($soap_response) ) {
+ return undef, "No response ($status)";
+ }
+
+ my $response = eval { strip_ns(XMLin($soap_response)) };
+ # handle various errors
+ if ( $@ ) {
+ return undef, "Parse error: $@";
+ }
+ if ( !exists $response->{'Body'} ) {
+ return undef, "Bad response (missing Body section)";
+ }
+ $body = $response->{'Body'};
+ if ( exists $body->{'Fault'} ) {
+ return undef, $body->{'Fault'}->{'faultstring'};
+ }
+ if ( !exists $body->{"${method}Response"} ) {
+ return undef, "Bad response (missing ${method}Response section)";
+ }
+
+ return $body->{"${method}Response"};
+}
+
+# Infra-infrastructure
+
+sub descend { # like XML::Simple, but more so
+ my $writer = shift;
+ my $tree = shift;
+ my $branch_ns = delete($tree->{'#NS'}) || shift;
+ while (my ($key, $val) = each %$tree) {
+ my ($name, $key_ns) = reverse split(':', $key);
+ $key_ns ||= $branch_ns;
+ $name = [ $namespaces{$key_ns}, $name ];
+ if ( ref($val) eq 'HASH' ) {
+ $writer->startTag($name);
+ descend($writer, $val, $key_ns);
+ $writer->endTag;
+ }
+ elsif ( defined($val) ) {
+ $writer->dataElement($name, $val);
+ }
+ else { #undef
+ $writer->emptyTag($name);
+ }
+ }
+}
+
+sub namespace {
+ my $ns = shift;
+ my %data = @_;
+ map { $ns.':'.$_ , $data{$_} } keys(%data);
+}
+
+sub strip_ns { # remove the namespace tags so that we can find stuff
+ my $tree = shift;
+ if ( ref $tree eq 'HASH' ) {
+ return +{
+ map {
+ my $name = $_;
+ $name =~ s/^.*://;
+ $name => strip_ns($tree->{$_});
+ } keys %$tree
+ }
+ }
+ elsif ( ref $tree eq 'ARRAY' ) {
+ return [
+ map { strip_ns($_) } @$tree
+ ]
+ }
+ else {
+ return $tree;
+ }
+}
+
+1;
+