package FS::cust_pkg;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin
+use base qw( FS::cust_pkg::API FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin
FS::contact_Mixin FS::location_Mixin
FS::m2m_Common FS::option_Common );
$upgrade = 0; #go away after setup+start dates cleaned up for old customers
+our $cache_enabled = 0;
+
+sub _simplecache {
+ my( $self, $hashref ) = @_;
+ if ( $cache_enabled && $hashref->{'pkg'} && $hashref->{'plan'} ) {
+ $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
+ }
+}
+
sub _cache {
my $self = shift;
my ( $hashref, $cache ) = @_;
- #if ( $hashref->{'pkgpart'} ) {
- if ( $hashref->{'pkg'} ) {
- # #@{ $self->{'_pkgnum'} } = ();
- # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
- # $self->{'_pkgpart'} = $subcache;
- # #push @{ $self->{'_pkgnum'} },
- # FS::part_pkg->new_or_cached($hashref, $subcache);
- $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
- }
+# #if ( $hashref->{'pkgpart'} ) {
+# if ( $hashref->{'pkg'} ) {
+# # #@{ $self->{'_pkgnum'} } = ();
+# # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
+# # $self->{'_pkgpart'} = $subcache;
+# # #push @{ $self->{'_pkgnum'} },
+# # FS::part_pkg->new_or_cached($hashref, $subcache);
+# $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
+# }
if ( exists $hashref->{'svcnum'} ) {
#@{ $self->{'_pkgnum'} } = ();
my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
$seconds = $record->seconds_since($timestamp);
+ #bulk cancel+order... perhaps slightly deprecated, only used by the bulk
+ # cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
$error = FS::cust_pkg::order( $custnum, \@pkgparts );
$error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
order taker (see L<FS::access_user>)
-=item manual_flag
-
-If this field is set to 1, disables the automatic
-unsuspension of this package when using the B<unsuspendauto> config option.
-
=item quantity
If not set, defaults to 1
my $conf = new FS::Conf;
+ if ($self->locationnum) {
+ my @part_export =
+ map qsearch( 'part_export', {exportnum=>$_} ),
+ $conf->config('cust_location-exports'); #, $agentnum
+
+ foreach my $part_export ( @part_export ) {
+ my $error = $part_export->export_pkg_location($self); #, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
#this init stuff is still inefficient, but at least its limited to
}
}
+ # also run exports if removing locationnum?
+ # doesn't seem to happen, and we don't export blank locationnum on insert...
+ if ($new->locationnum and ($new->locationnum != $old->locationnum)) {
+ my $conf = new FS::Conf;
+ my @part_export =
+ map qsearch( 'part_export', {exportnum=>$_} ),
+ $conf->config('cust_location-exports'); #, $agentnum
+
+ foreach my $part_export ( @part_export ) {
+ my $error = $part_export->export_pkg_location($new); #, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
}
}
+ # if a reasonnum was passed, get the actual reason object so we can check
+ # unused_credit
+
+ my $reason;
+ if ($options{'reason'} =~ /^\d+$/) {
+ $reason = FS::reason->by_key($options{'reason'});
+ }
+
unless ($date) {
- # credit remaining time if appropriate
+ # credit remaining time if any of these are true:
+ # - unused_credit => 1 was passed (this happens when canceling a package
+ # for a package change when unused_credit_change is set)
+ # - no unused_credit option, and there is a cancel reason, and the cancel
+ # reason says to credit the package
+ # - no unused_credit option, and the package definition says to credit the
+ # package on cancellation
my $do_credit;
if ( exists($options{'unused_credit'}) ) {
$do_credit = $options{'unused_credit'};
- }
- else {
+ } elsif ( defined($reason) && $reason->unused_credit ) {
+ $do_credit = 1;
+ } else {
$do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
}
if ( $do_credit ) {
'';
}
+=item uncancel_svc_x
+
+For cancelled cust_pkg, returns a list of new, uninserted FS::svc_X records
+for services that would be inserted by L</uncancel>. Returned objects also
+include the field _h_svc_x, which contains the service history object.
+
+Set pkgnum before inserting.
+
+Accepts the following options:
+
+only_svcnum - arrayref of svcnum, only returns objects for these svcnum
+(and only if they would otherwise be returned by this)
+
+=cut
+
+sub uncancel_svc_x {
+ my ($self, %opt) = @_;
+
+ die 'uncancel_svc_x called on a non-cancelled cust_pkg' unless $self->get('cancel');
+
+ #find historical services within this timeframe before the package cancel
+ # (incompatible with "time" option to cust_pkg->cancel?)
+ my $fuzz = 2 * 60; #2 minutes? too much? (might catch separate unprovision)
+ # too little? (unprovisioing export delay?)
+ my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
+ my @h_cust_svc = $self->h_cust_svc( $end, $start );
+
+ my @svc_x;
+ foreach my $h_cust_svc (@h_cust_svc) {
+ next if $opt{'only_svcnum'} && !(grep { $_ == $h_cust_svc->svcnum } @{$opt{'only_svcnum'}});
+ # filter out services that still exist on this package (ie preserved svcs)
+ # but keep services that have since been provisioned on another package (for informational purposes)
+ next if qsearchs('cust_svc',{ 'svcnum' => $h_cust_svc->svcnum, 'pkgnum' => $self->pkgnum });
+ my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
+ next unless $h_svc_x; # this probably doesn't happen, but just in case
+ (my $table = $h_svc_x->table) =~ s/^h_//;
+ require "FS/$table.pm";
+ my $class = "FS::$table";
+ my $svc_x = $class->new( {
+ 'svcpart' => $h_cust_svc->svcpart,
+ '_h_svc_x' => $h_svc_x,
+ map { $_ => $h_svc_x->get($_) } fields($table)
+ } );
+
+ # radius_usergroup
+ if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
+ $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
+ }
+
+ #these are pretty rare, but should handle them
+ # - dsl_device (mac addresses)
+ # - phone_device (mac addresses)
+ # - dsl_note (ikano notes)
+ # - domain_record (i.e. restore DNS information w/domains)
+ # - inventory_item(?) (inventory w/un-cancelling service?)
+ # - nas (svc_broaband nas stuff)
+ #this stuff is unused in the wild afaik
+ # - mailinglistmember
+ # - router.svcnum?
+ # - svc_domain.parent_svcnum?
+ # - acct_snarf (ancient mail fetching config)
+ # - cgp_rule (communigate)
+ # - cust_svc_option (used by our Tron stuff)
+ # - acct_rt_transaction (used by our time worked stuff)
+
+ push @svc_x, $svc_x;
+ }
+ return @svc_x;
+}
+
+=item uncancel_svc_summary
+
+Returns an array of hashrefs, one for each service that could
+potentially be reprovisioned by L</uncancel>, with the following keys:
+
+svcpart
+
+svc
+
+uncancel_svcnum
+
+label - from history table if not currently calculable, undefined if it can't be loaded
+
+reprovisionable - 1 if test reprovision succeeded, otherwise 0
+
+num_cust_svc - number of svcs for this svcpart, only if summarizing (see below)
+
+Cannot be run from within a transaction. Performs inserts
+to test the results, and then rolls back the transaction.
+Does not perform exports, so does not catch if export would fail.
+
+Also accepts the following options:
+
+no_test_reprovision - skip the test inserts (reprovisionable field will not exist)
+
+summarize_size - if true, returns a single summary record for svcparts with at
+least this many svcs, will have key num_cust_svc but not uncancel_svcnum, label or reprovisionable
+
+=cut
+
+sub uncancel_svc_summary {
+ my ($self, %opt) = @_;
+
+ die 'uncancel_svc_summary called on a non-cancelled cust_pkg' unless $self->get('cancel');
+ die 'uncancel_svc_summary called from within a transaction' unless $FS::UID::AutoCommit;
+
+ local $FS::svc_Common::noexport_hack = 1; # very important not to run exports!!!
+ local $FS::UID::AutoCommit = 0;
+
+ # sort by svcpart, to check summarize_size
+ my $uncancel_svc_x = {};
+ foreach my $svc_x (sort { $a->{'svcpart'} <=> $b->{'svcpart'} } $self->uncancel_svc_x) {
+ $uncancel_svc_x->{$svc_x->svcpart} = [] unless $uncancel_svc_x->{$svc_x->svcpart};
+ push @{$uncancel_svc_x->{$svc_x->svcpart}}, $svc_x;
+ }
+
+ my @out;
+ foreach my $svcpart (keys %$uncancel_svc_x) {
+ my @svcpart_svc_x = @{$uncancel_svc_x->{$svcpart}};
+ if ($opt{'summarize_size'} && (@svcpart_svc_x >= $opt{'summarize_size'})) {
+ my $svc_x = $svcpart_svc_x[0]; #grab first one for access to $part_svc
+ my $part_svc = $svc_x->part_svc;
+ push @out, {
+ 'svcpart' => $part_svc->svcpart,
+ 'svc' => $part_svc->svc,
+ 'num_cust_svc' => scalar(@svcpart_svc_x),
+ };
+ } else {
+ foreach my $svc_x (@svcpart_svc_x) {
+ my $part_svc = $svc_x->part_svc;
+ my $out = {
+ 'svcpart' => $part_svc->svcpart,
+ 'svc' => $part_svc->svc,
+ 'uncancel_svcnum' => $svc_x->get('_h_svc_x')->svcnum,
+ };
+ $svc_x->pkgnum($self->pkgnum); # provisioning services on a canceled package, will be rolled back
+ my $insert_error;
+ unless ($opt{'no_test_reprovision'}) {
+ # avoid possibly fatal errors from missing linked records
+ eval { $insert_error = $svc_x->insert };
+ $insert_error ||= $@;
+ }
+ if ($opt{'no_test_reprovision'} or $insert_error) {
+ # avoid possibly fatal errors from missing linked records
+ eval { $out->{'label'} = $svc_x->label };
+ eval { $out->{'label'} = $svc_x->get('_h_svc_x')->label } unless defined($out->{'label'});
+ $out->{'reprovisionable'} = 0 unless $opt{'no_test_reprovision'};
+ } else {
+ $out->{'label'} = $svc_x->label;
+ $out->{'reprovisionable'} = 1;
+ }
+ push @out, $out;
+ }
+ }
+ }
+
+ dbh->rollback;
+ return @out;
+}
+
=item uncancel
"Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
svc_errors: pass an array reference, will be filled in with any provisioning errors
+only_svcnum: arrayref, only attempt to re-provision these cancelled services
+
main_pkgnum: link the package as a supplemental package of this one. For
internal use only.
# insert services
##
- #find historical services within this timeframe before the package cancel
- # (incompatible with "time" option to cust_pkg->cancel?)
- my $fuzz = 2 * 60; #2 minutes? too much? (might catch separate unprovision)
- # too little? (unprovisioing export delay?)
- my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
- my @h_cust_svc = $self->h_cust_svc( $end, $start );
-
my @svc_errors;
- foreach my $h_cust_svc (@h_cust_svc) {
- my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
- #next unless $h_svc_x; #should this happen?
- (my $table = $h_svc_x->table) =~ s/^h_//;
- require "FS/$table.pm";
- my $class = "FS::$table";
- my $svc_x = $class->new( {
- 'pkgnum' => $cust_pkg->pkgnum,
- 'svcpart' => $h_cust_svc->svcpart,
- map { $_ => $h_svc_x->get($_) } fields($table)
- } );
-
- # radius_usergroup
- if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
- $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
- }
+ foreach my $svc_x ($self->uncancel_svc_x('only_svcnum' => $options{'only_svcnum'})) {
+ $svc_x->pkgnum($cust_pkg->pkgnum);
my $svc_error = $svc_x->insert;
+
if ( $svc_error ) {
if ( $options{svc_fatal} ) {
$dbh->rollback if $oldAutoCommit;
}
} # svc_fatal
} # svc_error
- } #foreach $h_cust_svc
-
- #these are pretty rare, but should handle them
- # - dsl_device (mac addresses)
- # - phone_device (mac addresses)
- # - dsl_note (ikano notes)
- # - domain_record (i.e. restore DNS information w/domains)
- # - inventory_item(?) (inventory w/un-cancelling service?)
- # - nas (svc_broaband nas stuff)
- #this stuff is unused in the wild afaik
- # - mailinglistmember
- # - router.svcnum?
- # - svc_domain.parent_svcnum?
- # - acct_snarf (ancient mail fetching config)
- # - cgp_rule (communigate)
- # - cust_svc_option (used by our Tron stuff)
- # - acct_rt_transaction (used by our time worked stuff)
+ } #foreach uncancel_svc_x
##
# also move over any services that didn't unprovision at cancellation
=item unexpire
-Cancels any pending expiration (sets the expire field to null).
+Cancels any pending expiration (sets the expire field to null)
+for this package and any supplemental packages.
If there is an error, returns the error, otherwise returns false.
=cut
sub unexpire {
- my( $self, %options ) = @_;
+ my( $self ) = @_;
my $error;
local $SIG{HUP} = 'IGNORE';
return $error;
}
+ foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+ $error = $supp_pkg->unexpire;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "unexpiring supplemental pkg#".$supp_pkg->pkgnum.": $error";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no errors
if $error;
}
+ my $cust_pkg_reason;
if ( $options{'reason'} ) {
$error = $self->insert_reason( 'reason' => $options{'reason'},
'action' => $date ? 'adjourn' : 'suspend',
dbh->rollback if $oldAutoCommit;
return "Error inserting cust_pkg_reason: $error";
}
+ $cust_pkg_reason = qsearchs('cust_pkg_reason', {
+ 'date' => $date ? $date : $suspend_time,
+ 'action' => $date ? 'A' : 'S',
+ 'pkgnum' => $self->pkgnum,
+ });
}
# if a reasonnum was passed, get the actual reason object so we can check
}
}
+ # suspension fees: if there is a feepart, and it's not an unsuspend fee,
+ # and this is not a suspend-before-cancel
+ if ( $cust_pkg_reason ) {
+ my $reason_obj = $cust_pkg_reason->reason;
+ if ( $reason_obj->feepart and
+ ! $reason_obj->fee_on_unsuspend and
+ ! $options{'from_cancel'} ) {
+
+ # register the need to charge a fee, cust_main->bill will do the rest
+ warn "registering suspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
+ if $DEBUG;
+ my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
+ 'pkgreasonnum' => $cust_pkg_reason->num,
+ 'pkgnum' => $self->pkgnum,
+ 'feepart' => $reason->feepart,
+ 'nextbill' => $reason->fee_hold,
+ });
+ $error ||= $cust_pkg_reason_fee->insert;
+ }
+ }
+
my $conf = new FS::Conf;
if ( $conf->config('suspend_email_admin') && !$options{'from_cancel'} ) {
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...
+ if ( $reason ) {
+ if ( $reason->unsuspend_pkgpart ) {
+ #warn "Suspend reason '".$reason->reason."' uses deprecated unsuspend_pkgpart feature.\n"; # in 4.x
+ 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 );
+ }
+ }
+ # new way, using fees
+ if ( $reason->feepart and $reason->fee_on_unsuspend ) {
+ # register the need to charge a fee, cust_main->bill will do the rest
+ warn "registering unsuspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
+ if $DEBUG;
+ my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
+ 'pkgreasonnum' => $cust_pkg_reason->num,
+ 'pkgnum' => $self->pkgnum,
+ 'feepart' => $reason->feepart,
+ 'nextbill' => $reason->fee_hold,
});
-
- $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+ $error ||= $cust_pkg_reason_fee->insert;
}
if ( $error ) {
=item unadjourn
-Cancels any pending suspension (sets the adjourn field to null).
+Cancels any pending suspension (sets the adjourn field to null)
+for this package and any supplemental packages.
If there is an error, returns the error, otherwise returns false.
=cut
sub unadjourn {
- my( $self, %options ) = @_;
+ my( $self ) = @_;
my $error;
local $SIG{HUP} = 'IGNORE';
return $error;
}
+ foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+ $error = $supp_pkg->unadjourn;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "unadjourning supplemental pkg#".$supp_pkg->pkgnum.": $error";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no errors
If unprotect_svcs is true, this method will transfer as many services as
it can and then unconditionally cancel the old package.
+=item contract_end
+
+If specified, sets this value for the contract_end date on the new package
+(without regard for keep_dates or the usual date-preservation behavior.)
+Will throw an error if defined but false; the UI doesn't allow editing
+this unless it already exists, making removal impossible to undo.
+
=back
At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or
=cut
+#used by change and change_later
+#didn't put with documented check methods because it depends on change-specific opts
+#and it also possibly edits the value of opts
+sub _check_change {
+ my $self = shift;
+ my $opt = shift;
+ if ( defined($opt->{'contract_end'}) ) {
+ my $current_contract_end = $self->get('contract_end');
+ unless ($opt->{'contract_end'}) {
+ if ($current_contract_end) {
+ return "Cannot remove contract end date when changing packages";
+ } else {
+ #shouldn't even pass this option if there's not a current value
+ #but can be handled gracefully if the option is empty
+ warn "Contract end date passed unexpectedly";
+ delete $opt->{'contract_end'};
+ return '';
+ }
+ }
+ unless ($current_contract_end) {
+ #option shouldn't be passed, throw error if it's non-empty
+ return "Cannot add contract end date when changing packages " . $self->pkgnum;
+ }
+ }
+ return '';
+}
+
#some false laziness w/order
sub change {
my $self = shift;
my $conf = new FS::Conf;
+ # handle contract_end on cust_pkg same as passed option
+ if ( $opt->{'cust_pkg'} ) {
+ $opt->{'contract_end'} = $opt->{'cust_pkg'}->contract_end;
+ delete $opt->{'contract_end'} unless $opt->{'contract_end'};
+ }
+
+ # check contract_end, prevent adding/removing
+ my $error = $self->_check_change($opt);
+ return $error if $error;
+
# Transactionize this whole mess
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $error;
+ 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;
+ }
+
+ # Before going any further here: if the package is still in the pre-setup
+ # state, it's safe to modify it in place. No need to charge/credit for
+ # partial period, transfer services, transfer usage pools, copy invoice
+ # details, or change any dates.
+ if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) {
+ foreach ( qw( locationnum pkgpart quantity refnum salesnum ) ) {
+ if ( length($opt->{$_}) ) {
+ $self->set($_, $opt->{$_});
+ }
+ }
+ # almost. if the new pkgpart specifies start/adjourn/expire timers,
+ # apply those.
+ if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
+ $self->set_initial_timers;
+ }
+ # but if contract_end was explicitly specified, that overrides all else
+ $self->set('contract_end', $opt->{'contract_end'})
+ if $opt->{'contract_end'};
+ $error = $self->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "modifying package: $error";
+ } else {
+ $dbh->commit if $oldAutoCommit;
+ return $self;
+ }
+ }
my %hash = ();
my $time = time;
- $hash{'setup'} = $time if $self->setup;
+ $hash{'setup'} = $time if $self->get('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)
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.
+
+ # 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 the old
+ # package had a setup date, set the new package's setup to the package
+ # change date so that it has the same status as before.
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);
+ $hash{'last_bill'} = '';
+ $hash{'bill'} = '';
}
if ( $keep_dates ) {
- foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
- resume start_date contract_end ) ) {
+ foreach my $date ( qw(setup bill last_bill) ) {
$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');
+ # always keep the following dates
+ foreach my $date (qw(order_date susp adjourn cancel expire resume
+ start_date contract_end)) {
+ $hash{$date} = $self->getfield($date);
+ }
+ # but if contract_end was explicitly specified, that overrides all else
+ $hash{'contract_end'} = $opt->{'contract_end'}
+ if $opt->{'contract_end'};
# allow $opt->{'locationnum'} = '' to specifically set it to null
# (i.e. customer default location)
# 2. (more importantly) changing a package before it's billed
$hash{'waive_setup'} = $self->waive_setup;
+ # if this package is scheduled for a future package change, preserve that
+ $hash{'change_to_pkgnum'} = $self->change_to_pkgnum;
+
my $custnum = $self->custnum;
if ( $opt->{cust_main} ) {
my $cust_main = $opt->{cust_main};
# changed from this package.
$cust_pkg = $opt->{'cust_pkg'};
- foreach ( qw( pkgnum pkgpart locationnum ) ) {
- $cust_pkg->set("change_$_", $self->get($_));
+ # follow all the above rules for date changes, etc.
+ foreach (keys %hash) {
+ $cust_pkg->set($_, $hash{$_});
}
- $cust_pkg->set('change_date', $time);
+ # except those that implement the future package change behavior
+ foreach (qw(change_to_pkgnum start_date expire)) {
+ $cust_pkg->set($_, '');
+ }
+
$error = $cust_pkg->replace;
} else {
}
# Transfer services and cancel old package.
-
+ # Enforce service limits only if this is a pkgpart change.
+ local $FS::cust_svc::ignore_quantity;
+ $FS::cust_svc::ignore_quantity = 1 if $same_pkgpart;
$error = $self->transfer($cust_pkg);
if ($error and $error == 0) {
# $old_pkg->transfer failed.
=item quantity
-The pkgpart. locationnum, and quantity of the new package, with the same
-meaning as in C<change>.
+=item contract_end
+
+The pkgpart, locationnum, quantity and optional contract_end of the new
+package, with the same meaning as in C<change>.
=back
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;
return "start_date $date is in the past";
}
- my $error;
+ # 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;
+ }
if ( $self->change_to_pkgnum ) {
my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
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 ) {
+ 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...
$error = $self->replace ||
$err_or_pkg->replace ||
- $change_to->cancel('no_delay_cancel' => 1) ||
- $change_to->delete;
+ #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;
}
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; # wouldn't do anything
+ 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)
locationnum => $opt->{'locationnum'},
start_date => $date,
map { $_ => ( $opt->{$_} || $self->$_() ) }
- qw( pkgpart quantity refnum salesnum )
+ qw( pkgpart quantity refnum salesnum contract_end )
} );
$error = $new->insert('change' => 1,
'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
$self->part_pkg->calc_recur($self, @_);
}
+=item base_setup
+
+Returns the base setup fee (per unit) of this package, from the package
+definition.
+
+=cut
+
+# minimal version for 3.x; in 4.x this can invoke currency conversion
+
+sub base_setup {
+ my $self = shift;
+ $self->part_pkg->unit_setup($self);
+}
+
=item base_recur
Calls the I<base_recur> of the FS::part_pkg object associated with this billing
}
my %search = (
- 'table' => 'cust_svc',
- 'hashref' => { 'pkgnum' => $self->pkgnum },
+ 'select' => 'cust_svc.*, part_svc.*',
+ 'table' => 'cust_svc',
+ 'hashref' => { 'pkgnum' => $self->pkgnum },
+ 'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
);
- 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'} );
- }
+ $search{hashref}->{svcpart} = $opt{svcpart}
+ if $opt{svcpart};
+ $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{svcdb} )
+ if $opt{svcdb};
[ qsearch(\%search) ];
package but not yet provisioned. Each FS::part_svc object also has an extra
field, I<num_avail>, which specifies the number of available services.
+Accepts option I<provision_hold>; if true, only returns part_svc for which the
+associated pkg_svc has the provision_hold flag set.
+
=cut
sub available_part_svc {
my $self = shift;
+ my %opt = @_;
my $pkg_quantity = $self->quantity || 1;
grep { $_->num_avail > 0 }
- map {
- my $part_svc = $_->part_svc;
- $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
- $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
-
- # more evil encapsulation breakage
- if($part_svc->{'Hash'}{'num_avail'} > 0) {
- my @exports = $part_svc->part_export_did;
- $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
- }
-
- $part_svc;
- }
- $self->part_pkg->pkg_svc;
+ map {
+ my $part_svc = $_->part_svc;
+ $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
+ $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
+
+ # more evil encapsulation breakage
+ if ($part_svc->{'Hash'}{'num_avail'} > 0) {
+ my @exports = $part_svc->part_export_did;
+ $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
+ }
+
+ $part_svc;
+ }
+ grep { $opt{'provision_hold'} ? $_->provision_hold : 1 }
+ $self->part_pkg->pkg_svc;
}
=item part_svc [ OPTION => VALUE ... ]
to cancel package within the next day (or however
many days are set in global config part_pkg-delay_cancel-days.
+Accepts option I<part_pkg-delay_cancel-days> which should be
+the value of the config setting, to avoid looking it up again.
+
This is not a real status, this only meant for hacking display
values, because otherwise treating the package as suspended is
really the whole point of the delay_cancel option.
=cut
sub is_status_delay_cancel {
- my ($self) = @_;
+ my ($self,%opt) = @_;
if ( $self->main_pkgnum and $self->pkglinknum ) {
return $self->main_pkg->is_status_delay_cancel;
}
return 0 unless $self->part_pkg->option('delay_cancel',1);
return 0 unless $self->status eq 'suspended';
return 0 unless $self->expire;
- my $conf = new FS::Conf;
- my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+ my $expdays = $opt{'part_pkg-delay_cancel-days'};
+ unless ($expdays) {
+ my $conf = new FS::Conf;
+ $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+ }
my $expsecs = 60*60*24*$expdays;
return 0 unless $self->expire < time + $expsecs;
return 1;
map { [ $_->label ] } $self->cust_svc;
}
-=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
+=item h_labels END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ]
Like the labels method, but returns historical information on services that
were active as of END_TIMESTAMP and (optionally) not cancelled before
START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the
I<pkg_svc.hidden> flag will be omitted.
-Returns a list of lists, calling the label method for all (historical) services
-(see L<FS::h_cust_svc>) of this billing item.
+If LOCALE is passed, service definition names will be localized.
+
+Returns a list of lists, calling the label method for all (historical)
+services (see L<FS::h_cust_svc>) of this billing item.
=cut
sub h_labels {
my $self = shift;
- warn "$me _h_labels called on $self\n"
+ my ($end, $start, $mode, $locale) = @_;
+ warn "$me h_labels\n"
if $DEBUG;
- map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
+ map { [ $_->label($end, $start, $locale) ] }
+ $self->h_cust_svc($end, $start, $mode);
}
=item labels_short
=cut
sub labels_short {
- shift->_labels_short( 'labels', @_ );
+ shift->_labels_short( 'labels' ); # 'labels' takes no further arguments
}
-=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
+=item h_labels_short END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ]
Like h_labels, except returns a simple flat list, and shortens long
-(currently >5 or the cust_bill-max_same_services configuration value) lists of
-identical services to one line that lists the service label and the number of
-individual services rather than individual items.
+(currently >5 or the cust_bill-max_same_services configuration value) lists
+of identical services to one line that lists the service label and the
+number of individual services rather than individual items.
=cut
shift->_labels_short( 'h_labels', @_ );
}
+# takes a method name ('labels' or 'h_labels') and all its arguments;
+# maybe should be "shorten($self->h_labels( ... ) )"
+
sub _labels_short {
my( $self, $method ) = ( shift, shift );
sub cust_main {
my $self = shift;
+ cluck 'cust_pkg->cust_main called' if $DEBUG;
qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
}
=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
+Bulk cancel + order subroutine. Perhaps slightly deprecated, only used by the
+bulk cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
+
CUSTNUM is a customer (see L<FS::cust_main>)
PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
'';
}
+=item forward_emails
+
+Returns a hash of svcnums and corresponding email addresses
+for svc_acct services that can be used as source or dest
+for svc_forward services provisioned in this package.
+
+Accepts options I<svc_forward> OR I<svcnum> for a svc_forward
+service; if included, will ensure the current values of the
+specified service are included in the list, even if for some
+other reason they wouldn't be. If called as a class method
+with a specified service, returns only these current values.
+
+Caution: does not actually check if svc_forward services are
+available to be provisioned on this package.
+
+=cut
+
+sub forward_emails {
+ my $self = shift;
+ my %opt = @_;
+
+ #load optional service, thoroughly validated
+ die "Use svcnum or svc_forward, not both"
+ if $opt{'svcnum'} && $opt{'svc_forward'};
+ my $svc_forward = $opt{'svc_forward'};
+ $svc_forward ||= qsearchs('svc_forward',{ 'svcnum' => $opt{'svcnum'} })
+ if $opt{'svcnum'};
+ die "Specified service is not a forward service"
+ if $svc_forward && (ref($svc_forward) ne 'FS::svc_forward');
+ die "Specified service not found"
+ if ($opt{'svcnum'} || $opt{'svc_forward'}) && !$svc_forward;
+
+ my %email;
+
+ ## everything below was basically copied from httemplate/edit/svc_forward.cgi
+ ## with minimal refactoring, not sure why we can't just load all svc_accts for this custnum
+
+ #add current values from specified service, if there was one
+ if ($svc_forward) {
+ foreach my $method (qw( srcsvc_acct dstsvc_acct )) {
+ my $svc_acct = $svc_forward->$method();
+ $email{$svc_acct->svcnum} = $svc_acct->email if $svc_acct;
+ }
+ }
+
+ if (ref($self) eq 'FS::cust_pkg') {
+
+ #and including the rest for this customer
+ my($u_part_svc,@u_acct_svcparts);
+ foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
+ push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
+ }
+
+ my $custnum = $self->getfield('custnum');
+ foreach my $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+ my $cust_pkgnum = $i_cust_pkg->getfield('pkgnum');
+ #now find the corresponding record(s) in cust_svc (for this pkgnum!)
+ foreach my $acct_svcpart (@u_acct_svcparts) {
+ foreach my $i_cust_svc (
+ qsearch( 'cust_svc', { 'pkgnum' => $cust_pkgnum,
+ 'svcpart' => $acct_svcpart } )
+ ) {
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $i_cust_svc->svcnum } );
+ $email{$svc_acct->svcnum} = $svc_acct->email;
+ }
+ }
+ }
+ }
+
+ return %email;
+}
+
# Used by FS::Upgrade to migrate to a new database.
sub _upgrade_data { # class method
my ($class, %opts) = @_;
projects / freeside.git / blobdiff