+ 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
+
+=item contract_end
+
+The pkgpart, locationnum, quantity and optional contract_end 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 : { @_ };
+
+ # check contract_end, prevent adding/removing
+ my $error = $self->_check_change($opt);
+ return $error if $error;
+
+ 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";
+ }
+
+ # If the user entered a new location, set it up now.
+ 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;
+ }
+
+ # Discounts:
+ # Applies discounts to the newly created future_change package
+ #
+ # If a new discount is the same as the old discount, carry over the
+ # old discount's months_used/end_date fields too
+ #
+ # Legacy behavior:
+ # Legacy behavior was to create the next package with no discount.
+ # This behavior is preserved. Without the discount fields in $opt,
+ # the new package will be created with no discounts.
+
+ # parse discount information from $opt
+ my %new_discount = $self->_parse_new_discounts($opt);
+
+ 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;
+ my $new_contract_end = $opt->{'contract_end'}
+ if $opt->{'contract_end'} and $opt->{'contract_end'} != $change_to->contract_end;
+ if ( $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end ) {
+ # 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 ||
+ #because change() might've edited existing scheduled change in place
+ (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' :
+ $change_to->cancel('no_delay_cancel' => 1) ||
+ $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 && exists $opt->{waive_setup} ) {
+ $change_to->set(waive_setup => $opt->{waive_setup} );
+ $error = $change_to->insert();
+ }
+
+ if ( !$error && %new_discount ) {
+ $error = $change_to->change_discount(%new_discount);
+ }
+
+ 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;
+ my $new_contract_end = $opt->{'contract_end'}
+ if $opt->{'contract_end'} and $opt->{'contract_end'} != $self->contract_end;
+
+ return '' unless $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end; # 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 contract_end )
+ } );
+ $error = $new->insert('change' => 1,
+ 'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
+
+ if ( !$error && %new_discount ) {
+ $error = $new->change_discount(%new_discount);
+ }
+
+ 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;
+}
+
+# Helper method reads $opt hashref from change() and change_later()
+# Returns a hash of %new_discount suitable for passing to change_discount()
+sub _parse_new_discounts {
+ my ($self, $opt) = @_;
+
+ croak "Bad parameter list" unless ref $opt;
+
+ my %old_discount =
+ map { $_->setuprecur => $_ }
+ qsearch('cust_pkg_discount', {
+ pkgnum => $self->pkgnum,
+ disabled => '',
+ });
+
+ my %new_discount;
+ for my $type(qw|setup recur|) {
+
+ if (exists $opt->{"${type}_discountnum"}) {
+ $new_discount{$type} = {
+ discountnum => $opt->{"${type}_discountnum"},
+ amount => $opt->{"${type}_discountnum_amount"},
+ percent => $opt->{"${type}_discountnum_percent"},
+ months => $opt->{"${type}_discountnum_months"},
+ };
+ }
+
+ # Specified discountnum same as old discountnum, carry over addl fields
+ if (
+ exists $opt->{"${type}_discountnum"}
+ && exists $old_discount{$type}
+ && $opt->{"${type}_discountnum"} eq $old_discount{$type}->discountnum
+ ){
+ $new_discount{$type}->{months} = $old_discount{$type}->months;
+ $new_discount{$type}->{end_date} = $old_discount{$type}->end_date;
+ }
+
+ # No new discount specified, carryover old discount
+ # If we wanted to abandon legacy behavior, and always carry old discounts
+ # uncomment this:
+
+ # if (!exists $new_discount{$type} && $old_discount{$type}) {
+ # $new_discount{$type} = {
+ # discountnum => $old_discount{$type}->discountnum,
+ # amount => $old_discount{$type}->amount,
+ # percent => $old_discount{$type}->percent,
+ # months => $old_discount{$type}->months,
+ # end_date => $old_discount{$type}->end_date,
+ # };
+ # }
+ }
+
+ if ($DEBUG) {
+ warn "_parse_new_discounts(), pkgnum: ".$self->pkgnum." \n";
+ warn "Determine \%old_discount, \%new_discount: \n";
+ warn Dumper(\%old_discount);
+ warn Dumper(\%new_discount);
+ }
+
+ %new_discount;
+}
+
+=item abort_change
+
+Cancels a future package change scheduled by C<change_later>.
+
+=cut
+
+sub abort_change {
+ my $self = shift;
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+
+ my $pkgnum = $self->change_to_pkgnum;
+ my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum;
+ my $error;
+ $self->set('change_to_pkgnum', '');
+ $self->set('expire', '');
+ $error = $self->replace;
+ if ( $change_to ) {
+ $error ||= $change_to->cancel || $change_to->delete;
+ }
+
+ if ( $oldAutoCommit ) {
+ if ( $error ) {
+ dbh->rollback;
+ } else {
+ dbh->commit;
+ }
+ }
+
+ return $error;
+}
+
+=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
+- separate_bill: whether to put the charge on a separate invoice
+
+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) != $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, setup_cost, quantity, start_date,
+ # and separate_bill
+
+ 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;
+ }
+
+ if ( exists($opt{'setup_cost'})
+ and $part_pkg->setup_cost != $opt{'setup_cost'}
+ and $opt{'setup_cost'} > 0 ) {
+
+ $part_pkg->set('setup_cost', $opt{'setup_cost'});
+ }
+
+ 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{'separate_bill'})
+ and $opt{'separate_bill'} ne $self->separate_bill ) {
+
+ $self->set('separate_bill', $opt{'separate_bill'});
+ }
+
+
+ } # else simply ignore them; the UI shouldn't allow editing the fields
+
+
+ if ( exists($opt{'taxclass'})
+ and $part_pkg->taxclass ne $opt{'taxclass'}) {
+
+ $part_pkg->set('taxclass', $opt{'taxclass'});
+ }
+
+ 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);
+ }