sipwise export, #40097

8 files changed, 922 insertions, 7 deletions

diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index be12c03..e1ed43c 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -5857,6 +5857,7 @@ sub tables_hashref {
         'pbxsvc',                         'int', 'NULL',      '', '', '',
         'domsvc',                         'int', 'NULL',      '', '', '', 
         'locationnum',                    'int', 'NULL',      '', '', '',
+        'forward_svcnum',                 'int', 'NULL',      '', '', '',
         'forwarddst',                 'varchar', 'NULL',      15, '', '', 
         'email',                      'varchar', 'NULL',     255, '', '', 
         'lnp_status',                 'varchar', 'NULL', $char_d, '', '',
diff --git a/FS/FS/part_export/sipwise.pm b/FS/FS/part_export/sipwise.pm
new file mode 100644
index 0000000..9559648
--- /dev/null
+++ b/FS/FS/part_export/sipwise.pm
@@ -0,0 +1,818 @@
+package FS::part_export::sipwise;
+
+use base qw( FS::part_export );
+use strict;
+
+use FS::Record qw(qsearch qsearchs dbh);
+use Tie::IxHash;
+use LWP::UserAgent;
+use URI;
+use JSON::XS;
+use HTTP::Request::Common qw(GET POST PUT DELETE);
+use FS::Misc::DateTime qw(parse_datetime);
+use DateTime;
+use Number::Phone;
+use Try::Tiny;
+
+our $me = '[sipwise]';
+our $DEBUG = 0;
+
+tie my %options, 'Tie::IxHash',
+  'port'            => { label => 'Port' },
+  'username'        => { label => 'API username', },
+  'password'        => { label => 'API password', },
+  'debug'           => { label => 'Enable debugging', type => 'checkbox', value => 1 },
+  'billing_profile' => {
+    label             => 'Billing profile handle',
+    default           => 'default',
+  },
+  'subscriber_profile_set' => {
+    label             => 'Subscriber profile set name (optional)',
+  },
+  'reseller_id'     => { label => 'Reseller ID' },
+  'ssl_no_verify'   => { label => 'Skip SSL certificate validation',
+                         type  => 'checkbox',
+                       },
+;
+
+tie my %roles, 'Tie::IxHash',
+  'subscriber'    => {  label     => 'Subscriber',
+                        svcdb     => 'svc_acct',
+                        multiple  => 1,
+                     },
+  'did'           => {  label     => 'DID',
+                        svcdb     => 'svc_phone',
+                        multiple  => 1,
+                     },
+;
+
+our %info = (
+  'svc'      => [qw( svc_acct svc_phone )],
+  'desc'     => 'Provision to a Sipwise sip:provider server',
+  'options'  => \%options,
+  'roles'    => \%roles,
+  'notes'    => <<'END'
+<P>Export to a <b>sip:provider</b> server.</P>
+<P>This requires two service definitions to be configured on the same package:
+  <OL>
+    <LI>An account service for a SIP client account ("subscriber"). The
+    <i>username</i> will be the SIP username. The <i>domsvc</i> should point
+    to a domain service to use as the SIP domain name.</LI>
+    <LI>A phone service for a DID. The <i>phonenum</i> here will be a PSTN
+    number. The <i>forward_svcnum</i> field should be set to the account that
+    will receive calls at this number.
+  </OL>
+</P>
+END
+);
+
+sub export_insert {
+  my($self, $svc_x) = (shift, shift);
+
+  local $SIG{__DIE__};
+  my $error;
+  my $role = $self->svc_role($svc_x);
+  if ( $role eq 'subscriber' ) {
+
+    try { $self->insert_subscriber($svc_x) }
+    catch { $error = $_ };
+
+  } elsif ( $role eq 'did' ) {
+
+    try { $self->export_did($svc_x) }
+    catch { $error = $_ };
+
+  }
+  return "$me $error" if $error;
+  '';
+}
+
+sub export_replace {
+  my ($self, $svc_new, $svc_old) = @_;
+  local $SIG{__DIE__};
+
+  my $role = $self->svc_role($svc_new);
+
+  my $error;
+  if ( $role eq 'subscriber' ) {
+
+    try { $self->replace_subscriber($svc_new, $svc_old) }
+    catch { $error = $_ };
+
+  } elsif ( $role eq 'did' ) {
+
+    try { $self->export_did($svc_new, $svc_old) }
+    catch { $error = $_ };
+
+  }
+  return "$me $error" if $error;
+  '';
+}
+
+sub export_delete {
+  my ($self, $svc_x) = (shift, shift);
+  local $SIG{__DIE__};
+
+  my $role = $self->svc_role($svc_x);
+  my $error;
+
+  if ( $role eq 'subscriber' ) {
+
+    # no need to remove DIDs from it, just drop the subscriber record
+    try { $self->delete_subscriber($svc_x) }
+    catch { $error = $_ };
+
+  } elsif ( $role eq 'did' ) {
+
+    try { $self->export_did($svc_x) }
+    catch { $error = $_ };
+
+  }
+  return "$me $error" if $error;
+  '';
+}
+
+# logic to set subscribers to locked/active is in replace_subscriber
+
+sub export_suspend {
+  my $self = shift;
+  my $svc_x = shift;
+  my $role = $self->svc_role($svc_x);
+  my $error;
+  if ( $role eq 'subscriber' ) {
+    try { $self->replace_subscriber($svc_x, $svc_x) }
+    catch { $error = $_ };
+  }
+  return "$me $error" if $error;
+  '';
+}
+
+sub export_unsuspend {
+  my $self = shift;
+  my $svc_x = shift;
+  my $role = $self->svc_role($svc_x);
+  my $error;
+  if ( $role eq 'subscriber' ) {
+    $svc_x->set('unsuspended', 1);
+    try { $self->replace_subscriber($svc_x, $svc_x) }
+    catch { $error = $_ };
+  }
+  return "$me $error" if $error;
+  '';
+}
+
+#############
+# CUSTOMERS #
+#############
+
+=item get_customer SERVICE
+
+Returns the Sipwise customer record that should belong to SERVICE. This is
+based on the pkgnum field.
+
+=cut
+
+sub get_customer {
+  my $self = shift;
+  my $svc = shift;
+  my $pkgnum = $svc->cust_svc->pkgnum;
+  my $custid = "cust_pkg#$pkgnum";
+
+  my @cust = $self->api_query('customers', [ external_id => $custid ]);
+  warn "$me multiple customers for external_id $custid.\n" if scalar(@cust) > 1;
+  $cust[0];
+}
+
+sub find_or_create_customer {
+  my $self = shift;
+  my $svc = shift;
+  my $cust = $self->get_customer($svc);
+  return $cust if $cust;
+
+  my $cust_pkg = $svc->cust_svc->cust_pkg;
+  my $cust_main = $cust_pkg->cust_main;
+  my $cust_location = $cust_pkg->cust_location;
+  my ($email) = $cust_main->invoicing_list_emailonly;
+  die "Customer contact email required\n" if !$email;
+  my $custid = 'cust_pkg#' . $cust_pkg->pkgnum;
+
+  # find the billing profile
+  my ($billing_profile) = $self->api_query('billingprofiles',
+    [
+      'handle'        => $self->option('billing_profile'),
+      'reseller_id'   => $self->option('reseller_id'),
+    ]
+  );
+  if (!$billing_profile) {
+    die "can't find billing profile '". $self->option('billing_profile') . "'\n";
+  }
+  my $bpid = $billing_profile->{id};
+
+  # contacts unfortunately have no searchable external_id or other field
+  # like that, so we can't go location -> package -> service
+  my $contact = $self->api_create('customercontacts',
+    {
+      'city'          => $cust_location->city,
+      'company'       => $cust_main->company,
+      'country'       => $cust_location->country,
+      'email'         => $email,
+      'faxnumber'     => $cust_main->fax,
+      'firstname'     => $cust_main->first,
+      'lastname'      => $cust_main->last,
+      'mobilenumber'  => $cust_main->mobile,
+      'phonenumber'   => ($cust_main->daytime || $cust_main->night),
+      'postcode'      => $cust_location->zip,
+      'reseller_id'   => $self->option('reseller_id'),
+      'street'        => $cust_location->address1,
+    }
+  );
+
+  $cust = $self->api_create('customers',
+    {
+      'status'      => 'active',
+      'type'        => 'sipaccount',
+      'contact_id'  => $contact->{id},
+      'external_id' => $custid,
+      'billing_profile_id' => $bpid,
+    }
+  );
+
+  $cust;
+}
+
+###########
+# DOMAINS #
+###########
+
+=item find_or_create_domain DOMAIN
+
+Returns the record for the domain object named DOMAIN. If necessary, will
+create it first.
+
+=cut
+
+sub find_or_create_domain {
+  my $self = shift;
+  my $domainname = shift;
+  my ($domain) = $self->api_query('domains', [ 'domain' => $domainname ]);
+  return $domain if $domain;
+
+  $self->api_create('domains',
+    {
+      'domain'        => $domainname,
+      'reseller_id'   => $self->option('reseller_id'),
+    }
+  );
+}
+
+########
+# DIDS #
+########
+
+=item acct_for_did SVC_PHONE
+
+Returns the subscriber svc_acct linked to SVC_PHONE.
+
+=cut
+
+sub acct_for_did {
+  my $self = shift;
+  my $svc_phone = shift;
+  my $svcnum = $svc_phone->forward_svcnum or return;
+  my $svc_acct = FS::svc_acct->by_key($svcnum) or return;
+  $self->svc_role($svc_acct) eq 'subscriber' or return;
+  $svc_acct;
+}
+
+=item export_did NEW, OLD
+
+Refreshes the subscriber information for the service the DID was linked to
+previously, and the one it's linked to now.
+
+=cut
+
+sub export_did {
+  my $self = shift;
+  my ($new, $old) = @_;
+  if ( $old and $new->forward_svcnum ne $old->forward_svcnum ) {
+    my $old_svc_acct = $self->acct_for_did($old);
+    $self->replace_subscriber( $old_svc_acct ) if $old_svc_acct;
+  }
+  my $new_svc_acct = $self->acct_for_did($new);
+  $self->replace_subscriber( $new_svc_acct ) if $new_svc_acct;
+}
+
+###############
+# SUBSCRIBERS #
+###############
+
+=item get_subscriber SVC
+
+Gets the subscriber record for SVC, if there is one.
+
+=cut
+
+sub get_subscriber {
+  my $self = shift;
+  my $svc = shift;
+
+  my $svcnum = $svc->svcnum;
+  my $svcid = "svc#$svcnum";
+
+  my $pkgnum = $svc->cust_svc->pkgnum;
+  my $custid = "cust_pkg#$pkgnum";
+
+  my @subscribers = grep { $_->{external_id} eq $svcid }
+    $self->api_query('subscribers',
+      [ 'customer_external_id' => $custid ]
+    );
+  warn "$me multiple subscribers for external_id $svcid.\n"
+    if scalar(@subscribers) > 1;
+
+  $subscribers[0];
+}
+
+# internal method: find DIDs that forward to this service
+
+sub did_numbers_for_svc {
+  my $self = shift;
+  my $svc = shift;
+  my @numbers;
+  my @dids = qsearch({
+      'table'     => 'svc_phone',
+      'hashref'   => { 'forward_svcnum' => $svc->svcnum }
+  });
+  foreach my $did (@dids) {
+    # only include them if they're interesting to this export
+    if ( $self->svc_role($did) eq 'did' ) {
+      my $phonenum;
+      if ($did->countrycode) {
+        $phonenum = Number::Phone->new('+' . $did->countrycode . $did->phonenum);
+      } else {
+        # the long way
+        my $country = $did->cust_svc->cust_pkg->cust_location->country;
+        $phonenum = Number::Phone->new($country, $did->phonenum);
+      }
+      if (!$phonenum) {
+        die "Can't process phonenum ".$did->countrycode . $did->phonenum . "\n";
+      }
+      push @numbers,
+        { 'cc' => $phonenum->country_code,
+          'ac' => $phonenum->areacode,
+          'sn' => $phonenum->subscriber
+        };
+    }
+  }
+  @numbers;
+}
+
+sub get_subscriber_profile_set_id {
+  my $self = shift;
+  if ( my $setname = $self->option('subscriber_profile_set') ) {
+    my ($set) = $self->api_query('subscriberprofilesets',
+      [ name => $setname ]
+    );
+    die "Subscriber profile set '$setname' not found" unless $set;
+    return $set->{id};
+  }
+  '';
+}
+
+sub insert_subscriber {
+  my $self = shift;
+  my $svc = shift;
+
+  my $cust = $self->find_or_create_customer($svc);
+  my $svcid = "svc#" . $svc->svcnum;
+  my $status = $svc->cust_svc->cust_pkg->susp ? 'locked' : 'active';
+  $status = 'active' if $svc->get('unsuspended');
+  my $domain = $self->find_or_create_domain($svc->domain);
+
+  my @numbers = $self->did_numbers_for_svc($svc);
+  my $first_number = shift @numbers;
+
+  my $profile_set_id = $self->get_subscriber_profile_set_id;
+  my $subscriber = $self->api_create('subscribers',
+    {
+      'alias_numbers'   => \@numbers,
+      'customer_id'     => $cust->{id},
+      'display_name'    => $svc->finger,
+      'domain_id'       => $domain->{id},
+      'external_id'     => $svcid,
+      'password'        => $svc->_password,
+      'primary_number'  => $first_number,
+      'profile_set_id'  => $profile_set_id,
+      'status'          => $status,
+      'username'        => $svc->username,
+    }
+  );
+}
+
+sub replace_subscriber {
+  my $self = shift;
+  my $svc = shift;
+  my $old = shift || $svc->replace_old;
+  my $svcid = "svc#" . $svc->svcnum;
+
+  my $cust = $self->find_or_create_customer($svc);
+  my $status = $svc->cust_svc->cust_pkg->susp ? 'locked' : 'active';
+  $status = 'active' if $svc->get('unsuspended');
+  my $domain = $self->find_or_create_domain($svc->domain);
+  
+  my @numbers = $self->did_numbers_for_svc($svc);
+  my $first_number = shift @numbers;
+
+  my $subscriber = $self->get_subscriber($svc);
+
+  if ( $subscriber ) {
+    my $id = $subscriber->{id};
+    if ( $svc->username ne $old->username ) {
+      # have to delete and recreate
+      $self->api_delete("subscribers/$id");
+      $self->insert_subscriber($svc);
+    } else {
+      my $profile_set_id = $self->get_subscriber_profile_set_id;
+      $self->api_update("subscribers/$id",
+        {
+          'alias_numbers'   => \@numbers,
+          'customer_id'     => $cust->{id},
+          'display_name'    => $svc->finger,
+          'domain_id'       => $domain->{id},
+          'email'           => $svc->email,
+          'external_id'     => $svcid,
+          'password'        => $svc->_password,
+          'primary_number'  => $first_number,
+          'profile_set_id'  => $profile_set_id,
+          'status'          => $status,
+          'username'        => $svc->username,
+        }
+      );
+    }
+  } else {
+    warn "$me subscriber not found for $svcid; creating new\n";
+    $self->insert_subscriber($svc);
+  }
+}
+
+sub delete_subscriber {
+  my $self = shift;
+  my $svc = shift;
+  my $svcid = "svc#" . $svc->svcnum;
+  my $pkgnum = $svc->cust_svc->pkgnum;
+  my $custid = "cust_pkg#$pkgnum";
+
+  my $subscriber = $self->get_subscriber($svc);
+
+  if ( $subscriber ) {
+    my $id = $subscriber->{id};
+    $self->api_delete("subscribers/$id");
+  } else {
+    warn "$me subscriber not found for $svcid (would be deleted)\n";
+  }
+
+  my (@other_subs) = $self->api_query('subscribers',
+    [ 'customer_external_id' => $custid ]
+  );
+  if (! @other_subs) {
+    # then it's safe to remove the customer
+    my ($cust) = $self->api_query('customers', [ 'external_id' => $custid ]);
+    if (!$cust) {
+      warn "$me customer not found for $custid\n";
+      return;
+    }
+    my $id = $cust->{id};
+    my $contact_id = $cust->{contact_id};
+    if ( $cust->{'status'} ne 'terminated' ) {
+      # can't delete customers, have to cancel them
+      $cust->{'status'} = 'terminated';
+      $cust->{'external_id'} = ""; # dissociate it from this pkgnum
+      $cust->{'contact_id'} = 1; # set to the system default contact
+      $self->api_update("customers/$id", $cust);
+    }
+    # can and should delete contacts though
+    $self->api_delete("customercontacts/$contact_id");
+  }
+}
+
+################
+# CALL DETAILS #
+################
+
+=item import_cdrs START, END
+
+Retrieves CDRs for calls in the date range from START to END and inserts them
+as a CDR batch. On success, returns a new cdr_batch object. On failure,
+returns an error message. If there are no new CDRs, returns nothing.
+
+=cut
+
+sub import_cdrs {
+  my ($self, $start, $end) = @_;
+  $start ||= 0;
+  $end ||= time;
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  
+  ($start, $end) = ($end, $start) if $end < $start;
+  $start = DateTime->from_epoch(epoch => $start, time_zone => 'local');
+  $end = DateTime->from_epoch(epoch => $end, time_zone => 'local');
+  $end->subtract(seconds => 1); # filter by >= and <= only, so...
+
+  # a little different from the usual: we have to fetch these subscriber by
+  # subscriber, not all at once.
+  my @svcs = qsearch({
+      'table'     => 'svc_acct',
+      'addl_from' => ' JOIN cust_svc USING (svcnum)' .
+                     ' JOIN export_svc USING (svcpart)',
+      'extra_sql' => ' WHERE export_svc.role = \'subscriber\''.
+                     ' AND export_svc.exportnum = '.$self->exportnum
+  });
+  my $cdr_batch;
+  my @args = ( 'start_ge' => $start->iso8601,
+               'start_le' => $end->iso8601,
+              );
+
+  my $error;
+  SVC: foreach my $svc (@svcs) {
+    my $subscriber = $self->get_subscriber($svc);
+    if (!$subscriber) {
+      warn "$me user ".$svc->label." is not configured on the SIP server.\n";
+      next;
+    }
+    my $id = $subscriber->{id};
+    my @calls;
+    try {
+      # alias_field tells "calllists" which field from the source and
+      # destination to use as the "own_cli" and "other_cli" of the call.
+      # "user" = username@domain.
+      @calls = $self->api_query('calllists', [
+          'subscriber_id' => $id,
+          'alias_field'   => 'user',
+          @args
+      ]);
+    } catch {
+      $error = "$me $_ (retrieving records for ".$svc->label.")";
+    };
+
+    if (@calls and !$cdr_batch) {
+      # create a cdr_batch if needed
+      my $cdrbatchname = 'sipwise-' . $self->exportnum . '-' . $end->epoch;
+      $cdr_batch = FS::cdr_batch->new({ cdrbatch => $cdrbatchname });
+      $error = $cdr_batch->insert;
+    }
+
+    last SVC if $error;
+
+    foreach my $c (@calls) {
+      # avoid double-importing
+      my $uniqueid = $c->{call_id};
+      if ( FS::cdr->row_exists("uniqueid = ?", $uniqueid) ) {
+        warn "skipped call with uniqueid = '$uniqueid' (already imported)\n"
+          if $DEBUG;
+        next;
+      }
+      my $src = $c->{own_cli};
+      my $dst = $c->{other_cli};
+      if ( $c->{direction} eq 'in' ) { # then reverse them
+        ($src, $dst) = ($dst, $src);
+      }
+      # parse duration from H:MM:SS format
+      my $duration;
+      if ( $c->{duration} =~ /^(\d+):(\d+):(\d+)$/ ) {
+        $duration = $3 + (60 * $2) + (3600 * $1);
+      } else {
+        $error = "call $uniqueid: unparseable duration '".$c->{duration}."'";
+      }
+
+      # use the username@domain label for src and/or dst if possible
+      my $cdr = FS::cdr->new({
+          uniqueid        => $uniqueid,
+          upstream_price  => $c->{customer_cost},
+          startdate       => parse_datetime($c->{start_time}),
+          disposition     => $c->{status},
+          duration        => $duration,
+          billsec         => $duration,
+          src             => $src,
+          dst             => $dst,
+      });
+      $error ||= $cdr->insert;
+      last SVC if $error;
+    }
+  } # foreach $svc
+
+  if ( $error ) {
+    dbh->rollback if $oldAutoCommit;
+    return $error;
+  } elsif ( $cdr_batch ) {
+    dbh->commit if $oldAutoCommit;
+    return $cdr_batch;
+  } else { # no CDRs
+    return;
+  }
+}
+
+##############
+# API ACCESS #
+##############
+
+=item api_query RESOURCE, CONTENT
+
+Makes a GET request to RESOURCE, the name of a resource type (like
+'customers'), with query parameters in CONTENT, unpacks the embedded search
+results, and returns them as a list.
+
+Sipwise ignores invalid query parameters rather than throwing an error, so if
+the parameters are misspelled or make no sense for this type of query, it will
+probably return all of the objects.
+
+=cut
+
+sub api_query {
+  my $self = shift;
+  my ($resource, $content) = @_;
+  if ( ref $content eq 'HASH' ) {
+    $content = [ %$content ];
+  }
+  my $page = 1;
+  push @$content, ('rows' => 100, 'page' => 1); # 'page' is always last
+  my $result = $self->api_request('GET', $resource, $content);
+  my @records;
+  # depaginate
+  while ( my $things = $result->{_embedded}{"ngcp:$resource"} ) {
+    if ( ref($things) eq 'ARRAY' ) {
+      push @records, @$things;
+    } else {
+      push @records, $things;
+    }
+    if ( my $linknext = $result->{_links}{next} ) {
+      # unfortunately their HAL isn't entirely functional
+      # it returns "next" links that contain "page" and "rows" but no other
+      # parameters. so just count the pages:
+      $page++;
+      $content->[-1] = $page;
+
+      warn "$me continued: $page\n" if $DEBUG;
+      $result = $self->api_request('GET', $resource, $content);
+    } else {
+      last;
+    }
+  }
+  return @records;
+}
+
+=item api_create RESOURCE, CONTENT
+
+Makes a POST request to RESOURCE, the name of a resource type (like
+'customers'), to create a new object of that type. CONTENT must be a hashref of
+the object's fields.
+
+On success, will then fetch and return the newly created object. On failure,
+will throw the "message" parameter from the request as an exception.
+
+=cut
+
+sub api_create {
+  my $self = shift;
+  my ($resource, $content) = @_;
+  my $result = $self->api_request('POST', $resource, $content);
+  if ( $result->{location} ) {
+    return $self->api_request('GET', $result->{location});
+  } else {
+    die $result->{message} . "\n";
+  }
+}
+
+=item api_update ENDPOINT, CONTENT
+
+Makes a PUT request to ENDPOINT, the name of a specific record (like
+'customers/11'), to replace it with the data in CONTENT (a hashref of the
+object's fields). On failure, will throw an exception. On success,
+returns nothing.
+
+=cut
+
+sub api_update {
+  my $self = shift;
+  my ($endpoint, $content) = @_;
+  my $result = $self->api_request('PUT', $endpoint, $content);
+  if ( $result->{message} ) {
+    die $result->{message} . "\n";
+  }
+  return;
+}
+
+=item api_delete ENDPOINT
+
+Makes a DELETE request to ENDPOINT. On failure, will throw an exception.
+
+=cut
+
+sub api_delete {
+  my $self = shift;
+  my $endpoint = shift;
+  my $result = $self->api_request('DELETE', $endpoint);
+  if ( $result->{code} and $result->{code} eq '404' ) {
+    # special case: this is harmless. we tried to delete something and it
+    # was already gone.
+    warn "$me api_delete $endpoint: does not exist\n";
+    return;
+  } elsif ( $result->{message} ) {
+    die $result->{message} . "\n";
+  }
+  return;
+}
+
+=item api_request METHOD, ENDPOINT, CONTENT
+
+Makes a REST request with HTTP method METHOD, to path ENDPOINT, with content
+CONTENT. If METHOD is GET, the content can be an arrayref or hashref to append
+as the query argument. If it's POST or PUT, the content will be JSON-serialized
+and sent as the request body. If it's DELETE, content will be ignored.
+
+=cut
+
+sub api_request {
+  my $self = shift;
+  my ($method, $endpoint, $content) = @_;
+  $DEBUG ||= 1 if $self->option('debug');
+  my $url;
+  if ($endpoint =~ /^http/) {
+    # allow directly using URLs returned from the API
+    $url = $endpoint;
+  } else {
+    $endpoint =~ s[/api/][]; # allow using paths returned in Location headers
+    $url = 'https://' . $self->host . '/api/' . $endpoint;
+    $url .= '/' unless $url =~ m[/$];
+  }
+  my $request;
+  if ( lc($method) eq 'get' ) {
+    $url = URI->new($url);
+    $url->query_form($content);
+    $request = GET($url,
+      'Accept'        => 'application/json'
+    );
+  } elsif ( lc($method) eq 'post' ) {
+    $request = POST($url,
+      'Accept'        => 'application/json',
+      'Content'       => encode_json($content),
+      'Content-Type'  => 'application/json',
+    );
+  } elsif ( lc($method) eq 'put' ) {
+    $request = PUT($url,
+      'Accept'        => 'application/json',
+      'Content'       => encode_json($content),
+      'Content-Type'  => 'application/json',
+    );
+  } elsif ( lc($method) eq 'delete' ) {
+    $request = DELETE($url);
+  }
+
+  warn "$me $method $endpoint\n" if $DEBUG;
+  warn $request->as_string ."\n" if $DEBUG > 1;
+  my $response = $self->ua->request($request);
+  warn "$me received\n" . $response->as_string ."\n" if $DEBUG > 1;
+
+  my $decoded_response = {};
+  if ( $response->content ) {
+    local $@;
+    $decoded_response = eval { decode_json($response->content) };
+    if ( $@ ) {
+      # then it can't be parsed; probably a low-level error of some kind.
+      warn "$me Parse error.\n".$response->content."\n\n";
+      die "$me Parse error:".$response->content . "\n";
+    }
+  }
+  if ( $response->header('Location') ) {
+    $decoded_response->{location} = $response->header('Location');
+  }
+  return $decoded_response;
+}
+
+# a little false laziness with aradial.pm
+sub host {
+  my $self = shift;
+  my $port = $self->option('port') || 1443;
+  $self->machine . ":$port";
+}
+
+sub ua {
+  my $self = shift;
+  $self->{_ua} ||= do {
+    my @opt;
+    if ( $self->option('ssl_no_verify') ) {
+      push @opt, ssl_opts => { verify_hostname => 0 };
+    }
+    my $ua = LWP::UserAgent->new(@opt);
+    $ua->credentials(
+      $self->host,
+      'api_admin_http',
+      $self->option('username'),
+      $self->option('password')
+    );
+    $ua;
+  }
+}
+
+
+1;
diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index c2f5d71..8283e6f 100644
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -847,6 +847,17 @@ sub delete {
     }
   }
 
+  foreach my $svc_phone (
+    qsearch( 'svc_phone', { 'forward_svcnum' => $self->svcnum })
+  ) {
+    $svc_phone->set('forward_svcnum', '');
+    my $error = $svc_phone->replace;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
   my $error = $self->delete_password_history
            || $self->SUPER::delete; # usergroup here
   if ( $error ) {
@@ -2308,8 +2319,8 @@ sub last_login_text {
 
 Returns a paged search (L<FS::PagedSearch>) for Call Detail Records
 associated with this service. For svc_acct, "associated with" means that
-either the "src" or the "charged_party" field of the CDR matches the
-"username" field of the service.
+either the "src" or the "charged_party" field of the CDR matches either
+the "username" field of the service or the username@domain label.
 
 =cut
 
@@ -2320,6 +2331,7 @@ sub psearch_cdrs {
   my @where;
 
   my $did = dbh->quote($self->username);
+  my $diddomain = dbh->quote($self->label);
 
   my $prefix = $options{'default_prefix'} || ''; #convergent.au '+61'
   my $prefixdid = dbh->quote($prefix . $self->username);
@@ -2335,12 +2347,16 @@ sub psearch_cdrs {
   if (!$options{'disable_charged_party'}) {
     push @orwhere,
       "charged_party = $did",
-      "charged_party = $prefixdid";
+      "charged_party = $prefixdid",
+      "charged_party = $diddomain"
+      ;
   }
   if (!$options{'disable_src'}) {
     push @orwhere,
       "src = $did AND charged_party IS NULL",
-      "src = $prefixdid AND charged_party IS NULL";
+      "src = $prefixdid AND charged_party IS NULL",
+      "src = $diddomain AND charged_party IS NULL"
+      ;
   }
   push @where, '(' . join(' OR ', @orwhere) . ')';
 
diff --git a/FS/FS/svc_phone.pm b/FS/FS/svc_phone.pm
index cf9d9b4..3a58b46 100644
--- a/FS/FS/svc_phone.pm
+++ b/FS/FS/svc_phone.pm
@@ -93,9 +93,14 @@ Voicemail PIN
 
 Optional svcnum from svc_pbx
 
+=item forward_svcnum
+
+Forward destination, if it's another service. Some exports use this
+configuration.
+
 =item forwarddst
 
-Forwarding destination
+Forwarding destination, if it's not a service.
 
 =item email
 
@@ -225,6 +230,9 @@ sub table_info {
 	'forwarddst' => {	label => 'Forward Destination', 
 				%dis2,
 			},
+        'forward_svcnum' => {   label => 'Route to service',
+                                %dis2,
+                            },
 	'email' => {		label => 'Email',
 				%dis2,
 		    },
@@ -529,7 +537,9 @@ sub check {
     || $self->ut_alphan('sms_account')
     || $self->ut_numbern('max_simultaneous')
     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
-    || $self->ut_numbern('forwarddst')
+    || $self->ut_numbern('forward_svcnum')
+    || $self->ut_foreign_keyn('forward_svcnum', 'cust_svc', 'svcnum')
+    || $self->ut_textn('forwarddst')
     || $self->ut_textn('email')
     || $self->ut_numbern('lrn')
     || $self->ut_numbern('lnp_desired_due_date')
diff --git a/debian/control b/debian/control
index badd99d..4844038 100644
--- a/debian/control
+++ b/debian/control
@@ -95,7 +95,7 @@ Depends: aspell-en,gnupg,ghostscript,gsfonts,gzip,latex-xcolor,
  libhtml-formattext-withlinks-andtables-perl, libcrypt-x509-perl,
  libdata-guid-perl, libparams-classify-perl (>= 0.013-5.1),
  libcpanel-json-xs-perl, libarchive-zip-perl
-Conflicts: libparams-classify-perl (>= 0.013-6)
+ libtry-tiny-perl, libnumber-phone-perl
 Suggests: libbusiness-onlinepayment-perl
 Description: Libraries for Freeside billing and trouble ticketing
  Freeside is a web-based billing and trouble ticketing application.
diff --git a/httemplate/edit/svc_phone.cgi b/httemplate/edit/svc_phone.cgi
index f1471e2..e74ffbb 100644
--- a/httemplate/edit/svc_phone.cgi
+++ b/httemplate/edit/svc_phone.cgi
@@ -60,6 +60,9 @@ my $begin_callback = sub {
                 type  => 'text',
                 maxlength => $conf->config('svc_phone-phone_name-max_length'),
               },
+              { field => 'forward_svcnum',
+                type  => 'select-svc_phone-forward',
+              },
 	      'forwarddst',
 	      'email',
 
diff --git a/httemplate/elements/tr-select-svc_phone-forward.html b/httemplate/elements/tr-select-svc_phone-forward.html
new file mode 100644
index 0000000..ef9ef17
--- /dev/null
+++ b/httemplate/elements/tr-select-svc_phone-forward.html
@@ -0,0 +1,50 @@
+% if ( $hide ) {
+  <tr style="display: none"><td>
+  <INPUT TYPE="hidden" NAME="<% $opt{field} %>" VALUE="<% $opt{curr_value}%>">
+  </td></tr>
+% } else {
+  <& tr-select-table.html,
+    'table'       => 'svc_acct', # for now
+    'name_col'    => 'email',
+    'order_by'    => 'order by username',
+    'empty_label' => ' ',
+    %select_hash,
+    %opt
+  &>
+% } 
+<%init>
+
+my %opt = @_;
+my $pkgnum = $opt{pkgnum};
+my $svcpart = $opt{svcpart};
+
+my $field = $opt{'field'} ||= 'forward_svcnum';
+
+my $part_svc = FS::part_svc->by_key($svcpart);
+# kludgey assumptions for now:
+# - this is only used to route DIDs to their real destinations
+# - which is a svc_acct
+# - in the same package (part_export::svc_with_role assumes this)
+# - and shares an export
+
+my $cust_pkg = FS::cust_pkg->by_key($pkgnum);
+my @svcparts;
+foreach my $part_export ( $part_svc->part_export ) {
+  foreach my $export_svc ( $part_export->export_svc ) {
+    push @svcparts, $export_svc->svcpart;
+  }
+}
+
+$pkgnum =~ /^(\d+)$/ or die "bad pkgnum $pkgnum";
+
+my %select_hash = (
+  'addl_from' => ' JOIN cust_svc USING (svcnum) ',
+  'extra_sql' => "WHERE pkgnum = $pkgnum AND svcpart IN(".
+    join(',', @svcparts) . ")"
+);
+
+my $hide = 0;
+$hide = 1 if $part_svc->part_svc_column($field) eq 'F';
+$hide = 1 if !@svcparts;
+
+</%init>
diff --git a/httemplate/view/svc_phone.cgi b/httemplate/view/svc_phone.cgi
index ab69c4f..416f138 100644
--- a/httemplate/view/svc_phone.cgi
+++ b/httemplate/view/svc_phone.cgi
@@ -18,6 +18,23 @@ my %labels = map { $_ =>  ( ref($fields->{$_})
 
 my @fields = qw( countrycode phonenum sim_imsi );
 push @fields, 'domain' if $conf->exists('svc_phone-domain');
+
+$labels{forward_svcnum} = mt('Route to service');
+push @fields, { field => 'forward_svcnum',
+                link => [ $p.'view/cust_svc.cgi?', 'forward_svcnum' ],
+                value_callback => sub {
+                  my $self = shift;
+                  if ($self->forward_svcnum) {
+                    my $cust_svc = FS::cust_svc->by_key($self->forward_svcnum);
+                    if ( $cust_svc ) {
+                      return $cust_svc->svc_x->label;
+                    }
+                  }
+                  '';
+                },
+              };
+
+
 push @fields, qw( pbx_title );
 $labels{pbx_title} = 'PBX';