+=cut
+
+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';
+ 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 $old = $self->select_for_update;
+
+ my $pkgnum = $old->pkgnum;
+ if ( $old->get('cancel') || $self->get('cancel') ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't unsuspend cancelled package $pkgnum";
+ }
+
+ unless ( $old->get('susp') && $self->get('susp') ) {
+ $dbh->rollback if $oldAutoCommit;
+ return ""; # no error # complain instead?
+ }
+
+ my $date = $opt{'date'};
+ if ( $date and $date > time ) { # return an error if $date <= time?
+
+ if ( $old->get('expire') && $old->get('expire') < $date ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Package $pkgnum expires before it would be unsuspended.";
+ }
+
+ my $new = new FS::cust_pkg { $self->hash };
+ $new->set('resume', $date);
+ $error = $new->replace($self, options => $self->options);
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ else {
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+ }
+
+ } #if $date
+
+ my @labels = ();
+
+ 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 $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
+ if ($svc) {
+ $error = $svc->unsuspend;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ my( $label, $value ) = $cust_svc->label;
+ push @labels, "$label: $value";
+ }
+
+ }
+
+ 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'};
+
+ my $conf = new FS::Conf;
+
+ $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
+ if $inactive > 0
+ && ( $hash{'bill'} || $hash{'setup'} )
+ && ( $opt{'adjust_next_bill'}
+ || $conf->exists('unsuspend-always_adjust_next_bill_date')
+ || $self->part_pkg->option('unsuspend_adjust_bill', 1)
+ )
+ && ! $self->option('suspend_bill',1)
+ && ( ! $self->part_pkg->option('suspend_bill',1)
+ || $self->option('no_suspend_bill',1)
+ )
+ && $hash{'order_date'} != $hash{'susp'}
+ ;
+
+ $hash{'susp'} = '';
+ $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
+ $hash{'resume'} = '' if !$hash{'adjourn'};
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace( $self, options => { $self->options } );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ my $unsusp_pkg;
+
+ 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.";
+ my $start_date = $self->cust_main->next_bill_date
+ if $reason->unsuspend_hold;
+
+ if ( $part_pkg ) {
+ $unsusp_pkg = FS::cust_pkg->new({
+ 'custnum' => $self->custnum,
+ 'pkgpart' => $reason->unsuspend_pkgpart,
+ 'start_date' => $start_date,
+ 'locationnum' => $self->locationnum,
+ # discount? probably not...
+ });
+
+ $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ if ( $conf->config('unsuspend_email_admin') ) {
+
+ my $error = send_email(
+ 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
+ #invoice_from ??? well as good as any
+ 'to' => $conf->config('unsuspend_email_admin'),
+ 'subject' => 'FREESIDE NOTIFICATION: Customer package unsuspended', 'body' => [
+ "This is an automatic message from your Freeside installation\n",
+ "informing you that the following customer package has been unsuspended:\n",
+ "\n",
+ 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
+ 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
+ ( map { "Service : $_\n" } @labels ),
+ ($unsusp_pkg ?
+ "An unsuspension fee was charged: ".
+ $unsusp_pkg->part_pkg->pkg_comment."\n"
+ : ''
+ ),
+ ],
+ 'custnum' => $self->custnum,
+ 'msgtype' => 'admin',
+ );
+
+ if ( $error ) {
+ warn "WARNING: can't send unsuspension admin email (unsuspending anyway): ".
+ "$error\n";
+ }
+
+ }
+
+ 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
+}
+
+=item unadjourn
+
+Cancels any pending suspension (sets the adjourn field to null).
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub unadjourn {
+ my( $self, %options ) = @_;
+ my $error;
+
+ 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 $old = $self->select_for_update;
+
+ my $pkgnum = $old->pkgnum;
+ if ( $old->get('cancel') || $self->get('cancel') ) {
+ dbh->rollback if $oldAutoCommit;
+ return "Can't unadjourn cancelled package $pkgnum";
+ # or at least it's pointless
+ }
+
+ if ( $old->get('susp') || $self->get('susp') ) {
+ dbh->rollback if $oldAutoCommit;
+ return "Can't unadjourn suspended package $pkgnum";
+ # perhaps this is arbitrary
+ }
+
+ unless ( $old->get('adjourn') && $self->get('adjourn') ) {
+ dbh->rollback if $oldAutoCommit;
+ return ""; # no error
+ }
+
+ my %hash = $self->hash;
+ $hash{'adjourn'} = '';
+ $hash{'resume'} = '';
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace( $self, options => { $self->options } );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ''; #no errors
+
+}
+
+
+=item change HASHREF | OPTION => VALUE ...
+
+Changes this package: cancels it and creates a new one, with a different
+pkgpart or locationnum or both. All services are transferred to the new
+package (no change will be made if this is not possible).
+
+Options may be passed as a list of key/value pairs or as a hash reference.
+Options are:
+
+=over 4
+
+=item locationnum
+
+New locationnum, to change the location for this package.
+
+=item cust_location
+
+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<FS::part_pkg>).
+
+=item refnum
+
+New refnum (see L<FS::part_referral>).
+
+=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<cust_pkg-change_svcpart> 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, 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.
+
+For example:
+
+ my $err_or_new_cust_pkg = $old_cust_pkg->change
+
+=cut
+
+#some false laziness w/order
+sub change {
+ my $self = shift;
+ my $opt = ref($_[0]) ? shift : { @_ };
+
+ my $conf = new FS::Conf;
+
+ # Transactionize this whole mess
+ 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 $error;
+
+ my %hash = ();
+
+ my $time = time;
+
+ $hash{'setup'} = $time if $self->setup;
+
+ $hash{'change_date'} = $time;
+ $hash{"change_$_"} = $self->$_()
+ foreach qw( pkgnum pkgpart locationnum );
+
+ if ( $opt->{'cust_location'} ) {
+ $error = $opt->{'cust_location'}->find_or_insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "creating location record: $error";
+ }
+ $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
+ and $self->part_pkg->option('unused_credit_change', 1) ) {
+ $unused_credit = 1;
+ $keep_dates = 0;
+ $hash{$_} = '' foreach qw(setup bill last_bill);
+ }
+
+ if ( $keep_dates ) {
+ foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
+ resume start_date contract_end ) ) {
+ $hash{$date} = $self->getfield($date);
+ }
+ }
+ # always keep this date, regardless of anything
+ # (the date of the package change is in a different field)
+ $hash{'order_date'} = $self->getfield('order_date');
+
+ # allow $opt->{'locationnum'} = '' to specifically set it to null
+ # (i.e. customer default location)
+ $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
+
+ # 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( @{ $opt->{cust_main_insert_args}||[] } );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "inserting customer record: $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'};
+
+ 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 "inserting new package: $error";
+ }
+
+ # Transfer services and cancel old package.
+
+ $error = $self->transfer($cust_pkg);
+ if ($error and $error == 0) {
+ # $old_pkg->transfer failed.
+ $dbh->rollback if $oldAutoCommit;
+ return "transferring $error";
+ }
+
+ if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
+ warn "trying transfer again with change_svcpart option\n" if $DEBUG;
+ $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
+ if ($error and $error == 0) {
+ # $old_pkg->transfer failed.
+ $dbh->rollback if $oldAutoCommit;
+ return "converting $error";
+ }
+ }
+
+ # 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;
+ return "unable to transfer all services";
+ }
+
+ #reset usage if changing pkgpart
+ # AND usage rollover is off (otherwise adds twice, now and at package bill)
+ if ($self->pkgpart != $cust_pkg->pkgpart) {
+ my $part_pkg = $cust_pkg->part_pkg;
+ $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
+ ? ()
+ : ( 'null' => 1 )
+ )
+ if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
+
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return "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 "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 "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 "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,
+ change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
+ );
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return "canceling old package: $error";
+ }
+
+ if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
+ #$self->cust_main
+ my $error = $cust_pkg->cust_main->bill(
+ 'pkg_list' => [ $cust_pkg, @new_supp_pkgs ]
+ );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "billing new package: $error";
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ $cust_pkg;
+
+}
+
+=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<abort_change>.
+
+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<change>.
+
+=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<change_later>.
+
+=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;
+ # XXX this should probably reassign any credit that's already been given
+}
+
+=item modify_charge OPTIONS
+
+Change the properties of a one-time charge. The following properties can
+be changed this way:
+- pkg: the package description
+- classnum: the package class
+- additional: arrayref of additional invoice details to add to this package
+
+and, I<if the charge has not yet been billed>:
+- start_date: the date when it will be billed
+- amount: the setup fee to be charged
+- quantity: the multiplier for the setup fee
+
+If you pass 'adjust_commission' => 1, and the classnum changes, and there are
+commission credits linked to this charge, they will be recalculated.
+
+=cut
+
+sub modify_charge {
+ my $self = shift;
+ my %opt = @_;
+ my $part_pkg = $self->part_pkg;
+ my $pkgnum = $self->pkgnum;
+
+ my $dbh = dbh;
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+
+ return "Can't use modify_charge except on one-time charges"
+ unless $part_pkg->freq eq '0';
+
+ if ( length($opt{'pkg'}) and $part_pkg->pkg ne $opt{'pkg'} ) {
+ $part_pkg->set('pkg', $opt{'pkg'});
+ }
+
+ my %pkg_opt = $part_pkg->options;
+ my $pkg_opt_modified = 0;
+
+ $opt{'additional'} ||= [];
+ my $i;
+ my @old_additional;
+ foreach (grep /^additional/, keys %pkg_opt) {
+ ($i) = ($_ =~ /^additional_info(\d+)$/);
+ $old_additional[$i] = $pkg_opt{$_} if $i;
+ delete $pkg_opt{$_};
+ }
+
+ for ( $i = 0; exists($opt{'additional'}->[$i]); $i++ ) {
+ $pkg_opt{ "additional_info$i" } = $opt{'additional'}->[$i];
+ if (!exists($old_additional[$i])
+ or $old_additional[$i] ne $opt{'additional'}->[$i])
+ {
+ $pkg_opt_modified = 1;
+ }
+ }
+ $pkg_opt_modified = 1 if (scalar(@old_additional) - 1) != $i;
+ $pkg_opt{'additional_count'} = $i if $i > 0;
+
+ my $old_classnum;
+ if ( exists($opt{'classnum'}) and $part_pkg->classnum ne $opt{'classnum'} )
+ {
+ # remember it
+ $old_classnum = $part_pkg->classnum;
+ $part_pkg->set('classnum', $opt{'classnum'});
+ }
+
+ if ( !$self->get('setup') ) {
+ # not yet billed, so allow amount and quantity
+ if ( exists($opt{'quantity'})
+ and $opt{'quantity'} != $self->quantity
+ and $opt{'quantity'} > 0 ) {
+
+ $self->set('quantity', $opt{'quantity'});
+ }
+ if ( exists($opt{'start_date'})
+ and $opt{'start_date'} != $self->start_date ) {
+
+ $self->set('start_date', $opt{'start_date'});
+ }
+
+ if ( exists($opt{'amount'})
+ and $part_pkg->option('setup_fee') != $opt{'amount'}
+ and $opt{'amount'} > 0 ) {
+
+ $pkg_opt{'setup_fee'} = $opt{'amount'};
+ $pkg_opt_modified = 1;
+
+ }
+ } # else simply ignore them; the UI shouldn't allow editing the fields
+
+ my $error;
+ if ( $part_pkg->modified or $pkg_opt_modified ) {
+ # can we safely modify the package def?
+ # Yes, if it's not available for purchase, and this is the only instance
+ # of it.
+ if ( $part_pkg->disabled
+ and FS::cust_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 1
+ and FS::quotation_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 0
+ ) {
+ $error = $part_pkg->replace( options => \%pkg_opt );
+ } else {
+ # clone it
+ $part_pkg = $part_pkg->clone;
+ $part_pkg->set('disabled' => 'Y');
+ $error = $part_pkg->insert( options => \%pkg_opt );
+ # and associate this as yet-unbilled package to the new package def
+ $self->set('pkgpart' => $part_pkg->pkgpart);
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ if ($self->modified) { # for quantity or start_date change, or if we had
+ # to clone the existing package def
+ my $error = $self->replace;
+ return $error if $error;
+ }
+ if (defined $old_classnum) {
+ # fix invoice grouping records
+ my $old_catname = $old_classnum
+ ? FS::pkg_class->by_key($old_classnum)->categoryname
+ : '';
+ my $new_catname = $opt{'classnum'}
+ ? $part_pkg->pkg_class->categoryname
+ : '';
+ if ( $old_catname ne $new_catname ) {
+ foreach my $cust_bill_pkg ($self->cust_bill_pkg) {
+ # (there should only be one...)
+ my @display = qsearch( 'cust_bill_pkg_display', {
+ 'billpkgnum' => $cust_bill_pkg->billpkgnum,
+ 'section' => $old_catname,
+ });
+ foreach (@display) {
+ $_->set('section', $new_catname);
+ $error = $_->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ } # foreach $cust_bill_pkg
+ }
+
+ if ( $opt{'adjust_commission'} ) {
+ # fix commission credits...tricky.
+ foreach my $cust_event ($self->cust_event) {
+ my $part_event = $cust_event->part_event;
+ foreach my $table (qw(sales agent)) {
+ my $class =
+ "FS::part_event::Action::Mixin::credit_${table}_pkg_class";
+ my $credit = qsearchs('cust_credit', {
+ 'eventnum' => $cust_event->eventnum,
+ });
+ if ( $part_event->isa($class) ) {
+ # Yes, this results in current commission rates being applied
+ # retroactively to a one-time charge. For accounting purposes
+ # there ought to be some kind of time limit on doing this.
+ my $amount = $part_event->_calc_credit($self);
+ if ( $credit and $credit->amount ne $amount ) {
+ # Void the old credit.
+ $error = $credit->void('Package class changed');
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error (adjusting commission credit)";
+ }
+ }
+ # redo the event action to recreate the credit.
+ local $@ = '';
+ eval { $part_event->do_action( $self, $cust_event ) };
+ if ( $@ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $@;
+ }
+ } # if $part_event->isa($class)
+ } # foreach $table
+ } # foreach $cust_event
+ } # if $opt{'adjust_commission'}
+ } # if defined $old_classnum
+
+ $dbh->commit if $oldAutoCommit;
+ '';
+}
+
+
+
+use Storable 'thaw';
+use MIME::Base64;
+use Data::Dumper;
+sub process_bulk_cust_pkg {
+ my $job = shift;
+ my $param = thaw(decode_base64(shift));
+ warn Dumper($param) if $DEBUG;
+
+ my $old_part_pkg = qsearchs('part_pkg',
+ { pkgpart => $param->{'old_pkgpart'} });
+ my $new_part_pkg = qsearchs('part_pkg',
+ { pkgpart => $param->{'new_pkgpart'} });
+ die "Must select a new package type\n" unless $new_part_pkg;
+ #my $keep_dates = $param->{'keep_dates'} || 0;
+ my $keep_dates = 1; # there is no good reason to turn this off
+
+ 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 @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
+
+ my $i = 0;
+ foreach my $old_cust_pkg ( @cust_pkgs ) {
+ $i++;
+ $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
+ if ( $old_cust_pkg->getfield('cancel') ) {
+ warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
+ $old_cust_pkg->pkgnum."\n"
+ if $DEBUG;
+ next;
+ }
+ warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
+ if $DEBUG;
+ my $error = $old_cust_pkg->change(
+ 'pkgpart' => $param->{'new_pkgpart'},
+ 'keep_dates' => $keep_dates
+ );
+ if ( !ref($error) ) { # change returns the cust_pkg on success
+ $dbh->rollback;
+ die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
+ }
+ }
+ $dbh->commit if $oldAutoCommit;
+ return;
+}
+
+=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;
+ 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,
+ 'edate' => $self->bill, } );
+ $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
+}
+
+=item last_cust_pkg_reason ACTION
+
+Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
+Returns false if there is no reason or the package is not currenly ACTION'd
+ACTION is one of adjourn, susp, cancel, or expire.
+
+=cut
+
+sub last_cust_pkg_reason {
+ my ( $self, $action ) = ( shift, shift );
+ my $date = $self->get($action);
+ qsearchs( {
+ 'table' => 'cust_pkg_reason',
+ 'hashref' => { 'pkgnum' => $self->pkgnum,
+ 'action' => substr(uc($action), 0, 1),
+ 'date' => $date,
+ },
+ 'order_by' => 'ORDER BY num DESC LIMIT 1',
+ } );
+}
+
+=item last_reason ACTION
+
+Returns the most recent ACTION FS::reason associated with the package.
+Returns false if there is no reason or the package is not currenly ACTION'd
+ACTION is one of adjourn, susp, cancel, or expire.
+
+=cut
+
+sub last_reason {
+ my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
+ $cust_pkg_reason->reason
+ if $cust_pkg_reason;
+}
+
+=item part_pkg
+
+Returns the definition for this billing item, as an FS::part_pkg object (see
+L<FS::part_pkg>).
+
+=cut
+
+sub part_pkg {
+ my $self = shift;
+ return $self->{'_pkgpart'} if $self->{'_pkgpart'};
+ cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
+ qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item old_cust_pkg
+
+Returns the cancelled package this package was changed from, if any.
+
+=cut
+
+sub old_cust_pkg {
+ my $self = shift;
+ return '' unless $self->change_pkgnum;
+ 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<calc_setup> of the FS::part_pkg object associated with this billing
+item.
+
+=cut
+
+sub calc_setup {
+ my $self = shift;
+ $self->part_pkg->calc_setup($self, @_);
+}
+
+=item calc_recur
+
+Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
+item.
+
+=cut
+
+sub calc_recur {
+ my $self = shift;
+ $self->part_pkg->calc_recur($self, @_);
+}
+
+=item base_recur
+
+Calls the I<base_recur> of the FS::part_pkg object associated with this billing
+item.
+
+=cut
+
+sub base_recur {
+ my $self = shift;
+ $self->part_pkg->base_recur($self, @_);
+}
+
+=item calc_remain
+
+Calls the I<calc_remain> of the FS::part_pkg object associated with this
+billing item.
+
+=cut
+
+sub calc_remain {
+ my $self = shift;
+ $self->part_pkg->calc_remain($self, @_);
+}
+
+=item calc_cancel
+
+Calls the I<calc_cancel> of the FS::part_pkg object associated with this
+billing item.
+
+=cut
+
+sub calc_cancel {
+ my $self = shift;
+ $self->part_pkg->calc_cancel($self, @_);
+}
+
+=item cust_bill_pkg
+
+Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
+
+=cut
+
+sub cust_bill_pkg {
+ my $self = shift;
+ qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
+}
+
+=item cust_pkg_detail [ DETAILTYPE ]
+
+Returns any customer package details for this package (see
+L<FS::cust_pkg_detail>).
+
+DETAILTYPE can be set to "I" for invoice details or "C" for comments.
+
+=cut
+
+sub cust_pkg_detail {
+ my $self = shift;
+ my %hash = ( 'pkgnum' => $self->pkgnum );
+ $hash{detailtype} = shift if @_;
+ qsearch({
+ 'table' => 'cust_pkg_detail',
+ 'hashref' => \%hash,
+ 'order_by' => 'ORDER BY weight, pkgdetailnum',
+ });
+}
+
+=item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
+
+Sets customer package details for this package (see L<FS::cust_pkg_detail>).
+
+DETAILTYPE can be set to "I" for invoice details or "C" for comments.
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub set_cust_pkg_detail {
+ my( $self, $detailtype, @details ) = @_;
+
+ 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 $current ( $self->cust_pkg_detail($detailtype) ) {
+ my $error = $current->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error removing old detail: $error";
+ }
+ }
+
+ foreach my $detail ( @details ) {
+ my $cust_pkg_detail = new FS::cust_pkg_detail {
+ 'pkgnum' => $self->pkgnum,
+ 'detailtype' => $detailtype,
+ 'detail' => $detail,
+ };
+ my $error = $cust_pkg_detail->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error adding new detail: $error";
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+=item cust_event
+
+Returns the customer billing events (see L<FS::cust_event>) for this invoice.
+
+=cut
+
+#false laziness w/cust_bill.pm
+sub cust_event {
+ my $self = shift;
+ qsearch({
+ 'table' => 'cust_event',
+ 'addl_from' => 'JOIN part_event USING ( eventpart )',
+ 'hashref' => { 'tablenum' => $self->pkgnum },
+ 'extra_sql' => " AND eventtable = 'cust_pkg' ",
+ });
+}
+
+=item num_cust_event
+
+Returns the number of customer billing events (see L<FS::cust_event>) for this package.
+
+=cut
+
+#false laziness w/cust_bill.pm
+sub num_cust_event {
+ my $self = shift;
+ my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where;
+ $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0];
+}
+
+=item exists_cust_event
+
+Returns true if there are customer billing events (see L<FS::cust_event>) for this package. More efficient than using num_cust_event.
+
+=cut
+
+sub exists_cust_event {
+ my $self = shift;
+ my $sql = "SELECT 1 ". $self->_from_cust_event_where. " LIMIT 1";
+ my $row = $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref;
+ $row ? $row->[0] : '';
+}
+
+sub _from_cust_event_where {
+ #my $self = shift;
+ " FROM cust_event JOIN part_event USING ( eventpart ) ".
+ " WHERE tablenum = ? AND eventtable = 'cust_pkg' ";
+}
+
+sub _prep_ex {
+ my( $self, $sql, @args ) = @_;
+ my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
+ $sth->execute(@args) or die $sth->errstr. " executing $sql";
+ $sth;
+}
+
+=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<FS::cust_svc>). 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(@_);
+
+ my %opt = ();
+ if ( @_ && $_[0] =~ /^\d+/ ) {
+ $opt{svcpart} = shift;
+ } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
+ %opt = %{ $_[0] };
+ } elsif ( @_ ) {
+ %opt = @_;
+ }
+
+ my %search = (
+ 'table' => 'cust_svc',
+ 'hashref' => { 'pkgnum' => $self->pkgnum },
+ );
+ if ( $opt{svcpart} ) {
+ $search{hashref}->{svcpart} = $opt{'svcpart'};
+ }
+ if ( $opt{'svcdb'} ) {
+ $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) ';
+ $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} );
+ }
+
+ [ qsearch(\%search) ];
+
+}