X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=0cb1b50a20d142ed75c98a98bd22e5eaaf766b15;hp=c34eb43b5374279484fb1c89a7d707feda54e8c9;hb=fe4515eb37d76849dd08c62782d86bc7ba311dcd;hpb=f8c8b9782ff5400790c2fb6dae017ce01790e56e diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index c34eb43b5..0cb1b50a2 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,26 +1,30 @@ package FS::cust_pkg; +use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin + FS::contact_Mixin FS::location_Mixin + FS::m2m_Common FS::option_Common ); use strict; -use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin - FS::m2m_Common FS::option_Common ); use vars qw($disable_agentcheck $DEBUG $me); use Carp qw(cluck); use Scalar::Util qw( blessed ); -use List::Util qw(max); +use List::Util qw(min max); use Tie::IxHash; use Time::Local qw( timelocal timelocal_nocheck ); use MIME::Entity; -use FS::UID qw( getotaker dbh driver_name ); +use FS::UID qw( dbh driver_name ); use FS::Misc qw( send_email ); use FS::Record qw( qsearch qsearchs fields ); use FS::CurrentUser; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; +use FS::contact; use FS::cust_location; use FS::pkg_svc; use FS::cust_bill_pkg; use FS::cust_pkg_detail; +use FS::cust_pkg_usage; +use FS::cdr_cust_pkg_usage; use FS::cust_event; use FS::h_cust_svc; use FS::reg_code; @@ -30,7 +34,7 @@ use FS::reason; use FS::cust_pkg_discount; use FS::discount; use FS::UI::Web; -use Data::Dumper; +use FS::sales; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } @@ -197,6 +201,20 @@ Previous locationnum =item waive_setup +=item main_pkgnum + +The pkgnum of the package that this package is supplemental to, if any. + +=item pkglinknum + +The package link (L) that defines this supplemental +package, if it is one. + +=item change_to_pkgnum + +The pkgnum of the package this one will be "changed to" in the future +(on its expiration date). + =back Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date @@ -214,7 +232,7 @@ Create a new billing item. To add the item to the database, see L<"insert">. =cut sub table { 'cust_pkg'; } -sub cust_linked { $_[0]->cust_main_custnum; } +sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum } sub cust_unlinked_msg { my $self = shift; "WARNING: can't find cust_main.custnum ". $self->custnum. @@ -242,7 +260,8 @@ The following options are available: =item change -If set true, supresses any referral credit to a referring customer. +If set true, supresses actions that should only be taken for new package +orders. (Currently this includes: intro periods when delay_setup is on.) =item options @@ -256,6 +275,12 @@ a ticket will be added to this customer with this subject an optional queue name for ticket additions +=item allow_pkgpart + +Don't check the legality of the package definition. This should be used +when performing a package change that doesn't change the pkgpart (i.e. +a location change). + =back =cut @@ -263,11 +288,13 @@ an optional queue name for ticket additions sub insert { my( $self, %options ) = @_; - my $error = $self->check_pkgpart; + my $error; + $error = $self->check_pkgpart unless $options{'allow_pkgpart'}; return $error if $error; my $part_pkg = $self->part_pkg; + # if the package def says to start only on the first of the month: if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) { my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5]; $mon += 1 unless $mday == 1; @@ -275,6 +302,8 @@ sub insert { $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) ); } + # set up any automatic expire/adjourn/contract_end timers + # based on the start date foreach my $action ( qw(expire adjourn contract_end) ) { my $months = $part_pkg->option("${action}_months",1); if($months and !$self->$action) { @@ -283,12 +312,16 @@ sub insert { } } - my $free_days = $part_pkg->option('free_days',1); - if ( $free_days && $part_pkg->option('delay_setup',1) ) { #&& !$self->start_date - my ($mday,$mon,$year) = (localtime(time) )[3,4,5]; - #my $start_date = ($self->start_date || timelocal(0,0,0,$mday,$mon,$year)) + 86400 * $free_days; - my $start_date = timelocal(0,0,0,$mday,$mon,$year) + 86400 * $free_days; - $self->start_date($start_date); + # if this package has "free days" and delayed setup fee, tehn + # set start date that many days in the future. + # (this should have been set in the UI, but enforce it here) + if ( ! $options{'change'} + && ( my $free_days = $part_pkg->option('free_days',1) ) + && $part_pkg->option('delay_setup',1) + #&& ! $self->start_date + ) + { + $self->start_date( $part_pkg->default_start_date ); } $self->order_date(time); @@ -325,15 +358,6 @@ sub insert { } } - #if ( $self->reg_code ) { - # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } ); - # $error = $reg_code->delete; - # if ( $error ) { - # $dbh->rollback if $oldAutoCommit; - # return $error; - # } - #} - my $conf = new FS::Conf; if ( $conf->config('ticket_system') && $options{ticket_subject} ) { @@ -556,9 +580,12 @@ sub replace { } - my $error = $new->SUPER::replace($old, - $options->{options} ? $options->{options} : () - ); + my $error = $new->export_pkg_change($old) + || $new->SUPER::replace( $old, + $options->{options} + ? $options->{options} + : () + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -594,14 +621,18 @@ replace methods. sub check { my $self = shift; - $self->locationnum('') if !$self->locationnum || $self->locationnum == -1; + if ( !$self->locationnum or $self->locationnum == -1 ) { + $self->set('locationnum', $self->cust_main->ship_locationnum); + } my $error = $self->ut_numbern('pkgnum') || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') || $self->ut_numbern('pkgpart') - || $self->check_pkgpart + || $self->ut_foreign_keyn('contactnum', 'contact', 'contactnum' ) || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum') + || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum') + || $self->ut_numbern('quantity') || $self->ut_numbern('start_date') || $self->ut_numbern('setup') || $self->ut_numbern('bill') @@ -616,6 +647,9 @@ sub check { || $self->ut_numbern('agent_pkgid') || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ]) || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ]) + || $self->ut_foreign_keyn('main_pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_foreign_keyn('pkglinknum', 'part_pkg_link', 'pkglinknum') + || $self->ut_foreign_keyn('change_to_pkgnum', 'cust_pkg', 'pkgnum') ; return $error if $error; @@ -639,14 +673,19 @@ sub check { =item check_pkgpart +Check the pkgpart to make sure it's allowed with the reg_code and/or +promo_code of the package (if present) and with the customer's agent. +Called from C, unless we are doing a package change that doesn't +affect pkgpart. + =cut sub check_pkgpart { my $self = shift; - my $error = $self->ut_numbern('pkgpart'); - return $error if $error; + # my $error = $self->ut_numbern('pkgpart'); # already done + my $error; if ( $self->reg_code ) { unless ( grep { $self->pkgpart == $_->pkgpart } @@ -730,6 +769,11 @@ sub cancel { my( $self, %options ) = @_; my $error; + # pass all suspend/cancel actions to the main package + if ( $self->main_pkgnum and !$options{'from_main'} ) { + return $self->main_pkg->cancel(%options); + } + my $conf = new FS::Conf; warn "cust_pkg::cancel called with options". @@ -827,14 +871,40 @@ sub cancel { } #unless $date my %hash = $self->hash; - $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time); + if ( $date ) { + $hash{'expire'} = $date; + } else { + $hash{'cancel'} = $cancel_time; + } + $hash{'change_custnum'} = $options{'change_custnum'}; + my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace( $self, options => { $self->options } ); + if ( $self->change_to_pkgnum ) { + my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum); + $error ||= $change_to->cancel || $change_to->delete; + } if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + $error = $supp_pkg->cancel(%options, 'from_main' => 1); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + + foreach my $usage ( $self->cust_pkg_usage ) { + $error = $usage->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "deleting usage pools: $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; return '' if $date; #no errors @@ -894,6 +964,9 @@ svc_fatal: service provisioning errors are fatal svc_errors: pass an array reference, will be filled in with any provisioning errors +main_pkgnum: link the package as a supplemental package of this one. For +internal use only. + =cut sub uncancel { @@ -902,6 +975,10 @@ sub uncancel { #in case you try do do $uncancel-date = $cust_pkg->uncacel return '' unless $self->get('cancel'); + if ( $self->main_pkgnum and !$options{'main_pkgnum'} ) { + return $self->main_pkg->uncancel(%options); + } + ## # Transaction-alize ## @@ -926,6 +1003,7 @@ sub uncancel { bill => ( $options{'bill'} || $self->get('bill') ), uncancel => time, uncancel_pkgnum => $self->pkgnum, + main_pkgnum => ($options{'main_pkgnum'} || ''), map { $_ => $self->get($_) } qw( custnum pkgpart locationnum setup @@ -937,6 +1015,7 @@ sub uncancel { my $error = $cust_pkg->insert( 'change' => 1, #supresses any referral credit to a referring customer + 'allow_pkgpart' => 1, # allow this even if the package def is disabled ); if ($error) { $dbh->rollback if $oldAutoCommit; @@ -978,15 +1057,20 @@ sub uncancel { $dbh->rollback if $oldAutoCommit; return $svc_error; } else { + # if we've failed to insert the svc_x object, svc_Common->insert + # will have removed the cust_svc already. if not, then both records + # were inserted but we failed for some other reason (export, most + # likely). in that case, report the error and delete the records. push @svc_errors, $svc_error; - # is this necessary? svc_Common::insert already deletes the - # cust_svc if inserting svc_x fails. my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum }); if ( $cust_svc ) { - my $cs_error = $cust_svc->delete; - if ( $cs_error ) { + # except if export_insert failed, export_delete probably won't be + # much better + local $FS::svc_Common::noexport_hack = 1; + my $cleanup_error = $svc_x->delete; # also deletes cust_svc + if ( $cleanup_error ) { # and if THAT fails, then run away $dbh->rollback if $oldAutoCommit; - return $cs_error; + return $cleanup_error; } } } # svc_fatal @@ -1023,6 +1107,20 @@ sub uncancel { } ## + # Uncancel any supplemental packages, and make them supplemental to the + # new one. + ## + + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + my $new_pkg; + $error = $supp_pkg->uncancel(%options, 'main_pkgnum' => $cust_pkg->pkgnum); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + + ## # Finish ## @@ -1111,6 +1209,9 @@ of final invoices or unused-time credits unsuspended. This may be more convenient than calling C separately. +=item from_main - allows a supplemental package to be suspended, rather +than redirecting the method call to its main package. For internal use. + =back If there is an error, returns the error, otherwise returns false. @@ -1121,6 +1222,11 @@ sub suspend { my( $self, %options ) = @_; my $error; + # pass all suspend/cancel actions to the main package + if ( $self->main_pkgnum and !$options{'from_main'} ) { + return $self->main_pkg->suspend(%options); + } + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -1271,6 +1377,14 @@ sub suspend { } + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + $error = $supp_pkg->suspend(%options, 'from_main' => 1); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "suspending supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors @@ -1338,10 +1452,8 @@ field). Can be set true to adjust the next bill date forward by the amount of time the account was inactive. This was set true by default -since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be -explicitly requested. Price plans for which this makes sense (anniversary-date -based than prorate or subscription) could have an option to enable this -behaviour? +in the past (from 1.4.2 and 1.5.0pre6 through 1.7.0), but now needs to be +explicitly requested with this option or in the price plan. =back @@ -1353,6 +1465,11 @@ sub unsuspend { my( $self, %opt ) = @_; my $error; + # pass all suspend/cancel actions to the main package + if ( $self->main_pkgnum and !$opt{'from_main'} ) { + return $self->main_pkg->unsuspend(%opt); + } + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -1427,7 +1544,8 @@ sub unsuspend { } - my $reason = $self->last_cust_pkg_reason('susp')->reason; + my $cust_pkg_reason = $self->last_cust_pkg_reason('susp'); + my $reason = $cust_pkg_reason ? $cust_pkg_reason->reason : ''; my %hash = $self->hash; my $inactive = time - $hash{'susp'}; @@ -1457,7 +1575,7 @@ sub unsuspend { my $unsusp_pkg; - if ( $reason->unsuspend_pkgpart ) { + if ( $reason && $reason->unsuspend_pkgpart ) { my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart) or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart. " not found."; @@ -1510,6 +1628,14 @@ sub unsuspend { } + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + $error = $supp_pkg->unsuspend(%opt, 'from_main' => 1); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "unsuspending supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors @@ -1595,6 +1721,11 @@ New locationnum, to change the location for this package. New FS::cust_location object, to create a new location and assign it to this package. +=item cust_main + +New FS::cust_main object, to create a new customer and assign the new package +to it. + =item pkgpart New pkgpart (see L). @@ -1603,15 +1734,32 @@ New pkgpart (see L). New refnum (see L). +=item quantity + +New quantity; if unspecified, the new package will have the same quantity +as the old. + +=item cust_pkg + +"New" (existing) FS::cust_pkg object. The package's services and other +attributes will be transferred to this package. + =item keep_dates Set to true to transfer billing dates (start_date, setup, last_bill, bill, susp, adjourn, cancel, expire, and contract_end) to the new package. +=item unprotect_svcs + +Normally, change() will rollback and return an error if some services +can't be transferred (also see the I config option). +If unprotect_svcs is true, this method will transfer as many services as +it can and then unconditionally cancel the old package. + =back -At least one of locationnum, cust_location, pkgpart, refnum must be specified -(otherwise, what's the point?) +At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or +cust_pkg must be specified (otherwise, what's the point?) Returns either the new FS::cust_pkg object or a scalar error. @@ -1626,9 +1774,6 @@ sub change { my $self = shift; my $opt = ref($_[0]) ? shift : { @_ }; -# my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_; -# - my $conf = new FS::Conf; # Transactionize this whole mess @@ -1649,19 +1794,14 @@ sub change { my $time = time; - #$hash{$_} = $self->$_() foreach qw( last_bill bill ); - - #$hash{$_} = $self->$_() foreach qw( setup ); - $hash{'setup'} = $time if $self->setup; $hash{'change_date'} = $time; $hash{"change_$_"} = $self->$_() foreach qw( pkgnum pkgpart locationnum ); - if ( $opt->{'cust_location'} && - ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) { - $error = $opt->{'cust_location'}->insert; + if ( $opt->{'cust_location'} ) { + $error = $opt->{'cust_location'}->find_or_insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting cust_location (transaction rolled back): $error"; @@ -1669,15 +1809,29 @@ sub change { $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum; } + if ( $opt->{'cust_pkg'} ) { + # treat changing to a package with a different pkgpart as a + # pkgpart change (because it is) + $opt->{'pkgpart'} = $opt->{'cust_pkg'}->pkgpart; + } + + # whether to override pkgpart checking on the new package + my $same_pkgpart = 1; + if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) { + $same_pkgpart = 0; + } + my $unused_credit = 0; my $keep_dates = $opt->{'keep_dates'}; # Special case. If the pkgpart is changing, and the customer is # going to be credited for remaining time, don't keep setup, bill, # or last_bill dates, and DO pass the flag to cancel() to credit # the customer. - if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) { + if ( $opt->{'pkgpart'} + and $opt->{'pkgpart'} != $self->pkgpart + and $self->part_pkg->option('unused_credit_change', 1) ) { + $unused_credit = 1; $keep_dates = 0; - $unused_credit = 1 if $self->part_pkg->option('unused_credit_change', 1); $hash{$_} = '' foreach qw(setup bill last_bill); } @@ -1687,20 +1841,57 @@ sub change { $hash{$date} = $self->getfield($date); } } + # allow $opt->{'locationnum'} = '' to specifically set it to null # (i.e. customer default location) $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'}); - # Create the new package. - my $cust_pkg = new FS::cust_pkg { - custnum => $self->custnum, - pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ), - refnum => ( $opt->{'refnum'} || $self->refnum ), - locationnum => ( $opt->{'locationnum'} ), - %hash, - }; + # usually this doesn't matter. the two cases where it does are: + # 1. unused_credit_change + pkgpart change + setup fee on the new package + # and + # 2. (more importantly) changing a package before it's billed + $hash{'waive_setup'} = $self->waive_setup; + + my $custnum = $self->custnum; + if ( $opt->{cust_main} ) { + my $cust_main = $opt->{cust_main}; + unless ( $cust_main->custnum ) { + my $error = $cust_main->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main (transaction rolled back): $error"; + } + } + $custnum = $cust_main->custnum; + } + + $hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'}; + + my $cust_pkg; + if ( $opt->{'cust_pkg'} ) { + # The target package already exists; update it to show that it was + # changed from this package. + $cust_pkg = $opt->{'cust_pkg'}; - $error = $cust_pkg->insert( 'change' => 1 ); + foreach ( qw( pkgnum pkgpart locationnum ) ) { + $cust_pkg->set("change_$_", $self->get($_)); + } + $cust_pkg->set('change_date', $time); + $error = $cust_pkg->replace; + + } else { + # Create the new package. + $cust_pkg = new FS::cust_pkg { + custnum => $custnum, + locationnum => $opt->{'locationnum'}, + ( map { $_ => ( $opt->{$_} || $self->$_() ) } + qw( pkgpart quantity refnum salesnum ) + ), + %hash, + }; + $error = $cust_pkg->insert( 'change' => 1, + 'allow_pkgpart' => $same_pkgpart ); + } if ($error) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1725,7 +1916,11 @@ sub change { } } - if ($error > 0) { + # We set unprotect_svcs when executing a "future package change". It's + # not a user-interactive operation, so returning an error means the + # package change will just fail. Rather than have that happen, we'll + # let leftover services be deleted. + if ($error > 0 and !$opt->{'unprotect_svcs'}) { # Transfers were successful, but we still had services left on the old # package. We can't change the package under this circumstances, so abort. $dbh->rollback if $oldAutoCommit; @@ -1746,17 +1941,119 @@ sub change { $dbh->rollback if $oldAutoCommit; return "Error setting usage values: $error"; } + } else { + # if NOT changing pkgpart, transfer any usage pools over + foreach my $usage ($self->cust_pkg_usage) { + $usage->set('pkgnum', $cust_pkg->pkgnum); + $error = $usage->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error transferring usage pools: $error"; + } + } } + # transfer discounts, if we're not changing pkgpart + if ( $same_pkgpart ) { + foreach my $old_discount ($self->cust_pkg_discount_active) { + # don't remove the old discount, we may still need to bill that package. + my $new_discount = new FS::cust_pkg_discount { + 'pkgnum' => $cust_pkg->pkgnum, + 'discountnum' => $old_discount->discountnum, + 'months_used' => $old_discount->months_used, + }; + $error = $new_discount->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error transferring discounts: $error"; + } + } + } + + # transfer (copy) invoice details + foreach my $detail ($self->cust_pkg_detail) { + my $new_detail = FS::cust_pkg_detail->new({ $detail->hash }); + $new_detail->set('pkgdetailnum', ''); + $new_detail->set('pkgnum', $cust_pkg->pkgnum); + $error = $new_detail->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error transferring package notes: $error"; + } + } + + my @new_supp_pkgs; + + if ( !$opt->{'cust_pkg'} ) { + # Order any supplemental packages. + my $part_pkg = $cust_pkg->part_pkg; + my @old_supp_pkgs = $self->supplemental_pkgs; + foreach my $link ($part_pkg->supp_part_pkg_link) { + my $old; + foreach (@old_supp_pkgs) { + if ($_->pkgpart == $link->dst_pkgpart) { + $old = $_; + $_->pkgpart(0); # so that it can't match more than once + } + last if $old; + } + # false laziness with FS::cust_main::Packages::order_pkg + my $new = FS::cust_pkg->new({ + pkgpart => $link->dst_pkgpart, + pkglinknum => $link->pkglinknum, + custnum => $custnum, + main_pkgnum => $cust_pkg->pkgnum, + locationnum => $cust_pkg->locationnum, + start_date => $cust_pkg->start_date, + order_date => $cust_pkg->order_date, + expire => $cust_pkg->expire, + adjourn => $cust_pkg->adjourn, + contract_end => $cust_pkg->contract_end, + refnum => $cust_pkg->refnum, + discountnum => $cust_pkg->discountnum, + waive_setup => $cust_pkg->waive_setup, + }); + if ( $old and $opt->{'keep_dates'} ) { + foreach (qw(setup bill last_bill)) { + $new->set($_, $old->get($_)); + } + } + $error = $new->insert( allow_pkgpart => $same_pkgpart ); + # transfer services + if ( $old ) { + $error ||= $old->transfer($new); + } + if ( $error and $error > 0 ) { + # no reason why this should ever fail, but still... + $error = "Unable to transfer all services from supplemental package ". + $old->pkgnum; + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + push @new_supp_pkgs, $new; + } + } # if !$opt->{'cust_pkg'} + # because if there is one, then supplemental packages would already + # have been created for it. + #Good to go, cancel old package. Notify 'cancel' of whether to credit #remaining time. #Don't allow billing the package (preceding period packages and/or #outstanding usage) if we are keeping dates (i.e. location changing), #because the new package will be billed for the same date range. + #Supplemental packages are also canceled here. + + # during scheduled changes, avoid canceling the package we just + # changed to (duh) + $self->set('change_to_pkgnum' => ''); + $error = $self->cancel( - quiet => 1, - unused_credit => $unused_credit, - nobill => $keep_dates + quiet => 1, + unused_credit => $unused_credit, + nobill => $keep_dates, + change_custnum => ( $self->custnum != $custnum ? $custnum : '' ), ); if ($error) { $dbh->rollback if $oldAutoCommit; @@ -1765,7 +2062,9 @@ sub change { if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) { #$self->cust_main - my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] ); + my $error = $cust_pkg->cust_main->bill( + 'pkg_list' => [ $cust_pkg, @new_supp_pkgs ] + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1778,8 +2077,190 @@ sub change { } +=item change_later OPTION => VALUE... + +Schedule a package change for a later date. This actually orders the new +package immediately, but sets its start date for a future date, and sets +the current package to expire on the same date. + +If the package is already scheduled for a change, this can be called with +'start_date' to change the scheduled date, or with pkgpart and/or +locationnum to modify the package change. To cancel the scheduled change +entirely, see C. + +Options include: + +=over 4 + +=item start_date + +The date for the package change. Required, and must be in the future. + +=item pkgpart + +=item locationnum + +=item quantity + +The pkgpart. locationnum, and quantity of the new package, with the same +meaning as in C. + +=back + +=cut + +sub change_later { + my $self = shift; + my $opt = ref($_[0]) ? shift : { @_ }; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $cust_main = $self->cust_main; + + my $date = delete $opt->{'start_date'} or return 'start_date required'; + + if ( $date <= time ) { + $dbh->rollback if $oldAutoCommit; + return "start_date $date is in the past"; + } + + my $error; + + if ( $self->change_to_pkgnum ) { + my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum); + my $new_pkgpart = $opt->{'pkgpart'} + if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $change_to->pkgpart; + my $new_locationnum = $opt->{'locationnum'} + if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum; + my $new_quantity = $opt->{'quantity'} + if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity; + if ( $new_pkgpart or $new_locationnum or $new_quantity ) { + # it hasn't been billed yet, so in principle we could just edit + # it in place (w/o a package change), but that's bad form. + # So change the package according to the new options... + my $err_or_pkg = $change_to->change(%$opt); + if ( ref $err_or_pkg ) { + # Then set that package up for a future start. + $self->set('change_to_pkgnum', $err_or_pkg->pkgnum); + $self->set('expire', $date); # in case it's different + $err_or_pkg->set('start_date', $date); + $err_or_pkg->set('change_date', ''); + $err_or_pkg->set('change_pkgnum', ''); + + $error = $self->replace || + $err_or_pkg->replace || + $change_to->cancel || + $change_to->delete; + } else { + $error = $err_or_pkg; + } + } else { # change the start date only. + $self->set('expire', $date); + $change_to->set('start_date', $date); + $error = $self->replace || $change_to->replace; + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } else { + $dbh->commit if $oldAutoCommit; + return ''; + } + } # if $self->change_to_pkgnum + + my $new_pkgpart = $opt->{'pkgpart'} + if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart; + my $new_locationnum = $opt->{'locationnum'} + if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum; + my $new_quantity = $opt->{'quantity'} + if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity; + + return '' unless $new_pkgpart or $new_locationnum or $new_quantity; # wouldn't do anything + + # allow $opt->{'locationnum'} = '' to specifically set it to null + # (i.e. customer default location) + $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'}); + + my $new = FS::cust_pkg->new( { + custnum => $self->custnum, + locationnum => $opt->{'locationnum'}, + start_date => $date, + map { $_ => ( $opt->{$_} || $self->$_() ) } + qw( pkgpart quantity refnum salesnum ) + } ); + $error = $new->insert('change' => 1, + 'allow_pkgpart' => ($new_pkgpart ? 0 : 1)); + if ( !$error ) { + $self->set('change_to_pkgnum', $new->pkgnum); + $self->set('expire', $date); + $error = $self->replace; + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + } else { + $dbh->commit if $oldAutoCommit; + } + + $error; +} + +=item abort_change + +Cancels a future package change scheduled by C. + +=cut + +sub abort_change { + my $self = shift; + my $pkgnum = $self->change_to_pkgnum; + my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum; + my $error; + if ( $change_to ) { + $error = $change_to->cancel || $change_to->delete; + return $error if $error; + } + $self->set('change_to_pkgnum', ''); + $self->set('expire', ''); + $self->replace; +} + +=item set_quantity QUANTITY + +Change the package's quantity field. This is one of the few package properties +that can safely be changed without canceling and reordering the package +(because it doesn't affect tax eligibility). Returns an error or an +empty string. + +=cut + +sub set_quantity { + my $self = shift; + $self = $self->replace_old; # just to make sure + $self->quantity(shift); + $self->replace; +} + +=item set_salesnum SALESNUM + +Change the package's salesnum (sales person) field. This is one of the few +package properties that can safely be changed without canceling and reordering +the package (because it doesn't affect tax eligibility). Returns an error or +an empty string. + +=cut + +sub set_salesnum { + my $self = shift; + $self = $self->replace_old; # just to make sure + $self->salesnum(shift); + $self->replace; +} + use Storable 'thaw'; use MIME::Base64; +use Data::Dumper; sub process_bulk_cust_pkg { my $job = shift; my $param = thaw(decode_base64(shift)); @@ -1908,6 +2389,18 @@ sub old_cust_pkg { qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } ); } +=item change_cust_main + +Returns the customter this package was detached to, if any. + +=cut + +sub change_cust_main { + my $self = shift; + return '' unless $self->change_custnum; + qsearchs('cust_main', { 'custnum' => $self->change_custnum } ); +} + =item calc_setup Calls the I of the FS::part_pkg object associated with this billing @@ -1932,6 +2425,18 @@ sub calc_recur { $self->part_pkg->calc_recur($self, @_); } +=item base_setup + +Calls the I of the FS::part_pkg object associated with this billing +item. + +=cut + +sub base_setup { + my $self = shift; + $self->part_pkg->base_setup($self, @_); +} + =item base_recur Calls the I of the FS::part_pkg object associated with this billing @@ -2084,18 +2589,54 @@ sub num_cust_event { $sth->fetchrow_arrayref->[0]; } +=item part_pkg_currency_option OPTIONNAME + +Returns a two item list consisting of the currency of this customer, if any, +and a value for the provided option. If the customer has a currency, the value +is the option value the given name and the currency (see +L). Otherwise, if the customer has no currency, is the +regular option value for the given name (see L). + +=cut + +sub part_pkg_currency_option { + my( $self, $optionname ) = @_; + my $part_pkg = $self->part_pkg; + if ( my $currency = $self->cust_main->currency ) { + ($currency, $part_pkg->part_pkg_currency_option($currency, $optionname) ); + } else { + ('', $part_pkg->option($optionname) ); + } +} + =item cust_svc [ SVCPART ] (old, deprecated usage) =item cust_svc [ OPTION => VALUE ... ] (current usage) +=item cust_svc_unsorted [ OPTION => VALUE ... ] + Returns the services for this package, as FS::cust_svc objects (see L). Available options are svcpart and svcdb. If either is spcififed, returns only the matching services. +As an optimization, use the cust_svc_unsorted version if you are not displaying +the results. + =cut sub cust_svc { my $self = shift; + cluck "cust_pkg->cust_svc called" if $DEBUG > 2; + $self->_sort_cust_svc( $self->cust_svc_unsorted_arrayref ); +} + +sub cust_svc_unsorted { + my $self = shift; + @{ $self->cust_svc_unsorted_arrayref }; +} + +sub cust_svc_unsorted_arrayref { + my $self = shift; return () unless $self->num_cust_svc(@_); @@ -2120,13 +2661,7 @@ sub cust_svc { $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} ); } - cluck "cust_pkg->cust_svc called" if $DEBUG > 2; - - #if ( $self->{'_svcnum'} ) { - # values %{ $self->{'_svcnum'}->cache }; - #} else { - $self->_sort_cust_svc( [ qsearch(\%search) ] ); - #} + [ qsearch(\%search) ]; } @@ -2179,11 +2714,13 @@ sub _sort_cust_svc { my $sort = sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }; + my %pkg_svc = map { $_->svcpart => $_ } + qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } ); + map { $_->[0] } sort $sort map { - my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart, - 'svcpart' => $_->svcpart } ); + my $pkg_svc = $pkg_svc{ $_->svcpart } || ''; [ $_, $pkg_svc ? $pkg_svc->primary_svc : '', $pkg_svc ? $pkg_svc->quantity : 0, @@ -2468,7 +3005,7 @@ sub statuscolor { =item pkg_label Returns a label for this package. (Currently "pkgnum: pkg - comment" or -"pkg-comment" depending on user preference). +"pkg - comment" depending on user preference). =cut @@ -2495,6 +3032,17 @@ sub pkg_label_long { $label; } +=item pkg_locale + +Returns a customer-localized label for this package. + +=cut + +sub pkg_locale { + my $self = shift; + $self->part_pkg->pkg_locale( $self->cust_main->locale ); +} + =item primary_cust_svc Returns a primary service (as FS::cust_svc object) if one can be identified. @@ -2649,6 +3197,18 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +=item balance + +Returns the balance for this specific package, when using +experimental package balance. + +=cut + +sub balance { + my $self = shift; + $self->cust_main->balance_pkgnum( $self->pkgnum ); +} + #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin =item cust_location @@ -2876,7 +3436,8 @@ sub transfer { } foreach my $cust_svc ($self->cust_svc) { - if($target{$cust_svc->svcpart} > 0) { + if($target{$cust_svc->svcpart} > 0 + or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option $target{$cust_svc->svcpart}--; my $new = new FS::cust_svc { $cust_svc->hash }; $new->pkgnum($dest_pkgnum); @@ -2913,6 +3474,46 @@ sub transfer { return $remaining; } +=item grab_svcnums SVCNUM, SVCNUM ... + +Change the pkgnum for the provided services to this packages. If there is an +error, returns the error, otherwise returns false. + +=cut + +sub grab_svcnums { + my $self = shift; + my @svcnum = @_; + + 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 $svcnum (@svcnum) { + my $cust_svc = qsearchs('cust_svc', { svcnum=>$svcnum } ) or do { + $dbh->rollback if $oldAutoCommit; + return "unknown svcnum $svcnum"; + }; + $cust_svc->pkgnum( $self->pkgnum ); + my $error = $cust_svc->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item reexport This method is deprecated. See the I option to the insert and @@ -2920,6 +3521,8 @@ order_pkgs methods in FS::cust_main for a better way to defer provisioning. =cut +#looks like this is still used by the order_pkg and change_pkg methods in +# ClientAPI/MyAccount, need to look into those before removing sub reexport { my $self = shift; @@ -2951,6 +3554,39 @@ sub reexport { } +=item export_pkg_change OLD_CUST_PKG + +Calls the "pkg_change" export action for all services attached to this package. + +=cut + +sub export_pkg_change { + my( $self, $old ) = ( shift, 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 $svc_x ( map $_->svc_x, $self->cust_svc ) { + my $error = $svc_x->export('pkg_change', $self, $old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item insert_reason Associates this package with a (suspension or cancellation) reason (see @@ -3123,6 +3759,207 @@ sub cust_pkg_discount_active { grep { $_->status eq 'active' } $self->cust_pkg_discount; } +=item cust_pkg_usage + +Returns a list of all voice usage counters attached to this package. + +=cut + +sub cust_pkg_usage { + my $self = shift; + qsearch('cust_pkg_usage', { pkgnum => $self->pkgnum }); +} + +=item apply_usage OPTIONS + +Takes the following options: +- cdr: a call detail record (L) +- rate_detail: the rate determined for this call (L) +- minutes: the maximum number of minutes to be charged + +Finds available usage minutes for a call of this class, and subtracts +up to that many minutes from the usage pool. If the usage pool is empty, +and the C global config option is set, minutes may +be taken from other calls as well. Either way, an allocation record will +be created (L) and this method will return the +number of minutes of usage applied to the call. + +=cut + +sub apply_usage { + my ($self, %opt) = @_; + my $cdr = $opt{cdr}; + my $rate_detail = $opt{rate_detail}; + my $minutes = $opt{minutes}; + my $classnum = $rate_detail->classnum; + my $pkgnum = $self->pkgnum; + my $custnum = $self->custnum; + + 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; + my $order = FS::Conf->new->config('cdr-minutes_priority'); + + my $is_classnum; + if ( $classnum ) { + $is_classnum = ' part_pkg_usage_class.classnum = '.$classnum; + } else { + $is_classnum = ' part_pkg_usage_class.classnum IS NULL'; + } + my @usage_recs = qsearch({ + 'table' => 'cust_pkg_usage', + 'addl_from' => ' JOIN part_pkg_usage USING (pkgusagepart)'. + ' JOIN cust_pkg USING (pkgnum)'. + ' JOIN part_pkg_usage_class USING (pkgusagepart)', + 'select' => 'cust_pkg_usage.*', + 'extra_sql' => " WHERE ( cust_pkg.pkgnum = $pkgnum OR ". + " ( cust_pkg.custnum = $custnum AND ". + " part_pkg_usage.shared IS NOT NULL ) ) AND ". + $is_classnum . ' AND '. + " cust_pkg_usage.minutes > 0", + 'order_by' => " ORDER BY priority ASC", + }); + + my $orig_minutes = $minutes; + my $error; + while (!$error and $minutes > 0 and @usage_recs) { + my $cust_pkg_usage = shift @usage_recs; + $cust_pkg_usage->select_for_update; + my $cdr_cust_pkg_usage = FS::cdr_cust_pkg_usage->new({ + pkgusagenum => $cust_pkg_usage->pkgusagenum, + acctid => $cdr->acctid, + minutes => min($cust_pkg_usage->minutes, $minutes), + }); + $cust_pkg_usage->set('minutes', + sprintf('%.0f', $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes) + ); + $error = $cust_pkg_usage->replace || $cdr_cust_pkg_usage->insert; + $minutes -= $cdr_cust_pkg_usage->minutes; + } + if ( $order and $minutes > 0 and !$error ) { + # then try to steal minutes from another call + my %search = ( + 'table' => 'cdr_cust_pkg_usage', + 'addl_from' => ' JOIN cust_pkg_usage USING (pkgusagenum)'. + ' JOIN part_pkg_usage USING (pkgusagepart)'. + ' JOIN cust_pkg USING (pkgnum)'. + ' JOIN part_pkg_usage_class USING (pkgusagepart)'. + ' JOIN cdr USING (acctid)', + 'select' => 'cdr_cust_pkg_usage.*', + 'extra_sql' => " WHERE cdr.freesidestatus = 'rated' AND ". + " ( cust_pkg.pkgnum = $pkgnum OR ". + " ( cust_pkg.custnum = $custnum AND ". + " part_pkg_usage.shared IS NOT NULL ) ) AND ". + " part_pkg_usage_class.classnum = $classnum", + 'order_by' => ' ORDER BY part_pkg_usage.priority ASC', + ); + if ( $order eq 'time' ) { + # find CDRs that are using minutes, but have a later startdate + # than this call + my $startdate = $cdr->startdate; + if ($startdate !~ /^\d+$/) { + die "bad cdr startdate '$startdate'"; + } + $search{'extra_sql'} .= " AND cdr.startdate > $startdate"; + # minimize needless reshuffling + $search{'order_by'} .= ', cdr.startdate DESC'; + } else { + # XXX may not work correctly with rate_time schedules. Could + # fix this by storing ratedetailnum in cdr_cust_pkg_usage, I + # think... + $search{'addl_from'} .= + ' JOIN rate_detail'. + ' ON (cdr.rated_ratedetailnum = rate_detail.ratedetailnum)'; + if ( $order eq 'rate_high' ) { + $search{'extra_sql'} .= ' AND rate_detail.min_charge < '. + $rate_detail->min_charge; + $search{'order_by'} .= ', rate_detail.min_charge ASC'; + } elsif ( $order eq 'rate_low' ) { + $search{'extra_sql'} .= ' AND rate_detail.min_charge > '. + $rate_detail->min_charge; + $search{'order_by'} .= ', rate_detail.min_charge DESC'; + } else { + # this should really never happen + die "invalid cdr-minutes_priority value '$order'\n"; + } + } + my @cdr_usage_recs = qsearch(\%search); + my %reproc_cdrs; + while (!$error and @cdr_usage_recs and $minutes > 0) { + my $cdr_cust_pkg_usage = shift @cdr_usage_recs; + my $cust_pkg_usage = $cdr_cust_pkg_usage->cust_pkg_usage; + my $old_cdr = $cdr_cust_pkg_usage->cdr; + $reproc_cdrs{$old_cdr->acctid} = $old_cdr; + $cdr_cust_pkg_usage->select_for_update; + $old_cdr->select_for_update; + $cust_pkg_usage->select_for_update; + # in case someone else stole the usage from this CDR + # while waiting for the lock... + next if $old_cdr->acctid != $cdr_cust_pkg_usage->acctid; + # steal the usage allocation and flag the old CDR for reprocessing + $cdr_cust_pkg_usage->set('acctid', $cdr->acctid); + # if the allocation is more minutes than we need, adjust it... + my $delta = $cdr_cust_pkg_usage->minutes - $minutes; + if ( $delta > 0 ) { + $cdr_cust_pkg_usage->set('minutes', $minutes); + $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $delta); + $error = $cust_pkg_usage->replace; + } + #warn 'CDR '.$cdr->acctid . ' stealing allocation '.$cdr_cust_pkg_usage->cdrusagenum.' from CDR '.$old_cdr->acctid."\n"; + $error ||= $cdr_cust_pkg_usage->replace; + # deduct the stolen minutes + $minutes -= $cdr_cust_pkg_usage->minutes; + } + # after all minute-stealing is done, reset the affected CDRs + foreach (values %reproc_cdrs) { + $error ||= $_->set_status(''); + # XXX or should we just call $cdr->rate right here? + # it's not like we can create a loop this way, since the min_charge + # or call time has to go monotonically in one direction. + # we COULD get some very deep recursions going, though... + } + } # if $order and $minutes + if ( $error ) { + $dbh->rollback; + die "error applying included minutes\npkgnum ".$self->pkgnum.", class $classnum, acctid ".$cdr->acctid."\n$error\n" + } else { + $dbh->commit if $oldAutoCommit; + return $orig_minutes - $minutes; + } +} + +=item supplemental_pkgs + +Returns a list of all packages supplemental to this one. + +=cut + +sub supplemental_pkgs { + my $self = shift; + qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum }); +} + +=item main_pkg + +Returns the package that this one is supplemental to, if any. + +=cut + +sub main_pkg { + my $self = shift; + if ( $self->main_pkgnum ) { + return FS::cust_pkg->by_key($self->main_pkgnum); + } + return; +} + =back =head1 CLASS METHODS @@ -3342,6 +4179,25 @@ sub search { } ## + # parse customer sales person + ## + + if ( $params->{'cust_main_salesnum'} =~ /^(\d+)$/ ) { + push @where, ($1 > 0) ? "cust_main.salesnum = $1" + : 'cust_main.salesnum IS NULL'; + } + + + ## + # parse sales person + ## + + if ( $params->{'salesnum'} =~ /^(\d+)$/ ) { + push @where, ($1 > 0) ? "cust_pkg.salesnum = $1" + : 'cust_pkg.salesnum IS NULL'; + } + + ## # parse custnum ## @@ -3650,10 +4506,10 @@ sub search { my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : ''; - my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '. - 'LEFT JOIN part_pkg USING ( pkgpart ) '. + my $addl_from = 'LEFT JOIN part_pkg USING ( pkgpart ) '. 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '. - 'LEFT JOIN cust_location USING ( locationnum ) '; + 'LEFT JOIN cust_location USING ( locationnum ) '. + FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'); my $select; my $count_query; @@ -3937,11 +4793,25 @@ sub order { %hash, }; $error = $cust_pkg->insert( 'change' => $change ); + push @$return_cust_pkg, $cust_pkg; + + foreach my $link ($cust_pkg->part_pkg->supp_part_pkg_link) { + my $supp_pkg = FS::cust_pkg->new({ + custnum => $custnum, + pkgpart => $link->dst_pkgpart, + refnum => $refnum, + main_pkgnum => $cust_pkg->pkgnum, + %hash, + }); + $error ||= $supp_pkg->insert( 'change' => $change ); + push @$return_cust_pkg, $supp_pkg; + } + if ($error) { $dbh->rollback if $oldAutoCommit; return $error; } - push @$return_cust_pkg, $cust_pkg; + } # $return_cust_pkg now contains refs to all of the newly # created packages.