use strict;
use vars qw(@ISA);
-use FS::UID qw( getotaker );
+use FS::UID qw( getotaker dbh );
use FS::Record qw( qsearch qsearchs );
use FS::cust_svc;
use FS::part_pkg;
use FS::svc_acct;
use FS::svc_acct_sm;
use FS::svc_domain;
+use FS::svc_www;
@ISA = qw( FS::Record );
=item otaker - order taker (assigned automatically if null, see L<FS::UID>)
+=item manual_flag - If this field is set to 1, disables the automatic
+unsuspensiond of this package when using the B<unsuspendauto> config file.
+
=back
Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
Adds this billing item to the database ("Orders" the item). If there is an
error, returns the error, otherwise returns false.
+=cut
+
sub insert {
my $self = shift;
# custnum might not have have been defined in sub check (for one-shot new
# customers), so check it here instead
+ # (is this still necessary with transactions?)
my $error = $self->ut_number('custnum');
- return $error if $error
+ return $error if $error;
- return "Unknown customer"
- unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+ return "Unknown customer ". $self->custnum unless $self->cust_main;
$self->SUPER::insert;
return $error if $error;
if ( $self->custnum ) {
- return "Unknown customer"
- unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+ return "Unknown customer ". $self->custnum unless $self->cust_main;
}
return "Unknown pkgpart"
$self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
$self->otaker($1);
+ if ( $self->dbdef_table->column('manual_flag') ) {
+ $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
+ $self->manual_flag($1);
+ }
+
''; #no error
}
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 (
qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
) {
my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
- $part_svc->svcdb =~ /^([\w\-]+)$/
- or return "Illegal svcdb value in part_svc!";
+ $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal svcdb value in part_svc!";
+ };
my $svcdb = $1;
require "FS/$svcdb.pm";
my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
if ($svc) {
$error = $svc->cancel;
- return "Error cancelling service: $error" if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error cancelling service: $error"
+ }
$error = $svc->delete;
- return "Error deleting service: $error" if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error deleting service: $error";
+ }
}
$error = $cust_svc->delete;
- return "Error deleting cust_svc: $error" if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error deleting cust_svc: $error";
+ }
}
$hash{'cancel'} = time;
my $new = new FS::cust_pkg ( \%hash );
$error = $new->replace($self);
- return $error if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
}
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
''; #no errors
}
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 (
qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
) {
my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
- $part_svc->svcdb =~ /^([\w\-]+)$/
- or return "Illegal svcdb value in part_svc!";
+ $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal svcdb value in part_svc!";
+ };
my $svcdb = $1;
require "FS/$svcdb.pm";
my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
if ($svc) {
$error = $svc->suspend;
- return $error if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
}
}
$hash{'susp'} = time;
my $new = new FS::cust_pkg ( \%hash );
$error = $new->replace($self);
- return $error if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
}
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
''; #no errors
}
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 (
qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
) {
my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
- $part_svc->svcdb =~ /^([\w\-]+)$/
- or return "Illegal svcdb value in part_svc!";
+ $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal svcdb value in part_svc!";
+ };
my $svcdb = $1;
require "FS/$svcdb.pm";
my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
if ($svc) {
$error = $svc->unsuspend;
- return $error if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
}
}
$hash{'susp'} = '';
my $new = new FS::cust_pkg ( \%hash );
$error = $new->replace($self);
- return $error if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
}
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
''; #no errors
}
map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
}
+=item cust_main
+
+Returns the parent customer object (see L<FS::cust_main>).
+
+=cut
+
+sub cust_main {
+ my $self = shift;
+ qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+}
+
=back
=head1 SUBROUTINES
=over 4
-=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
+=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
CUSTNUM is a customer (see L<FS::cust_main>)
REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
remove for this customer. The services (see L<FS::cust_svc>) are moved to the
new billing items. An error is returned if this is not possible (see
-L<FS::pkg_svc>).
+L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
+parameter.
+
+RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
+newly-created cust_pkg objects.
=cut
sub order {
- my($custnum,$pkgparts,$remove_pkgnums)=@_;
+ my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_;
+ $remove_pkgnums = [] unless defined($remove_pkgnums);
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
# generate %part_pkg
# $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
# @cust_svc is a corresponding list of lists of FS::Record objects
my($pkgpart);
foreach $pkgpart ( @{$pkgparts} ) {
- return "Customer not permitted to purchase pkgpart $pkgpart!"
- unless $part_pkg{$pkgpart};
+ unless ( $part_pkg{$pkgpart} ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Customer not permitted to purchase pkgpart $pkgpart!";
+ }
push @cust_svc, [
map {
( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
#check for leftover services
foreach (keys %svcnum) {
next unless @{ $svcnum{$_} };
+ $dbh->rollback if $oldAutoCommit;
return "Leftover services, svcpart $_: svcnum ".
join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
}
# my($pkgnum);
foreach $pkgnum ( @{$remove_pkgnums} ) {
my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- die "Package $pkgnum not found to remove!" unless $old;
+ unless ( $old ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Package $pkgnum not found to remove!";
+ }
my(%hash) = $old->hash;
$hash{'cancel'}=time;
my($new) = new FS::cust_pkg ( \%hash );
my($error)=$new->replace($old);
- die "Couldn't update package $pkgnum: $error" if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Couldn't update package $pkgnum: $error";
+ }
}
#now add new packages, changing cust_svc records if necessary
# my($pkgpart);
while ($pkgpart=shift @{$pkgparts} ) {
- my($new) = new FS::cust_pkg ( {
- 'custnum' => $custnum,
- 'pkgpart' => $pkgpart,
- } );
- my($error) = $new->insert;
- die "Couldn't insert new cust_pkg record: $error" if $error;
- my($pkgnum)=$new->getfield('pkgnum');
+ my $new = new FS::cust_pkg {
+ 'custnum' => $custnum,
+ 'pkgpart' => $pkgpart,
+ };
+ my $error = $new->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Couldn't insert new cust_pkg record: $error";
+ }
+ push @{$return_cust_pkg}, $new if $return_cust_pkg;
+ my $pkgnum = $new->pkgnum;
- my($cust_svc);
- foreach $cust_svc ( @{ shift @cust_svc } ) {
+ foreach my $cust_svc ( @{ shift @cust_svc } ) {
my(%hash) = $cust_svc->hash;
$hash{'pkgnum'}=$pkgnum;
my($new) = new FS::cust_svc ( \%hash );
my($error)=$new->replace($cust_svc);
- die "Couldn't link old service to new package: $error" if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Couldn't link old service to new package: $error";
+ }
}
}
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
''; #no errors
}
=head1 VERSION
-$Id: cust_pkg.pm,v 1.3 1999-11-08 21:38:38 ivan Exp $
+$Id: cust_pkg.pm,v 1.10 2001-10-15 12:16:42 ivan Exp $
=head1 BUGS
Probably need a subroutine which decides what to do based on whether or not
we've fetched the user yet, rather than a hash. See FS::UID and the TODO.
+Now that things are transactional should the check in the insert method be
+moved to check ?
+
=head1 SEE ALSO
-L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
-, L<FS::pkg_svc>, schema.html from the base documentation
+L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
+L<FS::pkg_svc>, schema.html from the base documentation
=cut
projects / freeside.git / blobdiff