move signup server functions to self-service server. fix provisioning &

immediate suspension of declined signups.

4 files changed, 277 insertions, 4 deletions

diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm
new file mode 100644
index 000000000..0bb9f7b6a
--- /dev/null
+++ b/FS/FS/ClientAPI/Signup.pm
@@ -0,0 +1,183 @@
+package FS::ClientAPI::Signup;
+
+use strict;
+use Tie::RefHash;
+use FS::Conf;
+use FS::Record qw(qsearch qsearchs);
+use FS::agent;
+use FS::cust_main_county;
+use FS::part_pkg;
+use FS::svc_acct_pop;
+use FS::cust_main;
+use FS::cust_pkg;
+use FS::Msgcat qw(gettext);
+
+use FS::ClientAPI; #hmm
+FS::ClientAPI->register_handlers(
+  'Signup/signup_info'  => \&signup_info,
+  'Signup/new_customer' => \&new_customer,
+);
+
+sub signup_info {
+  #my $packet = shift;
+
+  my $conf = new FS::Conf;
+
+  my $signup_info = {
+
+    'cust_main_county' =>
+      [ map { $_->hashref } qsearch('cust_main_county', {}) ],
+
+    'agentnum2part_pkg' =>
+      {
+        map {
+          my $href = $_->pkgpart_hashref;
+          $_->agentnum =>
+            [
+              map { { 'payby' => [ $_->payby ], %{$_->hashref} } }
+                grep { $_->svcpart('svc_acct') && $href->{ $_->pkgpart } }
+                  qsearch( 'part_pkg', { 'disabled' => '' } )
+            ];
+        } qsearch('agent', {} )
+      },
+
+    'svc_acct_pop' => [ map { $_->hashref } qsearch('svc_acct_pop',{} ) ],
+
+    'security_phrase' => $conf->exists('security_phrase'),
+
+    'payby' => [ $conf->config('signup_server-payby') ],
+
+    'msgcat' => { map { $_=>gettext($_) } qw(
+      passwords_dont_match invalid_card unknown_card_type not_a
+    ) },
+
+    'statedefault' => $conf->config('statedefault') || 'CA',
+
+    'countrydefault' => $conf->config('countrydefault') || 'US',
+
+  };
+
+  if ( $conf->config('signup_server-default_agentnum') ) {
+    my $agentnum = $conf->config('signup_server-default_agentnum');
+    my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } )
+      or die "fatal: signup_server-default_agentnum $agentnum not found\n";
+    my $pkgpart_href = $agent->pkgpart_hashref;
+
+    $signup_info->{'part_pkg'} = [
+      #map { $_->hashref }
+      map { { 'payby' => [ $_->payby ], %{$_->hashref} } }
+        grep { $_->svcpart('svc_acct') && $pkgpart_href->{ $_->pkgpart } }
+          qsearch( 'part_pkg', { 'disabled' => '' } )
+    ];
+  }
+
+  $signup_info;
+
+}
+
+sub new_customer {
+  my $packet = shift;
+
+  my $conf = new FS::Conf;
+  my $error = '';
+  
+  #things that aren't necessary in base class, but are for signup server
+    #return "Passwords don't match"
+    #  if $hashref->{'_password'} ne $hashref->{'_password2'}
+  $error ||= gettext('empty_password') unless $packet->{'_password'};
+  # a bit inefficient for large numbers of pops
+  $error ||= gettext('no_access_number_selected')
+    unless $packet->{'popnum'} || !scalar(qsearch('svc_acct_pop',{} ));
+
+  #shares some stuff with htdocs/edit/process/cust_main.cgi... take any
+  # common that are still here and library them.
+  my $cust_main = new FS::cust_main ( {
+    #'custnum'          => '',
+    'agentnum'      => $packet->{agentnum}
+                       || $conf->config('signup_server-default_agentnum'),
+    'refnum'        => $packet->{refnum}
+                       || $conf->config('signup_server-default_refnum'),
+
+    map { $_ => $packet->{$_} } qw(
+      last first ss company address1 address2 city county state zip country
+      daytime night fax payby payinfo paydate payname referral_custnum comments
+    ),
+
+  } );
+
+  $error ||= "Illegal payment type"
+    unless grep { $_ eq $packet->{'payby'} }
+                $conf->config('signup_server-payby');
+
+  $cust_main->payinfo($cust_main->daytime)
+    if $cust_main->payby eq 'LECB' && ! $cust_main->payinfo;
+
+  my @invoicing_list = split( /\s*\,\s*/, $packet->{'invoicing_list'} );
+
+  $packet->{'pkgpart'} =~ /^(\d+)$/ or '' =~ /^()$/;
+  my $pkgpart = $1;
+
+  my $part_pkg =
+    qsearchs( 'part_pkg', { 'pkgpart' => $pkgpart } )
+      or $error ||= "WARNING: unknown pkgpart: $pkgpart";
+  my $svcpart = $part_pkg->svcpart('svc_acct') unless $error;
+
+  my $cust_pkg = new FS::cust_pkg ( {
+    #later#'custnum' => $custnum,
+    'pkgpart' => $packet->{'pkgpart'},
+  } );
+  $error ||= $cust_pkg->check;
+
+  my $svc_acct = new FS::svc_acct ( {
+    'svcpart'   => $svcpart,
+    map { $_ => $packet->{$_} }
+      qw( username _password sec_phrase popnum ),
+  } );
+
+  my $y = $svc_acct->setdefault; # arguably should be in new method
+  $error ||= $y unless ref($y);
+
+  $error ||= $svc_acct->check;
+
+  use Tie::RefHash;
+  tie my %hash, 'Tie::RefHash';
+  %hash = ( $cust_pkg => [ $svc_acct ] );
+  #msgcat
+  $error ||= $cust_main->insert( \%hash, \@invoicing_list, 'noexport' => 1 );
+
+  if ( ! $error && $conf->exists('signup_server-realtime') ) {
+
+    #warn "[fs_signup_server] Billing customer...\n" if $Debug;
+
+    my $bill_error = $cust_main->bill;
+    #warn "[fs_signup_server] error billing new customer: $bill_error"
+    #  if $bill_error;
+
+    $cust_main->apply_payments;
+    $cust_main->apply_credits;
+
+    $bill_error = $cust_main->collect;
+    #warn "[fs_signup_server] error collecting from new customer: $bill_error"
+    #  if $bill_error;
+
+    if ( $cust_main->balance > 0 ) {
+
+      #this makes sense.  credit is "un-doing" the invoice
+      $cust_main->credit( $cust_main->balance, 'signup server decline' );
+      $cust_main->apply_credits;
+
+      #should check list for errors...
+      #$cust_main->suspend;
+      local $FS::svc_Common::noexport_hack = 1;
+      $cust_main->cancel;
+
+      $error = '_decline';
+    }
+
+  }
+  $cust_main->reexport unless $error;
+
+  return { error => $error };
+
+}
+
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 5ad109942..6fa47b6bd 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -896,7 +896,7 @@ httemplate/docs/config.html
   {
     'key'         => 'signup_server-quiet',
     'section'     => 'deprecated',
-    'description' => ''<b>DEPRECATED</b>, the signup server is now part of the self-service server and no longer sends superfluous decline and cancel emails.  Used to disable decline and cancel emails generated by transactions initiated by the signup server.  Does not disable welcome emails.',
+    'description' => '<b>DEPRECATED</b>, the signup server is now part of the self-service server and no longer sends superfluous decline and cancel emails.  Used to disable decline and cancel emails generated by transactions initiated by the signup server.  Does not disable welcome emails.',
     'type'        => 'checkbox',
   },
 
@@ -910,11 +910,24 @@ httemplate/docs/config.html
 
   {
     'key'         => 'signup_server-email',
+    'section'     => 'deprecated',
+    'description' => '<b>DEPRECATED</b>, this feature is no longer available.  See the ***fill me in*** report instead.  Used to contain a comma-separated list of email addresses to receive notification of signups via the signup server.',
+    'type'        => 'text',
+  },
+
+  {
+    'key'         => 'signup_server-default_agentnum',
     'section'     => '',
-    'description' => 'Comma-separated list of email addresses to receive notification of signups via the signup server.',
+    'description' => 'Default agentnum for the signup server',
     'type'        => 'text',
   },
 
+  {
+    'key'         => 'signup_server-default_refnum',
+    'section'     => '',
+    'description' => 'Default advertising source number for the signup server',
+    'type'        => 'text',
+  },
 
   {
     'key'         => 'show-msgcat-codes',
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 997eceacc..e4d440600 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -7,7 +7,7 @@ use Safe;
 use Carp;
 BEGIN {
   eval "use Time::Local;";
-  die "Time::Local version 1.05 required with Perl versions before 5.6"
+  die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
     if $] < 5.006 && !defined($Time::Local::VERSION);
   eval "use Time::Local qw(timelocal timelocal_nocheck);";
 }
@@ -201,7 +201,7 @@ points to.  You can ask the object for a copy with the I<hash> method.
 
 sub table { 'cust_main'; }
 
-=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
+=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 
 Adds this customer to the database.  If there is an error, returns the error,
 otherwise returns false.
@@ -229,12 +229,18 @@ invoicing_list destination to the newly-created svc_acct.  Here's an example:
 
   $cust_main->insert( {}, [ $email, 'POST' ] );
 
+Currently available options are: I<noexport>
+
+If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
+(You can schedule them later with the B<reexport> method.)
+
 =cut
 
 sub insert {
   my $self = shift;
   my $cust_pkgs = @_ ? shift : {};
   my $invoicing_list = @_ ? shift : '';
+  my %options = @_;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -286,6 +292,7 @@ sub insert {
   }
 
   # packages
+  local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
   $error = $self->order_pkgs($cust_pkgs, \$seconds);
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
@@ -368,6 +375,41 @@ sub order_pkgs {
   ''; #no error
 }
 
+=item reexport
+
+document me.  Re-schedules all exports by calling the B<reexport> method
+of all associated packages (see L<FS::cust_pkg>).  If there is an error,
+returns the error; otherwise returns false.
+
+=cut
+
+sub reexport {
+  my $self = shift;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
+    my $error = $cust_pkg->reexport;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
 =item delete NEW_CUSTNUM
 
 This deletes the customer.  If there is an error, returns the error, otherwise
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 9a54b95c9..1bf56e128 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -663,6 +663,41 @@ sub transfer {
   return $remaining;
 }
 
+=item reexport
+
+=cut
+
+sub reexport {
+  my $self = shift;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  foreach my $cust_svc ( $self->cust_svc ) {
+    #false laziness w/svc_Common::insert
+    my $svc_x = $cust_svc->svc_x;
+    foreach my $part_export ( $cust_svc->part_svc->part_export ) {
+      my $error = $part_export->export_insert($svc_x);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
 =back
 
 =head1 SUBROUTINES