X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FClientAPI%2FSignup.pm;h=220bedaf5d66c5241d57ed98cc92d2e4f309af16;hb=ecac079f31f3b96160b4ea480fbb735e34f8ce28;hp=67d11dc0ec1863dde2c9fc517fa7cfb1e86cd6cd;hpb=3b7ae729e52eb04e5d9974f0c635998a7e9176ff;p=freeside.git

diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm
index 67d11dc0e..220bedaf5 100644
--- a/FS/FS/ClientAPI/Signup.pm
+++ b/FS/FS/ClientAPI/Signup.pm
@@ -7,7 +7,7 @@ use Data::Dumper;
 use Tie::RefHash;
 use Digest::SHA qw(sha512_hex);
 use FS::Conf;
-use FS::Record qw(qsearch qsearchs dbdef);
+use FS::Record qw(qsearch qsearchs dbdef dbh);
 use FS::CGI qw(popurl);
 use FS::Msgcat qw(gettext);
 use FS::Misc qw(card_types);
@@ -30,6 +30,25 @@ use FS::part_tag;
 $DEBUG = 0;
 $me = '[FS::ClientAPI::Signup]';
 
+=head1 NAME
+
+FS::ClientAPI::Signup - Front-end API for signing up customers
+
+=head1 DESCRIPTION
+
+This module provides the ClientAPI functions for talking to a signup
+server. The signup server is open to the public, i.e. does not require a
+login. The back-end Freeside server creates customers, orders packages and
+services, and processes initial payments.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+# document the rest of this as we work on it
+
 sub clear_cache {
   warn "$me clear_cache called\n" if $DEBUG;
   my $cache = new FS::ClientAPI_SessionCache( {
@@ -498,21 +517,8 @@ sub new_customer {
     #possibly some validation will be needed
   }
 
-  my $agentnum;
-  if ( exists $packet->{'session_id'} ) {
-    my $cache = new FS::ClientAPI_SessionCache( {
-      'namespace' => 'FS::ClientAPI::Agent',
-    } );
-    my $session = $cache->get($packet->{'session_id'});
-    if ( $session ) {
-      $agentnum = $session->{'agentnum'};
-    } else {
-      return { 'error' => "Can't resume session" }; #better error message
-    }
-  } else {
-    $agentnum = $packet->{agentnum}
-                || $conf->config('signup_server-default_agentnum');
-  }
+  my $agentnum = get_agentnum($packet);
+  return $agentnum if ref($agentnum);
 
   my ($bill_hash, $ship_hash);
   foreach my $f (FS::cust_main->location_fields) {
@@ -539,6 +545,8 @@ sub new_customer {
             paystart_month paystart_year payissue
             payip
 
+            locale
+
             referral_custnum comments
           )
     ),
@@ -667,7 +675,6 @@ sub new_customer {
   my $part_pkg =
     qsearchs( 'part_pkg', { 'pkgpart' => $pkgpart } )
       or return { 'error' => "WARNING: unknown pkgpart: $pkgpart" };
-  my $svcpart = $part_pkg->svcpart($svc_x);
 
   my $reg_code = '';
   if ( $packet->{'reg_code'} ) {
@@ -685,50 +692,59 @@ sub new_customer {
   #my $error = $cust_pkg->check;
   #return { 'error' => $error } if $error;
 
-  #should be all auto-magic and shit
   my @svc = ();
-  if ( $svc_x eq 'svc_acct' ) {
+  unless ( $svc_x eq 'none' ) {
 
-    my $svc = new FS::svc_acct {
-      'svcpart'   => $svcpart,
-      map { $_ => $packet->{$_} }
-        qw( username _password sec_phrase popnum domsvc ),
-    };
+    my $svcpart = $part_pkg->svcpart($svc_x);
+    #should be all auto-magic and shit
+    if ( $svc_x eq 'svc_acct' ) {
 
-    my @acct_snarf;
-    my $snarfnum = 1;
-    while (    exists($packet->{"snarf_machine$snarfnum"})
-            && length($packet->{"snarf_machine$snarfnum"}) ) {
-      my $acct_snarf = new FS::acct_snarf ( {
-        'machine'   => $packet->{"snarf_machine$snarfnum"},
-        'protocol'  => $packet->{"snarf_protocol$snarfnum"},
-        'username'  => $packet->{"snarf_username$snarfnum"},
-        '_password' => $packet->{"snarf_password$snarfnum"},
-      } );
-      $snarfnum++;
-      push @acct_snarf, $acct_snarf;
-    }
-    $svc->child_objects( \@acct_snarf );
-    push @svc, $svc;
+      my $svc = new FS::svc_acct {
+        'svcpart'   => $svcpart,
+        map { $_ => $packet->{$_} }
+          qw( username _password sec_phrase popnum domsvc ),
+      };
+      
+      my $error = $svc->is_password_allowed($packet->{_password});
+      $error = '' if $conf->config_bool('password-insecure', $agentnum);
+      return { error => $error } if $error;
+
+      my @acct_snarf;
+      my $snarfnum = 1;
+      while (    exists($packet->{"snarf_machine$snarfnum"})
+              && length($packet->{"snarf_machine$snarfnum"}) ) {
+        my $acct_snarf = new FS::acct_snarf ( {
+          'machine'   => $packet->{"snarf_machine$snarfnum"},
+          'protocol'  => $packet->{"snarf_protocol$snarfnum"},
+          'username'  => $packet->{"snarf_username$snarfnum"},
+          '_password' => $packet->{"snarf_password$snarfnum"},
+        } );
+        $snarfnum++;
+        push @acct_snarf, $acct_snarf;
+      }
+      $svc->child_objects( \@acct_snarf );
+      push @svc, $svc;
 
-  } elsif ( $svc_x eq 'svc_phone' ) {
+    } elsif ( $svc_x eq 'svc_phone' ) {
 
-    push @svc, new FS::svc_phone ( {
-      'svcpart' => $svcpart,
-       map { $_ => $packet->{$_} }
-         qw( countrycode phonenum sip_password pin ),
-    } );
+      push @svc, new FS::svc_phone ( {
+        'svcpart' => $svcpart,
+         map { $_ => $packet->{$_} }
+           qw( countrycode phonenum sip_password pin ),
+      } );
 
-  } elsif ( $svc_x eq 'svc_pbx' ) {
+    } elsif ( $svc_x eq 'svc_pbx' ) {
 
-    push @svc, new FS::svc_pbx ( {
-        'svcpart' => $svcpart,
-        map { $_ => $packet->{$_} } 
-          qw( id title ),
-        } );
+      push @svc, new FS::svc_pbx ( {
+          'svcpart' => $svcpart,
+          map { $_ => $packet->{$_} } 
+            qw( id title ),
+          } );
   
-  } else {
-    die "unknown signup service $svc_x";
+    } else {
+      die "unknown signup service $svc_x";
+    }
+
   }
 
   if ($packet->{'mac_addr'} && $conf->exists('signup_server-mac_addr_svcparts'))
@@ -787,7 +803,11 @@ sub new_customer {
 
     #warn "$me Billing customer...\n" if $Debug;
 
-    my $bill_error = $cust_main->bill( 'depend_jobnum'=>$placeholder->jobnum );
+    my @cust_bill;
+    my $bill_error = $cust_main->bill(
+      'depend_jobnum' => $placeholder->jobnum,
+      'return_bill'   => \@cust_bill,
+    );
     #warn "$me error billing new customer: $bill_error"
     #  if $bill_error;
 
@@ -802,8 +822,8 @@ sub new_customer {
          depend_jobnum => $placeholder->jobnum,
          selfservice   => 1,
       );
-      #warn "$me error collecting from new customer: $bill_error"
-      #  if $bill_error;
+      warn "$me error collecting from new customer: $bill_error"
+        if $bill_error && !ref($bill_error);
     }
 
     if ($bill_error && ref($bill_error) eq 'HASH') {
@@ -822,11 +842,11 @@ sub new_customer {
 
     if ( $cust_main->balance > 0 ) {
 
-      #this makes sense.  credit is "un-doing" the invoice
-      $cust_main->credit( $cust_main->balance, 'signup server decline',
-                          'reason_type' => $conf->config('signup_credit_type'),
-                        );
-      $cust_main->apply_credits;
+      #this used to apply a credit, but now we can void invoices...
+      foreach my $cust_bill (@cust_bill) {
+        my $voiderror = $cust_bill->void('automatic payment failed');
+        warn "Error voiding cust bill after decline: $voiderror" if $voiderror;
+      }
 
       #should check list for errors...
       #$cust_main->suspend;
@@ -918,21 +938,8 @@ sub new_customer_minimal {
     #possibly some validation will be needed
   }
 
-  my $agentnum;
-  if ( exists $packet->{'session_id'} ) {
-    my $cache = new FS::ClientAPI_SessionCache( {
-      'namespace' => 'FS::ClientAPI::Agent',
-    } );
-    my $session = $cache->get($packet->{'session_id'});
-    if ( $session ) {
-      $agentnum = $session->{'agentnum'};
-    } else {
-      return { 'error' => "Can't resume session" }; #better error message
-    }
-  } else {
-    $agentnum = $packet->{agentnum}
-                || $conf->config('signup_server-default_agentnum');
-  }
+  my $agentnum = get_agentnum($packet);
+  return $agentnum if ref($agentnum);
 
   #shares some stuff with htdocs/edit/process/cust_main.cgi... take any
   # common that are still here and library them.
@@ -953,6 +960,8 @@ sub new_customer_minimal {
         payinfo paycvv paydate payname paystate paytype
         paystart_month paystart_year payissue
         payip
+
+        locale
       ),
 
   } );
@@ -1205,4 +1214,193 @@ sub capture_payment {
 
 }
 
+=item get_agentnum PACKET
+
+Given a PACKET from the signup server, looks up the agentnum to use for signing
+up a customer. This will use 'session_id' if the agent is authenticated,
+otherwise 'agentnum', otherwise the 'signup_server-default_agentnum' config. If
+the agent can't be found, returns an error packet.
+
+=cut
+
+sub get_agentnum {
+  my $packet = shift;
+  my $conf = new FS::Conf;
+  my $agentnum;
+  if ( exists $packet->{'session_id'} ) {
+    my $cache = new FS::ClientAPI_SessionCache( {
+      'namespace' => 'FS::ClientAPI::Agent',
+    } );
+    my $session = $cache->get($packet->{'session_id'});
+    if ( $session ) {
+      $agentnum = $session->{'agentnum'};
+    } else {
+      return { 'error' => "Can't resume session" }; #better error message
+    }
+  } else {
+    $agentnum = $packet->{agentnum}
+                || $conf->config('signup_server-default_agentnum');
+  }
+  if ( $agentnum and FS::agent->count('agentnum = ?', $agentnum) ) {
+    return $agentnum;
+  }
+  return { 'error' => 'Signup is not configured' };
+}
+
+=item new_prospect PACKET
+
+Creates a new L<FS::prospect_main> entry. PACKET must contain:
+
+- either agentnum or session_id; if not, signup_server-default_agentnum will
+be used and must not be empty
+
+- either refnum or referral_title; if not, signup_server-default_refnum will
+be used and must not be empty
+
+- last and first (names), and optionally company and title
+
+- address1, city, state, country, zip, and optionally address2
+
+- emailaddress
+
+and can also contain:
+
+- one or more of phone_daytime, phone_night, phone_mobile, and phone_fax
+
+- a 'comment' (will be attached to the contact)
+
+State and country will be normalized to Freeside state/country codes if
+necessary.
+
+=cut
+
+sub new_prospect {
+
+  my $packet = shift;
+  warn "$me new_prospect called\n".Dumper($packet) if $DEBUG;
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+  my $conf = FS::Conf->new;
+
+  my $error;
+
+  my $agentnum = get_agentnum($packet);
+  return $agentnum if ref $agentnum;
+  my $refnum;
+  if ( my $title = $packet->{referral_title} ) {
+    my $part_referral = qsearchs('part_referral', {
+        'agentnum'  => $agentnum,
+        'title'     => $title,
+    });
+    $part_referral ||= qsearchs('part_referral', {
+        'agentnum'  => '',
+        'title'     => $title,
+    });
+    if (!$part_referral) {
+      $part_referral = FS::part_referral->new({
+        'agentnum' => $agentnum,
+        'title'    => $title,
+        'referral' => $title,
+      });
+      $error = $part_referral->insert;
+      if ( $error ) {
+        warn "ERROR: could not create referral type '$title': $error\n";
+      }
+    }
+    $refnum = $part_referral->refnum;
+  } elsif ( $packet->{refnum} ) {
+    $refnum = $packet->{refnum};
+  }
+  $refnum ||= $conf->config('signup_server-default_refnum');
+  return { error => "Signup referral type is not configured" } if !$refnum;
+
+  my $prospect = FS::prospect_main->new({
+      'agentnum' => $agentnum,
+      'refnum'   => $refnum,
+      'company'  => $packet->{company},
+  });
+
+  my $location = FS::cust_location->new;
+  foreach ( qw(address1 address2 city county zip ) ) {
+    $location->set($_, $packet->{$_});
+  }
+  # normalize country and state if they're not already ISO codes
+  # easier than doing it on the client side--we already have the tables here
+  my $country = $packet->{country};
+  my $state = $packet->{state};
+  if (length($country) > 2) {
+    # it likes title case
+    $country = join(' ', map ucfirst, split(/\s+/, $country));
+    my $lsc = Locale::SubCountry->new($country);
+    if ($lsc) {
+      $country = uc($lsc->country_code);
+
+      if ($lsc->has_sub_countries) {
+        if ( $lsc->full_name($state) eq 'unknown' ) {
+          # then we were probably given a full name, so resolve it
+          $state = $lsc->code($state);
+          if ( $state eq 'unknown' ) {
+            # doesn't resolve as a full name either, return an error
+            $error = "Unknown state: ".$packet->{state};
+          } else {
+            $state = uc($state);
+          }
+        }
+      } # else state doesn't matter
+    } else {
+      # couldn't find the country in LSC
+      $error = "Unknown country: $country";
+    }
+  }
+  $location->set('country', $country);
+  $location->set('state', $state);
+
+  $error ||= $prospect->insert( cust_location => $location );
+  return { error => $error } if $error;
+
+  my $contact = FS::contact->new({
+      prospectnum   => $prospect->prospectnum,
+      locationnum   => $location->locationnum,
+      invoice_dest  => 'Y',
+  });
+  # use emailaddress pseudo-field behavior here
+  foreach (qw(last first title emailaddress comment)) {
+    $contact->set($_, $packet->{$_});
+  }
+  $error = $contact->insert;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return { error => $error };
+  }
+
+  foreach my $phone_type (qsearch('phone_type', {})) {
+    my $key = 'phone_' . lc($phone_type->typename);
+    my $phonenum = $packet->{$key};
+    if ( $phonenum ) {
+      # just to not have to supply country code from the other end
+      my $number = Number::Phone->new($location->country, $phonenum);
+      if (!$number) {
+        $error = 'invalid phone number';
+      } else {
+        my $phone = FS::contact_phone->new({
+            contactnum    => $contact->contactnum,
+            phonenum      => $phonenum,
+            countrycode   => $number->country_code,
+            phonetypenum  => $phone_type->phonetypenum,
+        });
+        $error = $phone->insert;
+      }
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return { error => $phone_type->typename . ' phone: ' . $error };
+      }
+    }
+  } # foreach $phone_type
+  
+  $dbh->commit if $oldAutoCommit;
+  return { prospectnum => $prospect->prospectnum };
+}
+
 1;