X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=b16d08137950b92b6a0259c4fceef2d062592906;hb=6f8a6c416174bcf8095c959085d14ba820425aad;hp=7aee8d02781bdcbe447e13f583ec77292fdd33e2;hpb=fcf83b9d956af1049af0d13812cc6756c78308b5;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 7aee8d027..b16d08137 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -14,12 +14,33 @@ use FS::pkg_svc; # 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 @@ -49,6 +70,8 @@ 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 ] ); @@ -78,7 +101,7 @@ inherits from FS::Record. The following fields are currently supported: =item otaker - order taker (assigned automatically if null, see L) =item manual_flag - If this field is set to 1, disables the automatic -unsuspensiond of this package when using the B config file. +unsuspension of this package when using the B config file. =back @@ -115,7 +138,13 @@ sub insert { 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; @@ -195,11 +224,11 @@ sub check { 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') ) { @@ -238,33 +267,11 @@ sub cancel { 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 $error = $cust_svc->cancel; - 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"; - } - } - - $error = $cust_svc->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "Error deleting cust_svc: $error"; + return "Error cancelling cust_svc: $error"; } } @@ -420,7 +427,26 @@ L). 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) + +=cut + +sub cust_svc { + my $self = shift; + if ( $self->{'_svcnum'} ) { + values %{ $self->{'_svcnum'}->cache }; + } else { + qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); + } } =item labels @@ -432,7 +458,7 @@ Returns a list of lists, calling the label method for all services sub labels { my $self = shift; - map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); + map { [ $_->label ] } $self->cust_svc; } =item cust_main @@ -446,6 +472,67 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +=item seconds_since TIMESTAMP + +Returns the number of seconds all accounts (see L) in this +package have been online since TIMESTAMP, according to the session monitor. + +TIMESTAMP is specified as a UNIX timestamp; see L. Also see +L and L 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 DATASRC DB_USERNAME DB_PASSWORD + +Returns the numbers of seconds all accounts (see L) in this +package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END +(exclusive), according to an external SQL radacct table, such as those +generated by ICRADIUS or FreeRADIUS. Sessions which started in the specified +range but are still open are counted from session start to the end of the +range. Also, sessions which end in the range but started earlier are counted +from the start of the range to session end. Finally, sessions which start +before the range but end after (or are still open) are counted for the entire +range. + +TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see +L. Also see L and L for conversion +functions. + + +=cut + +sub seconds_since_sqlradacct { + my($self, $start, $end, $datasrc, $db_user, $db_pass) = @_; + + my $dbh = DBI->connect($datasrc, $db_user, $db_pass) + or die "can't connect to $datasrc: ". $DBI::errstr; + + my $seconds = 0; + + foreach my $cust_svc ( + grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc + ) { + $seconds += $cust_svc->seconds_since_sqlradacct($start, $end, $dbh); + } + + $seconds; + +} + =back =head1 SUBROUTINES @@ -489,23 +576,20 @@ sub order { 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!"; @@ -513,10 +597,49 @@ sub order { 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{$_} }; @@ -535,8 +658,7 @@ sub order { 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; @@ -553,7 +675,7 @@ sub order { } #now add new packages, changing cust_svc records if necessary -# my($pkgpart); + my $pkgpart; while ($pkgpart=shift @{$pkgparts} ) { my $new = new FS::cust_pkg { @@ -571,8 +693,12 @@ sub order { 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"; @@ -589,7 +715,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.12 2001-10-22 08:29:42 ivan Exp $ +$Id: cust_pkg.pm,v 1.25 2002-10-12 13:26:45 ivan Exp $ =head1 BUGS @@ -600,11 +726,12 @@ In sub order, the @pkgparts array (passed by reference) is clobbered. 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 ?