registration codes

6 files changed, 473 insertions, 5 deletions

diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm
index dc627e9..46ef9e4 100644
--- a/FS/FS/ClientAPI/Signup.pm
+++ b/FS/FS/ClientAPI/Signup.pm
@@ -14,6 +14,7 @@ use FS::cust_pkg;
 use FS::svc_acct;
 use FS::acct_snarf;
 use FS::queue;
+use FS::reg_code;
 
 use FS::ClientAPI; #hmm
 FS::ClientAPI->register_handlers(
@@ -105,7 +106,22 @@ sub signup_info {
   }
 
   $signup_info->{'part_pkg'} = [];
-  if ( $packet->{'promo_code'} ) {
+
+  if ( $packet->{'reg_code'} ) {
+    $signup_info->{'part_pkg'} = 
+      [ map { { 'payby'   => [ $_->payby ], %{$_->hashref} } }
+          grep { $_->svcpart('svc_acct') }
+          map { $_->part_pkg }
+            qsearchs( 'reg_code', { 'code'     => $packet->{'reg_code'},
+                                    'agentnum' => $agentnum,              } )
+
+      ];
+
+    $signup_info->{'error'} = 'Unknown registration code'
+      unless @{ $signup_info->{'part_pkg'} };
+
+  } elsif ( $packet->{'promo_code'} ) {
+
     $signup_info->{'part_pkg'} =
       [ map { { 'payby'   => [ $_->payby ], %{$_->hashref} } }
           grep { $_->svcpart('svc_acct') }
@@ -209,10 +225,18 @@ sub new_customer {
       or return { 'error' => "WARNING: unknown pkgpart: $pkgpart" };
   my $svcpart = $part_pkg->svcpart('svc_acct');
 
+  my $reg_code = '';
+  if ( $packet->{'reg_code'} ) {
+    $reg_code = qsearchs( 'reg_code', { 'code'     => $packet->{'reg_code'},
+                                        'agentnum' => $agentnum,             } )
+      or return { 'error' => 'Unknown registration code' };
+  }
+
   my $cust_pkg = new FS::cust_pkg ( {
     #later#'custnum' => $custnum,
     'pkgpart'    => $packet->{'pkgpart'},
     'promo_code' => $packet->{'promo_code'},
+    'reg_code'   => $packet->{'reg_code'},
   } );
   #my $error = $cust_pkg->check;
   #return { 'error' => $error } if $error;
@@ -305,6 +329,11 @@ sub new_customer {
 
   }
 
+  if ( $reg_code ) {
+    $error = $reg_code->delete;
+    return { 'error' => $error } if $error;
+  }
+
   $error = $placeholder->delete;
   return { 'error' => $error } if $error;
 
diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm
index a9e41a6..3d8e677 100644
--- a/FS/FS/agent.pm
+++ b/FS/FS/agent.pm
@@ -5,6 +5,8 @@ use vars qw( @ISA );
 use FS::Record qw( dbh qsearch qsearchs );
 use FS::cust_main;
 use FS::agent_type;
+use FS::reg_code;
+#use Crypt::YAPassGen;
 
 @ISA = qw( FS::Record );
 
@@ -264,6 +266,65 @@ sub cancel_cust_main {
   shift->cust_main_sql(FS::cust_main->cancel_sql);
 }
 
+=item generate_reg_codes NUM PKGPART_ARRAYREF
+
+Generates the specified number of registration codes, allowing purchase of the
+specified package definitions.  Returns an array reference of the newly
+generated codes, or a scalar error message.
+
+=cut
+
+sub generate_reg_codes {
+  my( $self, $num, $pkgparts ) = @_;
+
+  my @codeset = ( 'A'..'Z' );
+
+  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;
+
+  my @codes = ();
+  for ( 1 ... $num ) {
+    my $reg_code = new FS::reg_code {
+      'agentnum' => $self->agentnum,
+      'code'     => join('', map($codeset[int(rand $#codeset)], (0..7) ) ),
+    };
+    my $error = $reg_code->insert($pkgparts);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+    push @codes, $reg_code->code;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  \@codes;
+
+}
+
+=item num_reg_code
+
+Returns the number of unused registration codes for this agent.
+
+=cut
+
+sub num_reg_code {
+  my $self = shift;
+  my $sth = dbh->prepare(
+    "SELECT COUNT(*) FROM reg_code WHERE agentnum = ?"
+  ) or die dbh->errstr;
+  $sth->execute($self->agentnum) or die $sth->errstr;
+  $sth->fetchrow_arrayref->[0];
+}
+
 =back
 
 =head1 BUGS
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 0c39f68..a6115a0 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -12,6 +12,7 @@ use FS::type_pkgs;
 use FS::pkg_svc;
 use FS::cust_bill_pkg;
 use FS::h_cust_svc;
+use FS::reg_code;
 
 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
 # setup }
@@ -176,6 +177,15 @@ sub insert {
     return $error;
   }
 
+  #if ( $self->reg_code ) {
+  #  my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
+  #  $error = $reg_code->delete;
+  #  if ( $error ) {
+  #    $dbh->rollback if $oldAutoCommit;
+  #    return $error;
+  #  }
+  #}
+
   my $conf = new FS::Conf;
   my $cust_main = $self->cust_main;
   my $part_pkg = $self->part_pkg;
@@ -289,7 +299,17 @@ sub check {
   ;
   return $error if $error;
 
-  if ( $self->promo_code ) {
+  if ( $self->reg_code ) {
+
+    unless ( grep { $self->pkgpart == $_->pkgpart }
+             map  { $_->reg_code_pkg }
+             qsearchs( 'reg_code', { 'code'     => $self->reg_code,
+                                     'agentnum' => $self->cust_main->agentnum })
+           ) {
+      return "Unknown registraiton code";
+    }
+
+  } elsif ( $self->promo_code ) {
 
     my $promo_part_pkg =
       qsearchs('part_pkg', {
@@ -297,7 +317,6 @@ sub check {
         'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
       } );
     return 'Unknown promotional code' unless $promo_part_pkg;
-    $self->pkgpart($promo_part_pkg->pkgpart);
 
   } else { 
 
diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index cef4a61..f210a67 100644
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -584,7 +584,7 @@ Returns the option value for the given name, or the empty string.
 =cut
 
 sub option {
-  my( $self, $opt ) = @_;
+  my( $self, $opt, $ornull ) = @_;
   my $part_pkg_option =
     qsearchs('part_pkg_option', {
       pkgpart    => $self->pkgpart,
@@ -594,7 +594,8 @@ sub option {
   my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
                      split("\n", $self->get('plandata') );
   return $plandata{$opt} if exists $plandata{$opt};
-  cluck "Package definition option $opt not found in options or plandata!\n";
+  cluck "Package definition option $opt not found in options or plandata!\n"
+    unless $ornull;
   '';
 }
 
diff --git a/FS/FS/reg_code.pm b/FS/FS/reg_code.pm
new file mode 100644
index 0000000..f48ccf0
--- /dev/null
+++ b/FS/FS/reg_code.pm
@@ -0,0 +1,223 @@
+package FS::reg_code;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw(qsearch dbh);
+use FS::agent;
+use FS::reg_code_pkg;
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::reg_code - One-time registration codes
+
+=head1 SYNOPSIS
+
+  use FS::reg_code;
+
+  $record = new FS::reg_code \%hash;
+  $record = new FS::reg_code { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::reg_code object is a one-time registration code.  FS::reg_code inherits
+from FS::Record.  The following fields are currently supported:
+
+=over 4
+
+=item codenum - primary key
+
+=item code - registration code string
+
+=item agentnum - Agent (see L<FS::agent>)
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new registration code.  To add the code to the database, see
+L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to.  You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'reg_code'; }
+
+=item insert [ PKGPART_ARRAYREF ] 
+
+Adds this record to the database.  If an arrayref of pkgparts
+(see L<FS::part_pkg>) is specified, the appropriate reg_code_pkg records
+(see L<FS::reg_code_pkg>) will be inserted.
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub insert {
+  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;
+
+  my $error = $self->SUPER::insert;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  if ( @_ ) {
+    my $pkgparts = shift;
+    foreach my $pkgpart ( @$pkgparts ) {
+      my $reg_code_pkg = new FS::reg_code_pkg ( {
+        'codenum' => $self->codenum,
+        'pkgpart' => $pkgpart,
+      } );
+      $error = $reg_code_pkg->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
+=item delete
+
+Delete this record (and all associated reg_code_pkg records) from the database.
+
+=cut
+
+sub delete {
+  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 $reg_code_pkg ( $self->reg_code_pkg ) {
+    my $error = $reg_code_pkg->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  my $error = $self->SUPER::delete;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
+=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
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid registration code.  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_numbern('codenum')
+    || $self->ut_alpha('code')
+    || $self->ut_foreign_key('agentnum', 'agent', 'agentnum')
+  ;
+  return $error if $error;
+
+  $self->SUPER::check;
+}
+
+=item part_pkg
+
+Returns all package definitions (see L<FS::part_pkg> for this registration
+code.
+
+=cut
+
+sub part_pkg {
+  my $self = shift;
+  map { $_->part_pkg } $self->reg_code_pkg;
+}
+
+=item reg_code_pkg
+
+Returns all FS::reg_code_pkg records for this registration code.
+
+=cut
+
+sub reg_code_pkg {
+  my $self = shift;
+  qsearch('reg_code_pkg', { 'codenum' => $self->codenum } );
+}
+
+
+=back
+
+=head1 BUGS
+
+Feeping creaturitis.
+
+=head1 SEE ALSO
+
+L<FS::reg_code_pkg>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
+
diff --git a/FS/FS/reg_code_pkg.pm b/FS/FS/reg_code_pkg.pm
new file mode 100644
index 0000000..598497c
--- /dev/null
+++ b/FS/FS/reg_code_pkg.pm
@@ -0,0 +1,135 @@
+package FS::reg_code_pkg;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw(qsearchs);
+use FS::reg_code;
+use FS::part_pkg;
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::reg_code_pkg - Class linking registration codes (see L<FS::reg_code>) with package definitions (see L<FS::part_pkg>)
+
+=head1 SYNOPSIS
+
+  use FS::reg_code_pkg;
+
+  $record = new FS::reg_code_pkg \%hash;
+  $record = new FS::reg_code_pkg { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::reg_code_pkg object links a registration code to a package definition.
+FS::table_name inherits from FS::Record.  The following fields are currently
+supported:
+
+=over 4
+
+=item codenum - registration code (see L<FS::reg_code>)
+
+=item pkgpart - package definition (see L<FS::part_pkg>)
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new example.  To add the example to the database, see L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to.  You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'reg_code_pkg'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=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
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid record.  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_foreign_key('codenum', 'reg_code', 'codenum')
+    || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart')
+  ;
+  return $error if $error;
+
+  $self->SUPER::check;
+}
+
+=item part_pkg
+
+Returns the package definition (see L<FS::part_pkg>)
+
+=cut
+
+sub part_pkg {
+  my $self = shift;
+  qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart } );
+}
+
+=back
+
+=head1 BUGS
+
+Feeping creaturitis.
+
+=head1 SEE ALSO
+
+L<FS::reg_code_pkg>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
+