X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=d9a6385e23e86038212e01115415ec3bee95d101;hp=4eea2c0877a2ca81cb1c60003ee5bc753155f9f7;hb=2d82b5b713c7c11d2d54a018d121b80fd6485c60;hpb=f3b8b72d2a07683b2deb2774f29407e25e725b5a diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 4eea2c087..d9a6385e2 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2,9 +2,9 @@ package FS::cust_pkg; use strict; use vars qw(@ISA $disable_agentcheck); -use vars qw( $quiet ); use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearch qsearchs ); +use FS::Misc qw( send_email ); use FS::cust_svc; use FS::part_pkg; use FS::cust_main; @@ -20,12 +20,8 @@ use FS::svc_domain; use FS::svc_www; use FS::svc_forward; -# need all this for sending cancel emails in sub cancel - +# 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 ); @@ -103,6 +99,8 @@ inherits from FS::Record. The following fields are currently supported: =item bill - date (next bill date) +=item last_bill - last bill date + =item susp - date =item expire - date @@ -246,25 +244,31 @@ sub check { $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 + $self->SUPER::check; } -=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'; @@ -304,38 +308,16 @@ sub cancel { $dbh->commit or die $dbh->errstr if $oldAutoCommit; my $conf = new FS::Conf; - - if ( !$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? - } + my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list; + if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { + my $conf = new FS::Conf; + my $error = send_email( + 'from' => $conf->config('invoice_from'), + 'to' => \@invoicing_list, + 'subject' => $conf->config('cancelsubject'), + 'body' => [ map "$_\n", $conf->config('cancelmessage') ], + ); + #should this do something on errors? } ''; #no errors @@ -477,8 +459,8 @@ Useful for billing metered services. sub last_bill { my $self = shift; - if ( $self->dbdef_table->column('manual_flag') ) { - return $self->setfield('last_bill', $_[1]) if @_; + if ( $self->dbdef_table->column('last_bill') ) { + return $self->setfield('last_bill', $_[0]) if @_; return $self->getfield('last_bill') if $self->getfield('last_bill'); } my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum, @@ -628,6 +610,96 @@ sub attribute_since_sqlradacct { } +=item transfer DEST_PKGNUM + +Transfers as many services as possible from this package to another package. +The destination package must already exist. Services are moved only if +the destination allows services with the correct I (not svcdb). +Any services that can't be moved remain in the original package. + +Returns an error, if there is one; otherwise, returns the number of services +that couldn't be moved. + +=cut + +sub transfer { + my ($self, $dest_pkgnum) = @_; + + my $remaining = 0; + my $dest; + my %target; + my $pkg_svc; + + if (ref ($dest_pkgnum) eq 'FS::cust_pkg') { + $dest = $dest_pkgnum; + $dest_pkgnum = $dest->pkgnum; + } else { + $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum }); + } + + return ('Package does not exist: '.$dest_pkgnum) unless $dest; + + foreach $pkg_svc (qsearch('pkg_svc', { pkgpart => $dest->pkgpart })) { + $target{$pkg_svc->svcpart} = $pkg_svc->quantity; + } + + my $cust_svc; + + foreach $cust_svc ($dest->cust_svc) { + $target{$cust_svc->svcpart}--; + } + + foreach $cust_svc ($self->cust_svc) { + if($target{$cust_svc->svcpart} > 0) { + $target{$cust_svc->svcpart}--; + my $new = new FS::cust_svc { + svcnum => $cust_svc->svcnum, + svcpart => $cust_svc->svcpart, + pkgnum => $dest_pkgnum }; + my $error = $new->replace($cust_svc); + return $error if $error; + } else { + $remaining++ + } + } + return $remaining; +} + +=item reexport + +=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 @@ -654,156 +726,62 @@ newly-created cust_pkg objects. =cut sub order { - my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_; - $remove_pkgnums = [] unless defined($remove_pkgnums); + # Rewritten to make use of the transfer() method, and in general + # to not suck so badly. + + my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_; + + # Transactionize this whole mess 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($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum}); - my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); - my %part_pkg = %{ $agent->pkgpart_hashref }; - - my(%svcnum); - # generate %svcnum - # for those packages being removed: - #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::cust_svc objects - my($pkgnum); - foreach $pkgnum ( @{$remove_pkgnums} ) { - foreach my $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) { - push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $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 - foreach my $pkgpart ( @{$pkgparts} ) { - unless ( $part_pkg{$pkgpart} ) { + my $error; + my $cust_main = qsearchs('cust_main', { custnum => $custnum }); + return "Customer not found: $custnum" unless $cust_main; + + # Create the new packages. + my $cust_pkg; + foreach (@$pkgparts) { + $cust_pkg = new FS::cust_pkg { custnum => $custnum, + pkgpart => $_ }; + $error = $cust_pkg->insert; + if ($error) { $dbh->rollback if $oldAutoCommit; - return "Customer not permitted to purchase pkgpart $pkgpart!"; + return $error; } - push @cust_svc, [ - map { - ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : (); - } map { $_->svcpart } - qsearch('pkg_svc', { pkgpart => $pkgpart, - quantity => { op=>'>', value=>'0', } } ) - ]; + push @$return_cust_pkg, $cust_pkg; } - - #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 ]; + # $return_cust_pkg now contains refs to all of the newly + # created packages. + + # Transfer services and cancel old packages. + foreach my $old_pkgnum (@$remove_pkgnum) { + my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum }); + foreach my $new_pkg (@$return_cust_pkg) { + $error = $old_pkg->transfer($new_pkg); + if ($error and $error == 0) { + # $old_pkg->transfer failed. + $dbh->rollback if $oldAutoCommit; + return $error; } - $i++; } - - } - - #check for leftover services - foreach (keys %svcnum) { - next unless @{ $svcnum{$_} }; - $dbh->rollback if $oldAutoCommit; - return "Leftover services, svcpart $_: svcnum ". - join(', ', map { $_->svcnum } @{ $svcnum{$_} } ); - } - - #no leftover services, let's make changes. - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - #first cancel old packages - foreach my $pkgnum ( @{$remove_pkgnums} ) { - my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); - unless ( $old ) { + if ($error > 0) { + # Transfers were successful, but we went through all of the + # new packages and still had services left on the old package. + # We can't cancel the package under the circumstances, so abort. $dbh->rollback if $oldAutoCommit; - return "Package $pkgnum not found to remove!"; + return "Unable to transfer all services from package ".$old_pkg->pkgnum; } - my(%hash) = $old->hash; - $hash{'cancel'}=time; - my($new) = new FS::cust_pkg ( \%hash ); - my($error)=$new->replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Couldn't update package $pkgnum: $error"; + $error = $old_pkg->cancel; + if ($error) { + $dbh->rollback; + return $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; - 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; - - foreach my $cust_svc ( @{ shift @cust_svc } ) { - my(%hash) = $cust_svc->hash; - $hash{'pkgnum'}=$pkgnum; - 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 + ''; } =back