From e3a2ca0a7ef6e0931283136321ba8c1494b37c19 Mon Sep 17 00:00:00 2001 From: mark Date: Tue, 1 Mar 2011 04:09:22 +0000 Subject: [PATCH] VoipNow export, #11170 --- FS/FS/Mason.pm | 1 + FS/FS/Schema.pm | 12 ++ FS/FS/areacode.pm | 130 +++++++++++++ FS/FS/part_export/voipnow_did.pm | 369 ++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 8 + FS/t/areacode.t | 5 + bin/populate-areacodes | 56 ++++++ httemplate/elements/select-did.html | 5 +- 8 files changed, 585 insertions(+), 1 deletion(-) create mode 100644 FS/FS/areacode.pm create mode 100644 FS/FS/part_export/voipnow_did.pm create mode 100644 FS/t/areacode.t create mode 100644 bin/populate-areacodes diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index b27c266a9..49980924f 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -271,6 +271,7 @@ if ( -e $addl_handler_use_file ) { use FS::did_order; use FS::torrus_srvderive; use FS::torrus_srvderive_component; + use FS::areacode; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 512b9c369..ecfb0e4d2 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -3266,6 +3266,18 @@ sub tables_hashref { 'index' => [], #recnum }, + 'areacode' => { + 'columns' => [ + 'code', 'char', '', 3, '', '', + 'country', 'char', 'NULL', 2, '', '', + 'state', 'char', 'NULL', 2, '', '', + 'description','varchar', 'NULL', 255, '', '', + ], + 'primary_key' => 'code', + 'unique' => [], + 'index' => [], + }, + %{ tables_hashref_torrus() }, # tables of ours for doing torrus virtual port combining diff --git a/FS/FS/areacode.pm b/FS/FS/areacode.pm new file mode 100644 index 000000000..58b498c09 --- /dev/null +++ b/FS/FS/areacode.pm @@ -0,0 +1,130 @@ +package FS::areacode; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::areacode - Object methods for areacode records + +=head1 SYNOPSIS + + use FS::areacode; + + $record = new FS::areacode \%hash; + $record = new FS::areacode { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::areacode object represents an example. FS::areacode inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item code + +area code (primary key) + +=item country + +two-letter country code + +=item state + +two-letter state code, if appropriate + +=item description + +description (optional) + + +=back + +=head1 METHODS + +=over 4 + +=cut + +sub table { 'areacode'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_number('code') + || $self->ut_text('country') + || $self->ut_textn('state') + || $self->ut_textn('description') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 CLASS METHODS + +locate CODE + +Returns the country, state, and description for an area code. + +=cut + +sub locate { + my $class = shift; + my $code = shift; + my $areacode = qsearchs('areacode', { code => $code }) + or return (); + return ($areacode->country, $areacode->state, $areacode->description); +} + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_export/voipnow_did.pm b/FS/FS/part_export/voipnow_did.pm new file mode 100644 index 000000000..cd13a44d5 --- /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 +XML::Writer +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; + diff --git a/FS/MANIFEST b/FS/MANIFEST index 0c82337c7..fce790346 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -527,6 +527,10 @@ FS/cgp_rule_condition.pm t/cgp_rule_condition.t FS/cgp_rule_action.pm t/cgp_rule_action.t +FS/rate_time.pm +t/rate_time.t +FS/rate_time_interval.pm +t/rate_time_interval.t FS/msg_template.pm t/msg_template.t FS/cust_tag.pm @@ -570,3 +574,7 @@ FS/torrus_srvderive.pm t/torrus_srvderive.t FS/torrus_srvderive_component.pm t/torrus_srvderive_component.t +FS/areacode.pm +t/areacode.t +FS/areacode.pm +t/areacode.t diff --git a/FS/t/areacode.t b/FS/t/areacode.t new file mode 100644 index 000000000..6afcb4350 --- /dev/null +++ b/FS/t/areacode.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::areacode; +$loaded=1; +print "ok 1\n"; diff --git a/bin/populate-areacodes b/bin/populate-areacodes new file mode 100644 index 000000000..f5e8ae105 --- /dev/null +++ b/bin/populate-areacodes @@ -0,0 +1,56 @@ +#!/usr/bin/perl + +use FS::UID qw(adminsuidsetup dbh); +use FS::Record; +use FS::areacode; +use Locale::SubCountry; + +my $fsuser = shift @ARGV or die $usage; +my $path = shift @ARGV or die $usage; + +adminsuidsetup($fsuser); +local $FS::UID::AutoCommit = 0; +my $dbh = dbh; + +#horribly inefficient but you only have to do it once +my %state_to_country; +my $world = Locale::SubCountry::World->new; +foreach my $countrycode (qw(US CA MX)) { + my $c = Locale::SubCountry->new($countrycode); + next if !$c->has_sub_countries; + $state_to_country{uc $_} = $countrycode foreach $c->all_full_names; +} +my %name_to_country = $world->full_name_code_hash; + +my $fh; +open $fh, '<', $path + or die "couldn't open $path\n"; +while(<$fh>) { + my ($npa, $statecode, $statename, $desc) = + /^(\d{3}) ([A-Z]{2}) ([\w\s]*\w) \(([^)]*)\)/; + if (!$npa) { + warn "couldn't read $_"; + next; + } + my $countrycode = $state_to_country{uc $statename} || + $name_to_country{uc $statename}; + if (!$countrycode) { + warn "couldn't find country for $statename\n"; + next; + } + + my $areacode = FS::areacode->new({ + 'npa' => $npa, + 'state' => $statecode, + 'country' => $countrycode, + 'description' => $desc, + }); + my $error = $areacode->insert; + if ($error) { + $dbh->rollback; + die $error; + } + print "$npa => $statecode, $countrycode\n"; +} +$dbh->commit; + diff --git a/httemplate/elements/select-did.html b/httemplate/elements/select-did.html index 6cc63b961..dd2e8e531 100644 --- a/httemplate/elements/select-did.html +++ b/httemplate/elements/select-did.html @@ -99,7 +99,6 @@ Example: my %opt = @_; my $conf = new FS::Conf; -my $country = $conf->config('countrydefault') || 'US'; #false laziness w/tr-select-did.html #XXX make sure this comes through on errors too @@ -122,6 +121,10 @@ $export = $exports[0] if scalar(@exports); my $bulknum = $opt{'bulknum'} || 0; +my $country = $export->option('country') || + $conf->config('countrydefault') || + 'US'; + #my $field = $opt{'field'} || 'phonenum'; -- 2.11.0