VoipNow export, #11170

8 files changed, 585 insertions, 1 deletions

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<FS::Record>, 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
+<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;
+
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';
 
 </%init>