RT# 83450 - fixed rateplan export
[freeside.git] / FS / FS / part_export / sipwise.pm
index 690a14c..287e604 100644 (file)
@@ -5,7 +5,7 @@ use strict;
 
 use FS::Record qw(qsearch qsearchs dbh);
 use Tie::IxHash;
-use Carp;
+use IO::Socket::SSL;
 use LWP::UserAgent;
 use URI;
 use Cpanel::JSON::XS;
@@ -13,9 +13,11 @@ use HTTP::Request::Common qw(GET POST PUT DELETE);
 use FS::Misc::DateTime qw(parse_datetime);
 use DateTime;
 use Number::Phone;
+use Try::Tiny;
+use Carp qw(carp);
 
 our $me = '[sipwise]';
-our $DEBUG = 2;
+our $DEBUG = 0;
 
 tie my %options, 'Tie::IxHash',
   'port'            => { label => 'Port' },
@@ -23,8 +25,11 @@ tie my %options, 'Tie::IxHash',
   'password'        => { label => 'API password', },
   'debug'           => { label => 'Enable debugging', type => 'checkbox', value => 1 },
   'billing_profile' => {
-    label             => 'Billing profile',
-    default           => 'default', # that's what it's called
+    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',
@@ -34,7 +39,7 @@ tie my %options, 'Tie::IxHash',
 
 tie my %roles, 'Tie::IxHash',
   'subscriber'    => {  label     => 'Subscriber',
-                        svcdb     => 'svc_phone',
+                        svcdb     => 'svc_acct',
                         multiple  => 1,
                      },
   'did'           => {  label     => 'DID',
@@ -44,7 +49,7 @@ tie my %roles, 'Tie::IxHash',
 ;
 
 our %info = (
-  'svc'      => [qw( svc_phone )],
+  'svc'      => [qw( svc_acct svc_phone )],
   'desc'     => 'Provision to a Sipwise sip:provider server',
   'options'  => \%options,
   'roles'    => \%roles,
@@ -52,102 +57,108 @@ our %info = (
 <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>A phone service for a SIP client account ("subscriber"). The
-    <i>phonenum</i> will be the SIP username. The <i>domsvc</i> should point
+    <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>forwarddst</i> field should be set to the SIP username
-    of the subscriber who should receive calls directed to this number.</LI>
+    number. The <i>forward_svcnum</i> field should be set to the account that
+    will receive calls at this number.
   </OL>
 </P>
-<P>Export options:
-</P>
 END
 );
 
-sub export_insert {
+sub _export_insert {
   my($self, $svc_x) = (shift, shift);
 
-  local $@;
+  local $SIG{__DIE__};
+  my $error;
   my $role = $self->svc_role($svc_x);
   if ( $role eq 'subscriber' ) {
 
-    eval { $self->insert_subscriber($svc_x) };
-    return "$me $@" if $@;
+    try { $self->insert_subscriber($svc_x) }
+    catch { $error = $_ };
 
   } elsif ( $role eq 'did' ) {
 
-    # only export the DID if it's set to forward to somewhere...
-    return if $svc_x->forwarddst eq '';
-    my $subscriber = qsearchs('svc_phone', { phonenum => $svc_x->forwarddst });
-    # and there is a service for the forwarding destination...
-    return if !$subscriber;
-    # and that service is managed by this export.
-    return if !$self->svc_role($subscriber);
-
-    eval { $self->replace_subscriber($subscriber) };
-    return "$me $@" if $@;
+    try { $self->export_did($svc_x) }
+    catch { $error = $_ };
 
   }
+  return "$me $error" if $error;
   '';
 }
 
-sub export_replace {
+sub _export_replace {
   my ($self, $svc_new, $svc_old) = @_;
+  local $SIG{__DIE__};
+
   my $role = $self->svc_role($svc_new);
-  local $@;
+
+  my $error;
   if ( $role eq 'subscriber' ) {
-    eval { $self->replace_subscriber($svc_new, $svc_old) };
+
+    try { $self->replace_subscriber($svc_new, $svc_old) }
+    catch { $error = $_ };
+
   } elsif ( $role eq 'did' ) {
-    eval { $self->replace_did($svc_new, $svc_old) };
+
+    try { $self->export_did($svc_new, $svc_old) }
+    catch { $error = $_ };
+
   }
-  return "$me $@" if $@;
+  return "$me $error" if $error;
   '';
 }
 
-sub export_delete {
+sub _export_delete {
   my ($self, $svc_x) = (shift, shift);
+  local $SIG{__DIE__};
+
   my $role = $self->svc_role($svc_x);
-  local $@;
+  my $error;
+
   if ( $role eq 'subscriber' ) {
 
     # no need to remove DIDs from it, just drop the subscriber record
-    eval { $self->delete_subscriber($svc_x) };
+    try { $self->delete_subscriber($svc_x) }
+    catch { $error = $_ };
 
   } elsif ( $role eq 'did' ) {
 
-    return if !$svc_x->forwarddst;
-    my $subscriber = qsearchs('svc_phone', { phonenum => $svc_x->forwarddst });
-    return if !$subscriber;
-    return if !$self->svc_role($subscriber);
-    eval { $self->delete_did($svc_x, $subscriber) };
+    try { $self->export_did($svc_x) }
+    catch { $error = $_ };
 
   }
-  return "$me $@" if $@;
+  return "$me $error" if $error;
   '';
 }
 
-# XXX NOT DONE YET
-sub export_suspend {
+# 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);
-  return if $role ne 'subacct'; # can't suspend DIDs directly
-
-  my $error = $self->replace_subacct($svc_x, $svc_x); # will disable it
+  my $error;
+  if ( $role eq 'subscriber' ) {
+    try { $self->replace_subscriber($svc_x, $svc_x) }
+    catch { $error = $_ };
+  }
   return "$me $error" if $error;
   '';
 }
 
-sub export_unsuspend {
+sub _export_unsuspend {
   my $self = shift;
   my $svc_x = shift;
   my $role = $self->svc_role($svc_x);
-  return if $role ne 'subacct'; # can't suspend DIDs directly
-
-  $svc_x->set('unsuspended', 1); # hack to tell replace_subacct to do it
-  my $error = $self->replace_subacct($svc_x, $svc_x); #same
+  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;
   '';
 }
@@ -184,6 +195,7 @@ sub find_or_create_customer {
   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
@@ -194,7 +206,7 @@ sub find_or_create_customer {
     ]
   );
   if (!$billing_profile) {
-    croak "can't find billing profile '". $self->option('billing_profile') . "'";
+    die "can't find billing profile '". $self->option('billing_profile') . "'\n";
   }
   my $bpid = $billing_profile->{id};
 
@@ -255,6 +267,50 @@ sub find_or_create_domain {
   );
 }
 
+########
+# 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 ( $FS::svc_Common::noexport_hack ) {
+    carp 'export_did() suppressed by noexport_hack'
+      if $self->option('debug') || $DEBUG;
+    return;
+  }
+
+  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 #
 ###############
@@ -270,7 +326,7 @@ sub get_subscriber {
   my $svc = shift;
 
   my $svcnum = $svc->svcnum;
-  my $svcid = "svc_phone#$svcnum";
+  my $svcid = "svc#$svcnum";
 
   my $pkgnum = $svc->cust_svc->pkgnum;
   my $custid = "cust_pkg#$pkgnum";
@@ -291,12 +347,11 @@ sub did_numbers_for_svc {
   my $self = shift;
   my $svc = shift;
   my @numbers;
-  my @possible_dids = qsearch({
+  my @dids = qsearch({
       'table'     => 'svc_phone',
-      'hashref'   => { 'forwarddst' => $svc->phonenum },
-      'order_by'  => ' ORDER BY phonenum'
+      'hashref'   => { 'forward_svcnum' => $svc->svcnum }
   });
-  foreach my $did (@possible_dids) {
+  foreach my $did (@dids) {
     # only include them if they're interesting to this export
     if ( $self->svc_role($did) eq 'did' ) {
       my $phonenum;
@@ -308,7 +363,7 @@ sub did_numbers_for_svc {
         $phonenum = Number::Phone->new($country, $did->phonenum);
       }
       if (!$phonenum) {
-        croak "Can't process phonenum ".$did->countrycode . $did->phonenum;
+        die "Can't process phonenum ".$did->countrycode . $did->phonenum . "\n";
       }
       push @numbers,
         { 'cc' => $phonenum->country_code,
@@ -320,30 +375,44 @@ sub did_numbers_for_svc {
   @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_phone#" . $svc->svcnum;
+  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->phone_name,
+      'display_name'    => $svc->finger,
       'domain_id'       => $domain->{id},
-      'email'           => $svc->email,
       'external_id'     => $svcid,
-      'password'        => $svc->sip_password,
+      'password'        => $svc->_password,
       'primary_number'  => $first_number,
+      'profile_set_id'  => $profile_set_id,
       'status'          => $status,
-      'username'        => $svc->phonenum,
+      'username'        => $svc->username,
     }
   );
 }
@@ -351,11 +420,12 @@ sub insert_subscriber {
 sub replace_subscriber {
   my $self = shift;
   my $svc = shift;
-  my $old = shift;
-  my $svcid = "svc_phone#" . $svc->svcnum;
+  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);
@@ -365,23 +435,25 @@ sub replace_subscriber {
 
   if ( $subscriber ) {
     my $id = $subscriber->{id};
-    if ( $svc->phonenum ne $old->phonenum ) {
+    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->phone_name,
+          'display_name'    => $svc->finger,
           'domain_id'       => $domain->{id},
           'email'           => $svc->email,
           'external_id'     => $svcid,
-          'password'        => $svc->sip_password,
+          'password'        => $svc->_password,
           'primary_number'  => $first_number,
+          'profile_set_id'  => $profile_set_id,
           'status'          => $status,
-          'username'        => $svc->phonenum,
+          'username'        => $svc->username,
         }
       );
     }
@@ -394,7 +466,7 @@ sub replace_subscriber {
 sub delete_subscriber {
   my $self = shift;
   my $svc = shift;
-  my $svcid = "svc_phone#" . $svc->svcnum;
+  my $svcid = "svc#" . $svc->svcnum;
   my $pkgnum = $svc->cust_svc->pkgnum;
   my $custid = "cust_pkg#$pkgnum";
 
@@ -431,6 +503,124 @@ sub delete_subscriber {
   }
 }
 
+################
+# 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 #
 ##############
@@ -453,6 +643,8 @@ sub api_query {
   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
@@ -463,8 +655,14 @@ sub api_query {
       push @records, $things;
     }
     if ( my $linknext = $result->{_links}{next} ) {
-      warn "$me continued at $linknext\n" if $DEBUG;
-      $result = $self->api_request('GET', $linknext);
+      # 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;
     }
@@ -490,7 +688,7 @@ sub api_create {
   if ( $result->{location} ) {
     return $self->api_request('GET', $result->{location});
   } else {
-    croak $result->{message};
+    die $result->{message} . "\n";
   }
 }
 
@@ -508,7 +706,7 @@ sub api_update {
   my ($endpoint, $content) = @_;
   my $result = $self->api_request('PUT', $endpoint, $content);
   if ( $result->{message} ) {
-    croak $result->{message};
+    die $result->{message} . "\n";
   }
   return;
 }
@@ -529,7 +727,7 @@ sub api_delete {
     warn "$me api_delete $endpoint: does not exist\n";
     return;
   } elsif ( $result->{message} ) {
-    croak $result->{message};
+    die $result->{message} . "\n";
   }
   return;
 }
@@ -591,7 +789,7 @@ sub api_request {
     if ( $@ ) {
       # then it can't be parsed; probably a low-level error of some kind.
       warn "$me Parse error.\n".$response->content."\n\n";
-      croak $response->content;
+      die "$me Parse error:".$response->content . "\n";
     }
   }
   if ( $response->header('Location') ) {
@@ -612,7 +810,10 @@ sub ua {
   $self->{_ua} ||= do {
     my @opt;
     if ( $self->option('ssl_no_verify') ) {
-      push @opt, ssl_opts => { verify_hostname => 0 };
+      push @opt, ssl_opts => {
+                   verify_hostname => 0,
+                   SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
+                 };
     }
     my $ua = LWP::UserAgent->new(@opt);
     $ua->credentials(