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::cust_main;
use FS::type_pkgs;
+use FS::pkg_svc;
# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
# setup }
# because they load configuraion by setting FS::UID::callback (see TODO)
use FS::svc_acct;
-use FS::svc_acct_sm;
use FS::svc_domain;
+use FS::svc_www;
+use FS::svc_forward;
@ISA = qw( FS::Record );
+sub _cache {
+ my $self = shift;
+ my ( $hashref, $cache ) = @_;
+ #if ( $hashref->{'pkgpart'} ) {
+ if ( $hashref->{'pkg'} ) {
+ # #@{ $self->{'_pkgnum'} } = ();
+ # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
+ # $self->{'_pkgpart'} = $subcache;
+ # #push @{ $self->{'_pkgnum'} },
+ # FS::part_pkg->new_or_cached($hashref, $subcache);
+ $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
+ }
+ if ( exists $hashref->{'svcnum'} ) {
+ #@{ $self->{'_pkgnum'} } = ();
+ my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
+ $self->{'_svcnum'} = $subcache;
+ #push @{ $self->{'_pkgnum'} },
+ FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
+ }
+}
+
=head1 NAME
FS::cust_pkg - Object methods for cust_pkg objects
@labels = $record->labels;
+ $seconds = $record->seconds_since($timestamp);
+
$error = FS::cust_pkg::order( $custnum, \@pkgparts );
$error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
=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
+unsuspension 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 } );
+ my $cust_main = $self->cust_main;
+ return "Unknown customer ". $self->custnum unless $cust_main;
+
+ my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
+ my $pkgpart_href = $agent->pkgpart_hashref;
+ return "agent ". $agent->agentnum. " can't purchase pkgpart ". $self->pkgpart
+ unless $pkgpart_href->{ $self->pkgpart };
$self->SUPER::insert;
=item delete
-Currently unimplemented. You don't want to delete billing items, because there
-would then be no record the customer ever purchased the item. Instead, see
-the cancel method.
+This method now works but you probably shouldn't use it.
+
+You don't want to delete billing items, because there would then be no record
+the customer ever purchased the item. Instead, see the cancel method.
=cut
-sub delete {
- return "Can't delete cust_pkg records!";
-}
+#sub delete {
+# return "Can't delete cust_pkg records!";
+#}
=item replace OLD_RECORD
#return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
return "Can't change otaker!" if $old->otaker ne $new->otaker;
- return "Can't change setup once it exists!"
- if $old->getfield('setup') &&
- $old->getfield('setup') != $new->getfield('setup');
+
+ #allow this *sigh*
+ #return "Can't change setup once it exists!"
+ # if $old->getfield('setup') &&
+ # $old->getfield('setup') != $new->getfield('setup');
+
#some logic for bill, susp, cancel?
$new->SUPER::replace($old);
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"
+ return "Unknown pkgpart: ". $self->pkgpart
unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
$self->otaker(getotaker) unless $self->otaker;
- $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
+ $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 } );
+ my $error = $cust_svc->cancel;
- $part_svc->svcdb =~ /^([\w\-]+)$/
- or 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;
- $error = $svc->delete;
- return "Error deleting service: $error" if $error;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error cancelling cust_svc: $error";
}
- $error = $cust_svc->delete;
- return "Error deleting cust_svc: $error" if $error;
-
}
unless ( $self->getfield('cancel') ) {
$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
}
=item part_pkg
Returns the definition for this billing item, as an FS::part_pkg object (see
-L<FS::part_pkg).
+L<FS::part_pkg>).
=cut
sub part_pkg {
my $self = shift;
- qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+ #exists( $self->{'_pkgpart'} )
+ $self->{'_pkgpart'}
+ ? $self->{'_pkgpart'}
+ : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item cust_svc
+
+Returns the services for this package, as FS::cust_svc objects (see
+L<FS::cust_svc>)
+
+=cut
+
+sub cust_svc {
+ my $self = shift;
+ if ( $self->{'_svcnum'} ) {
+ values %{ $self->{'_svcnum'}->cache };
+ } else {
+ qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+ }
}
=item labels
sub labels {
my $self = shift;
- map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+ map { [ $_->label ] } $self->cust_svc;
+}
+
+=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 } );
+}
+
+=item seconds_since TIMESTAMP
+
+Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
+package have been online since TIMESTAMP.
+
+TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub seconds_since {
+ my($self, $since) = @_;
+ my $seconds = 0;
+
+ foreach my $cust_svc (
+ grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
+ ) {
+ $seconds += $cust_svc->seconds_since($since);
+ }
+
+ $seconds;
+
}
=back
=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
my(%svcnum);
# generate %svcnum
# for those packages being removed:
- #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
- # objects (table eq 'cust_svc')
+ #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::cust_svc objects
my($pkgnum);
foreach $pkgnum ( @{$remove_pkgnums} ) {
- my($cust_svc);
- foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
+ foreach my $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
}
}
- my(@cust_svc);
+ my @cust_svc;
#generate @cust_svc
# for those packages the customer is purchasing:
# @{$pkgparts} is a list of said packages, by 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};
+ foreach my $pkgpart ( @{$pkgparts} ) {
+ unless ( $part_pkg{$pkgpart} ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Customer not permitted to purchase pkgpart $pkgpart!";
+ }
push @cust_svc, [
map {
( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
- } (split(/,/,
- qsearchs('part_pkg',{'pkgpart'=>$pkgpart})->getfield('services')
- ))
+ } map { $_->svcpart }
+ qsearch('pkg_svc', { pkgpart => $pkgpart,
+ quantity => { op=>'>', value=>'0', } } )
];
}
+ #special-case until this can be handled better
+ # move services to new svcparts - even if the svcparts don't match (svcdb
+ # needs to...)
+ # looks like they're moved in no particular order, ewwwwwwww
+ # and looks like just one of each svcpart can be moved... o well
+
+ #start with still-leftover services
+ #foreach my $svcpart ( grep { scalar(@{ $svcnum{$_} }) } keys %svcnum ) {
+ foreach my $svcpart ( keys %svcnum ) {
+ next unless @{ $svcnum{$svcpart} };
+
+ my $svcdb = $svcnum{$svcpart}->[0]->part_svc->svcdb;
+
+ #find an empty place to put one
+ my $i = 0;
+ foreach my $pkgpart ( @{$pkgparts} ) {
+ my @pkg_svc =
+ qsearch('pkg_svc', { pkgpart => $pkgpart,
+ quantity => { op=>'>', value=>'0', } } );
+ #my @pkg_svc =
+ # grep { $_->quantity > 0 } qsearch('pkg_svc', { pkgpart=>$pkgpart } );
+ if ( ! @{$cust_svc[$i]} #find an empty place to put them with
+ && grep { $svcdb eq $_->part_svc->svcdb } #with appropriate svcdb
+ @pkg_svc
+ ) {
+ my $new_svcpart =
+ ( grep { $svcdb eq $_->part_svc->svcdb } @pkg_svc )[0]->svcpart;
+ my $cust_svc = shift @{$svcnum{$svcpart}};
+ $cust_svc->svcpart($new_svcpart);
+ #warn "changing from $svcpart to $new_svcpart!!!\n";
+ $cust_svc[$i] = [ $cust_svc ];
+ }
+ $i++;
+ }
+
+ }
+
#check for leftover services
foreach (keys %svcnum) {
next unless @{ $svcnum{$_} };
- return "Leftover services!";
+ $dbh->rollback if $oldAutoCommit;
+ return "Leftover services, svcpart $_: svcnum ".
+ join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
}
#no leftover services, let's make changes.
local $SIG{PIPE} = 'IGNORE';
#first cancel old packages
-# my($pkgnum);
- foreach $pkgnum ( @{$remove_pkgnums} ) {
+ foreach my $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);
+ 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;
+ my $new = new FS::cust_svc ( \%hash );
+
+ #avoid Record diffing missing changed svcpart field from above.
+ my $old = qsearchs('cust_svc', { 'svcnum' => $cust_svc->svcnum } );
+
+ my $error = $new->replace($old);
+ 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.1 1999-08-04 09:03:53 ivan Exp $
+$Id: cust_pkg.pm,v 1.24 2002-09-17 09:19:06 ivan Exp $
=head1 BUGS
Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
method to pass dates to the recur_prog expression, it should do so.
-FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at
-compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
-cancel } because they use %FS::UID::callback to load configuration values.
-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.
+FS::svc_acct, FS::svc_domain, FS::svc_www and FS::svc_forward are loaded via
+'use' at compile time, rather than via 'require' in sub
+{ setup, suspend, unsuspend, cancel } because they use %FS::UID::callback to
+load configuration values. 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