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;
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 );
=item bill - date (next bill date)
+=item last_bill - last bill date
+
=item susp - date
=item expire - date
$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<FS::cust_svc> and L<FS::part_svc>)
in this package, then cancels the package itself (sets the cancel field to
now).
+Available options are: I<quiet>
+
+I<quiet> 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';
$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
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,
}
+=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<svcnum> (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
=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
projects / freeside.git / blobdiff