X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=a3297ab4739d20ed1df2e18765af95466fa01aa2;hb=74d6490b9bb61dfb0a4f0633e074ab6126638bdb;hp=c6fabe5cb8344eee7b3ffb98434c59e4c0f8fd64;hpb=5c0eff524454c3e66a0fbe90250884d0a7578284;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index c6fabe5cb..a3297ab47 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,7 +1,7 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA); +use vars qw(@ISA $disable_agentcheck $DEBUG); use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearch qsearchs ); use FS::cust_svc; @@ -9,6 +9,7 @@ use FS::part_pkg; 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 } @@ -17,9 +18,21 @@ use FS::svc_acct; use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_www; +use FS::svc_forward; + +# need all this for sending cancel emails in sub cancel + +use FS::Conf; +use Date::Format; +use Mail::Internet 1.44; +use Mail::Header; @ISA = qw( FS::Record ); +$DEBUG = 0; + +$disable_agentcheck = 0; + sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; @@ -70,6 +83,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 ] ); @@ -88,7 +103,7 @@ inherits from FS::Record. The following fields are currently supported: =item setup - date -=item bill - date +=item bill - date (next bill date) =item susp - date @@ -136,7 +151,16 @@ 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 custnum: ". $self->custnum unless $cust_main; + + unless ( $disable_agentcheck ) { + 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; @@ -216,33 +240,39 @@ 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') ) { - $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag"; + $self->manual_flag('') if $self->manual_flag eq ' '; + $self->manual_flag =~ /^([01]?)$/ + or return "Illegal manual_flag ". $self->manual_flag; $self->manual_flag($1); } ''; #no error } -=item cancel +=item cancel [ OPTION => VALUE ... ] Cancels and removes all services (see L and L) in this package, then cancels the package itself (sets the cancel field to now). +Available options are: I + +I can be set true to supress email cancellation notices. + If there is an error, returns the error, otherwise returns false. =cut sub cancel { - my $self = shift; + my( $self, %options ) = @_; my $error; local $SIG{HUP} = 'IGNORE'; @@ -259,33 +289,11 @@ sub cancel { 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 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"; - } - } - - $error = $cust_svc->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "Error deleting cust_svc: $error"; + return "Error cancelling cust_svc: $error"; } } @@ -303,7 +311,43 @@ sub cancel { $dbh->commit or die $dbh->errstr if $oldAutoCommit; + my $conf = new FS::Conf; + + if ( !$options{'quiet'} && $conf->exists('emailcancel') + && grep { $_ ne 'POST' } $self->cust_main->invoicing_list) { + + my @invoicing_list = $self->cust_main->invoicing_list; + + my $invoice_from = $conf->config('invoice_from'); + my @print_text = map "$_\n", $conf->config('cancelmessage'); + my $subject = $conf->config('cancelsubject'); + my $smtpmachine = $conf->config('smtpmachine'); + + if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice + #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card + #$ENV{SMTPHOSTS} = $smtpmachine; + $ENV{MAILADDRESS} = $invoice_from; + my $header = new Mail::Header ( [ + "From: $invoice_from", + "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), + "Sender: $invoice_from", + "Reply-To: $invoice_from", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: $subject", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ @print_text ], + ); + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ); + #should this return an error? + } + } + ''; #no errors + } =item suspend @@ -418,7 +462,10 @@ sub unsuspend { unless ( ! $self->getfield('susp') ) { my %hash = $self->hash; + my $inactive = time - $hash{'susp'}; $hash{'susp'} = ''; + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive + if $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace($self); if ( $error ) { @@ -432,6 +479,24 @@ sub unsuspend { ''; #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; + if ( $self->dbdef_table->column('last_bill') ) { + return $self->setfield('last_bill', $_[1]) if @_; + return $self->getfield('last_bill') if $self->getfield('last_bill'); + } + 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 @@ -486,6 +551,131 @@ 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 + +Returns the numbers of seconds all accounts (see L) 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. Also see L and L 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) +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. Also see L and L 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; + +} + +=item reexport + +This method is deprecated. See the I option to the insert and +order_pkgs methods in FS::cust_main for a better way to defer provisioning. + +=cut + +sub reexport { + 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 $cust_svc ( $self->cust_svc ) { + #false laziness w/svc_Common::insert + my $svc_x = $cust_svc->svc_x; + foreach my $part_export ( $cust_svc->part_svc->part_export ) { + my $error = $part_export->export_insert($svc_x); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =back =head1 SUBROUTINES @@ -529,34 +719,100 @@ 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; } } + if ( $DEBUG ) { + foreach my $svcpart ( keys %svcnum ) { + warn "initial svcpart $svcpart: existing svcnums ". + join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n"; + } + } - 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 }) + my $svcnum = $svcnum{$_->{svcpart}}; + if ( $svcnum && @$svcnum ) { + my $num = ( $_->{quantity} < scalar(@$svcnum) ) + ? $_->{quantity} + : scalar(@$svcnum); + splice @$svcnum, 0, $num; + } else { + (); + } + } map { { 'svcpart' => $_->svcpart, + 'quantity' => $_->quantity } } + qsearch('pkg_svc', { pkgpart => $pkgpart, + quantity => { op=>'>', value=>'0', } } ) ]; } + if ( $DEBUG ) { + foreach my $svcpart ( keys %svcnum ) { + warn "after regular move svcpart $svcpart: existing svcnums ". + join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n"; + } + } + + #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++; + } + + } + + if ( $DEBUG ) { + foreach my $svcpart ( keys %svcnum ) { + warn "after special-case move svcpart $svcpart: existing svcnums ". + join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n"; + } + } + + #check for leftover services foreach (keys %svcnum) { next unless @{ $svcnum{$_} }; @@ -575,8 +831,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; @@ -593,7 +848,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 { @@ -611,8 +866,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"; @@ -627,10 +886,6 @@ sub order { =back -=head1 VERSION - -$Id: cust_pkg.pm,v 1.14 2001-11-30 00:04:38 ivan Exp $ - =head1 BUGS sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?