freeside/FS/FS reg_code.pm,NONE,1.1 reg_code_pkg.pm,NONE,1.1 cust_pkg.pm,1.54,1.55 agent.pm,1.8,1.9 part_pkg.pm,1.32,1.33
ivan
ivan at pouncequick.420.am
Sat Jan 29 04:34:15 PST 2005
Update of /home/cvs/cvsroot/freeside/FS/FS
In directory pouncequick:/tmp/cvs-serv3172/FS/FS
Modified Files:
cust_pkg.pm agent.pm part_pkg.pm
Added Files:
reg_code.pm reg_code_pkg.pm
Log Message:
registration codes
--- NEW FILE: reg_code_pkg.pm ---
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;
Index: cust_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pkg.pm,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -d -r1.54 -r1.55
--- cust_pkg.pm 27 Jan 2005 22:19:36 -0000 1.54
+++ cust_pkg.pm 29 Jan 2005 12:34:10 -0000 1.55
@@ -12,6 +12,7 @@
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 @@
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 @@
;
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 @@
'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
} );
return 'Unknown promotional code' unless $promo_part_pkg;
- $self->pkgpart($promo_part_pkg->pkgpart);
} else {
Index: part_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/part_pkg.pm,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -d -r1.32 -r1.33
--- part_pkg.pm 23 Dec 2004 09:07:34 -0000 1.32
+++ part_pkg.pm 29 Jan 2005 12:34:10 -0000 1.33
@@ -584,7 +584,7 @@
=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 @@
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;
'';
}
--- NEW FILE: reg_code.pm ---
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;
Index: agent.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/agent.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- agent.pm 1 Jul 2004 12:45:04 -0000 1.8
+++ agent.pm 29 Jan 2005 12:34:10 -0000 1.9
@@ -5,6 +5,8 @@
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 );
@@ -262,6 +264,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
More information about the freeside-commits
mailing list