use FS::cust_main;
use FS::type_pkgs;
use FS::pkg_svc;
+use FS::cust_bill_pkg;
# 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 setup - date
-=item bill - date
+=item bill - date (next bill date)
=item susp - date
=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.
+unsuspension of this package when using the B<unsuspendauto> config file.
=back
my $error = $self->ut_number('custnum');
return $error if $error;
- return "Unknown customer ". $self->custnum unless $self->cust_main;
+ 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 "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') ) {
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 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;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error cancelling service: $error"
- }
- $error = $svc->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error deleting service: $error";
- }
- }
+ my $error = $cust_svc->cancel;
- $error = $cust_svc->delete;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "Error deleting cust_svc: $error";
+ return "Error cancelling cust_svc: $error";
}
}
''; #no errors
}
+=item last_bill
+
+Returns the last bill date, or if there is no last bill date, the setup date.
+Useful for billing metered services.
+
+=cut
+
+sub last_bill {
+ my $self = shift;
+ my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
+ 'edate' => $self->bill, } );
+ $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
+}
+
=item part_pkg
Returns the definition for this billing item, as an FS::part_pkg object (see
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
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, according to the session monitor.
+
+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;
+
+}
+
+=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
+
+Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
+package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
+(exclusive).
+
+TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
+L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
+functions.
+
+
+=cut
+
+sub seconds_since_sqlradacct {
+ my($self, $start, $end) = @_;
+
+ my $seconds = 0;
+
+ foreach my $cust_svc (
+ grep {
+ my $part_svc = $_->part_svc;
+ $part_svc->svcdb eq 'svc_acct'
+ && scalar($part_svc->part_export('sqlradius'));
+ } $self->cust_svc
+ ) {
+ $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
+ }
+
+ $seconds;
+
+}
+
+=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
+
+Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
+in this package for sessions ending between TIMESTAMP_START (inclusive) and
+TIMESTAMP_END
+(exclusive).
+
+TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
+L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
+functions.
+
+=cut
+
+sub attribute_since_sqlradacct {
+ my($self, $start, $end, $attrib) = @_;
+
+ my $sum = 0;
+
+ foreach my $cust_svc (
+ grep {
+ my $part_svc = $_->part_svc;
+ $part_svc->svcdb eq 'svc_acct'
+ && scalar($part_svc->part_export('sqlradius'));
+ } $self->cust_svc
+ ) {
+ $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
+ }
+
+ $sum;
+
+}
+
=back
=head1 SUBROUTINES
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} ) {
+ 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{$_} } : ();
- } map { $_->svcpart } qsearch('pkg_svc', { 'pkgpart' => $pkgpart })
+ } 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{$_} };
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});
unless ( $old ) {
$dbh->rollback if $oldAutoCommit;
}
#now add new packages, changing cust_svc records if necessary
-# my($pkgpart);
+ my $pkgpart;
while ($pkgpart=shift @{$pkgparts} ) {
my $new = new FS::cust_pkg {
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);
+ 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";
=back
-=head1 VERSION
-
-$Id: cust_pkg.pm,v 1.10 2001-10-15 12:16:42 ivan Exp $
-
=head1 BUGS
sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
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, FS::svc_ip 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 ?