package FS::cust_pkg;
-
-use strict;
-use base qw( FS::otaker_Mixin FS::cust_main_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 );
-use vars qw($disable_agentcheck $DEBUG $me);
+
+use strict;
+use vars qw( $disable_agentcheck $DEBUG $me $upgrade );
use Carp qw(cluck);
use Scalar::Util qw( blessed );
-use List::Util qw(min max);
+use List::Util qw(min max sum);
use Tie::IxHash;
use Time::Local qw( timelocal timelocal_nocheck );
use MIME::Entity;
use FS::cust_pkg_discount;
use FS::discount;
use FS::UI::Web;
-use Data::Dumper;
+use FS::sales;
+# for modify_charge
+use FS::cust_credit;
# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
# setup }
$disable_agentcheck = 0;
+$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 ] );
=item locationnum
-Optional link to package location (see L<FS::location>)
+Optional link to package location (see L<FS::cust_location>)
=item order_date
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
The package link (L<FS::part_pkg_link>) 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
' (cust_pkg.pkgnum '. $self->pkgnum. ')';
}
+=item set_initial_timers
+
+If required by the package definition, sets any automatic expire, adjourn,
+or contract_end timers to some number of months after the start date
+(or setup date, if the package has already been setup). If the package has
+a delayed setup fee after a period of "free days", will also set the
+start date to the end of that period.
+
+=cut
+
+sub set_initial_timers {
+ my $self = shift;
+ my $part_pkg = $self->part_pkg;
+ foreach my $action ( qw(expire adjourn contract_end) ) {
+ my $months = $part_pkg->option("${action}_months",1);
+ if($months and !$self->get($action)) {
+ my $start = $self->start_date || $self->setup || time;
+ $self->set($action, $part_pkg->add_freq($start, $months) );
+ }
+ }
+
+ # if this package has "free days" and delayed setup fee, then
+ # set start date that many days in the future.
+ # (this should have been set in the UI, but enforce it here)
+ if ( $part_pkg->option('free_days',1)
+ && $part_pkg->option('delay_setup',1)
+ )
+ {
+ $self->start_date( $part_pkg->default_start_date );
+ }
+ '';
+}
+
=item insert [ OPTION => VALUE ... ]
Adds this billing item to the database ("Orders" the item). If there is an
=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,
+auto-adding a 1st start date, auto-adding expiration/adjourn/contract_end dates)
=item options
my $part_pkg = $self->part_pkg;
- 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;
- until ( $mon < 12 ) { $mon -= 12; $year++; }
- $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
- }
+ if ( ! $options{'change'} ) {
- foreach my $action ( qw(expire adjourn contract_end) ) {
- my $months = $part_pkg->option("${action}_months",1);
- if($months and !$self->$action) {
- my $start = $self->start_date || $self->setup || time;
- $self->$action( $part_pkg->add_freq($start, $months) );
- }
- }
+ # set order date to now
+ $self->order_date(time);
- 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 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;
+ until ( $mon < 12 ) { $mon -= 12; $year++; }
+ $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
+ }
- $self->order_date(time);
+ if ($self->susp eq 'now' or $part_pkg->start_on_hold) {
+ # if the package was ordered on hold:
+ # - suspend it
+ # - don't set the start date (it will be started manually)
+ $self->set('susp', $self->order_date);
+ $self->set('start_date', '');
+ } else {
+ # set expire/adjourn/contract_end timers, and free days, if appropriate
+ $self->set_initial_timers;
+ }
+ } # else this is a package change, and shouldn't have "new package" behavior
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
}
}
- #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 ($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
=item reason
-can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
+can be set to a cancellation reason (see L<FS::reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
=item reason_otaker
}
- 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;
}
}
+ # 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;
'';
|| $self->ut_numbern('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')
|| $self->ut_numbern('resume')
|| $self->ut_numbern('expire')
|| $self->ut_numbern('dundate')
- || $self->ut_enum('no_auto', [ '', 'Y' ])
- || $self->ut_enum('waive_setup', [ '', 'Y' ])
- || $self->ut_numbern('agent_pkgid')
+ || $self->ut_flag('no_auto', [ '', 'Y' ])
+ || $self->ut_flag('waive_setup', [ '', 'Y' ])
+ || $self->ut_flag('separate_bill')
+ || $self->ut_textn('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;
return "A package with both start date (future start) and setup date (already started) will never bill"
- if $self->start_date && $self->setup;
+ if $self->start_date && $self->setup && ! $upgrade;
return "A future unsuspend date can only be set for a package with a suspend date"
if $self->resume and !$self->susp and !$self->adjourn;
this.
=item reason - can be set to a cancellation reason (see L<FS:reason>),
-either a reasonnum of an existing reason, or passing a hashref will create
-a new reason. The hashref should have the following keys: typenum - Reason
-type (see L<FS::reason_type>, reason - Text of the new reason.
+either a reasonnum of an existing reason, or a hashref to create
+a new reason. The hashref should have the following keys:
+typenum - Reason type (see L<FS::reason_type>
+reason - Text of the new reason.
+
+If this argument isn't given or is a false value, then the package will be
+canceled with no reason.
=item date - can be set to a unix style timestamp to specify when to
cancel (expire)
case. If it's not set, the 'unused_credit_cancel' part_pkg option will
be used.
+=item no_delay_cancel - prevents delay_cancel behavior
+no matter what other options say, for use when changing packages (or any
+other time you're really sure you want an immediate cancel)
+
=back
If there is an error, returns the error, otherwise returns false.
=cut
+#NOT DOCUMENTING - this should only be used when calling recursively
+#=item delay_cancel - for internal use, to allow proper handling of
+#supplemental packages when the main package is flagged to suspend
+#before cancelling, probably shouldn't be used otherwise (set the
+#corresponding package option instead)
+
sub cancel {
my( $self, %options ) = @_;
my $error;
# pass all suspend/cancel actions to the main package
- if ( $self->main_pkgnum and !$options{'from_main'} ) {
+ # (unless the pkglinknum has been removed, then the link is defunct and
+ # this package can be canceled on its own)
+ if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) {
return $self->main_pkg->cancel(%options);
}
my $date = $options{'date'} if $options{'date'}; # expire/cancel later
$date = '' if ($date && $date <= $cancel_time); # complain instead?
+ my $delay_cancel = $options{'no_delay_cancel'} ? 0 : $options{'delay_cancel'};
+ if ( !$date && $self->part_pkg->option('delay_cancel',1)
+ && (($self->status eq 'active') || ($self->status eq 'suspended'))
+ && !$options{'no_delay_cancel'}
+ ) {
+ my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+ my $expsecs = 60*60*24*$expdays;
+ my $suspfor = $self->susp ? $cancel_time - $self->susp : 0;
+ $expsecs = $expsecs - $suspfor if $suspfor;
+ unless ($expsecs <= 0) { #if it's already been suspended long enough, don't re-suspend
+ $delay_cancel = 1;
+ $date = $cancel_time + $expsecs;
+ }
+ }
+
#race condition: usage could be ongoing until unprovisioned
#resolved by performing a change package instead (which unprovisions) and
#later cancelling
}
}
+ # 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 ) {
return $error;
}
}
-
} #unless $date
my %hash = $self->hash;
- $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
+ if ( $date ) {
+ $hash{'expire'} = $date;
+ if ($delay_cancel) {
+ # just to be sure these are clear
+ $hash{'adjourn'} = undef;
+ $hash{'resume'} = undef;
+ }
+ } else {
+ $hash{'cancel'} = $cancel_time;
+ }
+ $hash{'change_custnum'} = $options{'change_custnum'};
+
+ # if this is a supplemental package that's lost its part_pkg_link, and it's
+ # being canceled for real, unlink it completely
+ if ( !$date and ! $self->pkglinknum ) {
+ $hash{main_pkgnum} = '';
+ }
+
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('no_delay_cancel' => 1) || $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);
+ $error = $supp_pkg->cancel(%options,
+ 'from_main' => 1,
+ 'date' => $date, #in case it got changed by delay_cancel
+ 'delay_cancel' => $delay_cancel,
+ );
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";
+ if ($delay_cancel && !$options{'from_main'}) {
+ $error = $new->suspend(
+ 'from_cancel' => 1,
+ 'time' => $cancel_time
+ );
+ }
+
+ unless ($date) {
+ 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
- my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
- if ( !$options{'quiet'} &&
- $conf->exists('emailcancel', $self->cust_main->agentnum) &&
- @invoicing_list ) {
- my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
+ my $cust_main = $self->cust_main;
+
+ my @invoicing_list = $cust_main->invoicing_list_emailonly;
+ if ( !$options{'quiet'}
+ && $conf->config_bool('emailcancel', $cust_main->agentnum)
+ && @invoicing_list
+ )
+ {
+ my $msgnum = $conf->config('cancel_msgnum', $cust_main->agentnum);
my $error = '';
if ( $msgnum ) {
my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
- $error = $msg_template->send( 'cust_main' => $self->cust_main,
- 'object' => $self );
- }
- else {
+ $error = $msg_template->send(
+ 'cust_main' => $cust_main,
+ 'object' => $self,
+ );
+ } else {
$error = send_email(
- 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
+ 'from' => $conf->invoice_from_full( $self->cust_main->agentnum ),
'to' => \@invoicing_list,
'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
'body' => [ map "$_\n", $conf->config('cancelmessage') ],
+ 'custnum' => $self->custnum,
+ 'msgtype' => '', #admin?
);
}
#should this do something on errors?
}
+ my %pkg_class = map { $_=>1 }
+ $conf->config('cancel_msgnum-referring_cust-pkg_class');
+ my $ref_msgnum = $conf->config('cancel_msgnum-referring_cust');
+ if ( !$options{'quiet'}
+ && $cust_main->referral_custnum
+ && $pkg_class{ $self->classnum }
+ && $ref_msgnum
+ )
+ {
+ my $msg_template = qsearchs('msg_template', { msgnum => $ref_msgnum });
+ my $error = $msg_template->send(
+ 'cust_main' => $cust_main->referring_cust_main,
+ 'object' => $self,
+ );
+ #should this do something on errors?
+ }
+
''; #no errors
}
=cut
+# XXX should look for an expire reason
+# but seems to be unused; this is now handled more holistically in
+# cust_main::Billing
+
sub cancel_if_expired {
my $self = shift;
my $time = shift || time;
'';
}
+=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.
setup
susp adjourn resume expire start_date contract_end dundate
change_date change_pkgpart change_locationnum
- manual_flag no_auto quantity agent_pkgid recur_show_zero setup_show_zero
+ manual_flag no_auto separate_bill quantity agent_pkgid
+ recur_show_zero setup_show_zero
),
};
# 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
=over 4
-=item reason - can be set to a cancellation reason (see L<FS:reason>),
+=item reason - can be set to a cancellation reason (see L<FS::reason>),
either a reasonnum of an existing reason, or passing a hashref will create
a new reason. The hashref should have the following keys:
- typenum - Reason type (see L<FS::reason_type>
=item from_main - allows a supplemental package to be suspended, rather
than redirecting the method call to its main package. For internal use.
+=item from_cancel - used when suspending from the cancel method, forces
+this to skip everything besides basic suspension. For internal use.
+
=back
If there is an error, returns the error, otherwise returns false.
}
# some false laziness with sub cancel
- if ( !$options{nobill} && !$date &&
+ if ( !$options{nobill} && !$date && !$options{'from_cancel'} &&
$self->part_pkg->option('bill_suspend_as_cancel',1) ) {
# kind of a kludge--'bill_suspend_as_cancel' to avoid having to
# make the entire cust_main->bill path recognize 'suspend' and
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
+ # unused_credit
+ # (passing a reason hashref is still allowed, but it can't be used with
+ # the fancy behavioral options.)
+
+ my $reason;
+ if ($options{'reason'} =~ /^\d+$/) {
+ $reason = FS::reason->by_key($options{'reason'});
}
my %hash = $self->hash;
return $error;
}
- unless ( $date ) {
- # credit remaining time if appropriate
- if ( $self->part_pkg->option('unused_credit_suspend', 1) ) {
- my $error = $self->credit_remaining('suspend', $suspend_time);
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
+ unless ( $date ) { # then we are suspending now
+
+ unless ($options{'from_cancel'}) {
+ # credit remaining time if appropriate
+ # (if required by the package def, or the suspend reason)
+ my $unused_credit = $self->part_pkg->option('unused_credit_suspend',1)
+ || ( defined($reason) && $reason->unused_credit );
+
+ if ( $unused_credit ) {
+ warn "crediting unused time on pkg#".$self->pkgnum."\n" if $DEBUG;
+ my $error = $self->credit_remaining('suspend', $suspend_time);
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
}
}
}
}
+ # 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') ) {
+ if ( $conf->config('suspend_email_admin') && !$options{'from_cancel'} ) {
my $error = send_email(
'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
( map { "Service : $_\n" } @labels ),
],
+ 'custnum' => $self->custnum,
+ 'msgtype' => 'admin'
);
if ( $error ) {
=cut
+# Implementation note:
+#
+# If you pkgpart-change a package that has been billed, and it's set to give
+# credit on package change, then this method gets called and then the new
+# package will have no last_bill date. Therefore the customer will be credited
+# only once (per billing period) even if there are multiple package changes.
+#
+# If you location-change a package that has been billed, this method will NOT
+# be called and the new package WILL have the last bill date of the old
+# package.
+#
+# If the new package is then canceled within the same billing cycle,
+# credit_remaining needs to run calc_remain on the OLD package to determine
+# the amount of unused time to credit.
+
sub credit_remaining {
# Add a credit for remaining service
my ($self, $mode, $time) = @_;
my $conf = FS::Conf->new;
my $reason_type = $conf->config($mode.'_credit_type');
- my $last_bill = $self->getfield('last_bill') || 0;
- my $next_bill = $self->getfield('bill') || 0;
- if ( $last_bill > 0 # the package has been billed
- and $next_bill > 0 # the package has a next bill date
- and $next_bill >= $time # which is in the future
- ) {
- my $remaining_value = $self->calc_remain('time' => $time);
- if ( $remaining_value > 0 ) {
- warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
- if $DEBUG;
- my $error = $self->cust_main->credit(
- $remaining_value,
- 'Credit for unused time on '. $self->part_pkg->pkg,
- 'reason_type' => $reason_type,
- );
- return "Error crediting customer \$$remaining_value for unused time".
- " on ". $self->part_pkg->pkg. ": $error"
- if $error;
- } #if $remaining_value
- } #if $last_bill, etc.
+ $time ||= time;
+
+ my $remain_pkg = $self;
+ my (@billpkgnums, @amounts, @setuprecurs);
+
+ # we may have to walk back past some package changes to get to the
+ # one that actually has unused time. loop until that happens, or we
+ # reach the first package in the chain.
+ while (1) {
+ my $last_bill = $remain_pkg->get('last_bill') || 0;
+ my $next_bill = $remain_pkg->get('bill') || 0;
+ if ( $last_bill > 0 # the package has been billed
+ and $next_bill > 0 # the package has a next bill date
+ and $next_bill >= $time # which is in the future
+ ) {
+
+ # Find actual charges for the period ending on or after the cancel
+ # date.
+ my @charges = qsearch('cust_bill_pkg', {
+ pkgnum => $remain_pkg->pkgnum,
+ edate => {op => '>=', value => $time},
+ recur => {op => '>' , value => 0},
+ });
+
+ foreach my $cust_bill_pkg (@charges) {
+ # hack to deal with the weird behavior of edate on package
+ # cancellation
+ my $edate = $cust_bill_pkg->edate;
+ if ( $self->recur_temporality eq 'preceding' ) {
+ $edate = $self->add_freq($cust_bill_pkg->sdate);
+ }
+
+ # this will also get any package charges that are _entirely_ after
+ # the cancellation date (can happen with advance billing). in that
+ # case, use the entire recurring charge:
+ my $amount = $cust_bill_pkg->recur - $cust_bill_pkg->usage;
+ my $max_credit = $amount
+ - $cust_bill_pkg->credited('', '', setuprecur => 'recur') || 0;
+
+ # but if the cancellation happens during the interval, prorate it:
+ # (XXX obey prorate_round_day here?)
+ if ( $cust_bill_pkg->sdate < $time ) {
+ $amount = $amount *
+ ($edate - $time) / ($edate - $cust_bill_pkg->sdate);
+ }
+
+ # if there are existing credits, don't let the sum of credits exceed
+ # the recurring charge
+ $amount = $max_credit if $amount > $max_credit;
+
+ $amount = sprintf('%.2f', $amount);
+
+ # if no time has been used and/or there are existing line item
+ # credits, we may end up not needing to credit anything.
+ if ( $amount > 0 ) {
+
+ push @billpkgnums, $cust_bill_pkg->billpkgnum;
+ push @amounts, $amount;
+ push @setuprecurs, 'recur';
+
+ warn "Crediting for $amount on package ".$remain_pkg->pkgnum."\n"
+ if $DEBUG;
+ }
+
+ }
+
+ last if @charges;
+ }
+
+ if ( my $changed_from_pkgnum = $remain_pkg->change_pkgnum ) {
+ $remain_pkg = FS::cust_pkg->by_key($changed_from_pkgnum);
+ } else {
+ # the package has really never been billed
+ return;
+ }
+ }
+
+ # keep traditional behavior here.
+ local $@;
+ my $reason = FS::reason->new_or_existing(
+ reason => 'Credit for unused time on '. $self->part_pkg->pkg,
+ type => $reason_type,
+ class => 'R',
+ );
+ if ( $@ ) {
+ return "failed to set credit reason: $@";
+ }
+
+ my $error = FS::cust_credit->credit_lineitems(
+ 'billpkgnums' => \@billpkgnums,
+ 'setuprecurs' => \@setuprecurs,
+ 'amounts' => \@amounts,
+ 'custnum' => $self->custnum,
+ 'date' => time,
+ 'reasonnum' => $reason->reasonnum,
+ 'apply' => 1,
+ );
+
'';
}
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
return ""; # no error # complain instead?
}
+ # handle the case of setting a future unsuspend (resume) date
+ # and do not continue to actually unsuspend the package
my $date = $opt{'date'};
if ( $date and $date > time ) { # return an error if $date <= time?
} #if $date
+ if (!$self->setup) {
+ # then this package is being released from on-hold status
+ $self->set_initial_timers;
+ }
+
my @labels = ();
foreach my $cust_svc (
my $conf = new FS::Conf;
- 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) )
- ) {
+ # increment next bill date if certain conditions are met:
+ # - it was due to be billed at some point
+ # - either the global or local config says to do this
+ my $adjust_bill = 0;
+ 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)
+ )
+ ) {
+ $adjust_bill = 1;
+ }
- $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
-
+ # but not if:
+ # - the package billed during suspension
+ # - or it was ordered on hold
+ # - or the customer was credited for the unused time
+
+ if ( $self->option('suspend_bill',1)
+ or ( $self->part_pkg->option('suspend_bill',1)
+ and ! $self->option('no_suspend_bill',1)
+ )
+ or $hash{'order_date'} == $hash{'susp'}
+ ) {
+ $adjust_bill = 0;
+ }
+
+ if ( $adjust_bill ) {
+ if ( $self->part_pkg->option('unused_credit_suspend')
+ or ( $reason and $reason->unused_credit ) ) {
+ # then the customer was credited for the unused time before suspending,
+ # so their next bill should be immediate.
+ $hash{'bill'} = time;
+ } else {
+ # add the length of time suspended to the bill date
+ $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
+ }
}
$hash{'susp'} = '';
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 ) {
: ''
),
],
+ 'custnum' => $self->custnum,
+ 'msgtype' => 'admin',
);
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
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>).
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.
+
+=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 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.
=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 $opt = ref($_[0]) ? shift : { @_ };
-# my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
-#
-
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;
+ }
- my %hash = ();
+ # figure out if we're changing pkgpart
+ if ( $opt->{'cust_pkg'} ) {
+ $opt->{'pkgpart'} = $opt->{'cust_pkg'}->pkgpart;
+ }
- my $time = time;
+ # whether to override pkgpart checking on the new package
+ my $same_pkgpart = 1;
+ if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) {
+ $same_pkgpart = 0;
+ }
- #$hash{$_} = $self->$_() foreach qw( last_bill bill );
-
- #$hash{$_} = $self->$_() foreach qw( setup );
+ if ($opt->{'waive_setup'}) { $self->set('waive_setup', $opt->{'waive_setup'}) }
+ else { $self->set('waive_setup', ''); }
- $hash{'setup'} = $time if $self->setup;
+ # 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 usage pools, copy invoice details, or change any
+ # dates. We DO need to "transfer" services (from the package to itself) to
+ # check their validity on the new pkgpart.
+ if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) {
+ foreach ( qw( locationnum pkgpart quantity refnum salesnum waive_setup ) ) {
+ if ( length($opt->{$_}) ) {
+ $self->set($_, $opt->{$_});
+ }
+ }
+ # almost. if the new pkgpart specifies start/adjourn/expire timers,
+ # apply those.
+ if ( !$same_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'};
- $hash{'change_date'} = $time;
- $hash{"change_$_"} = $self->$_()
- foreach qw( pkgnum pkgpart locationnum );
+ $error = $self->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "modifying package: $error";
+ }
+
+ # check/convert services (only on pkgpart change, to avoid surprises
+ # when editing locations)
+ # (maybe do this if changing quantity?)
+ if ( !$same_pkgpart ) {
+
+ $error = $self->transfer($self);
+
+ if ( $error and $error == 0 ) {
+ $error = "transferring $error";
+ } elsif ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
+ warn "trying transfer again with change_svcpart option\n" if $DEBUG;
+ $error = $self->transfer($self, 'change_svcpart'=>1 );
+ if ($error and $error == 0) {
+ $error = "converting $error";
+ }
+ }
- if ( $opt->{'cust_location'} &&
- ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
+ if ($error > 0) {
+ $error = "unable to transfer all services";
+ }
- if ( ! $opt->{'cust_location'}->locationnum ) {
- # not inserted yet
- $error = $opt->{'cust_location'}->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "inserting cust_location (transaction rolled back): $error";
+ return $error;
}
- }
- $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
- }
+ } # done transferring services
+
+ $dbh->commit if $oldAutoCommit;
+ return $self;
- # 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 %hash = ();
+
+ my $time = time;
+
+ $hash{'setup'} = $time if $self->get('setup');
+
+ $hash{'change_date'} = $time;
+ $hash{"change_$_"} = $self->$_()
+ foreach qw( pkgnum pkgpart locationnum );
+
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 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)
$opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
# 2. (more importantly) changing a package before it's billed
$hash{'waive_setup'} = $self->waive_setup;
- # 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,
- };
- $error = $cust_pkg->insert( 'change' => 1,
- 'allow_pkgpart' => $same_pkgpart );
+ # 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};
+ 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'};
+
+ # follow all the above rules for date changes, etc.
+ foreach (keys %hash) {
+ $cust_pkg->set($_, $hash{$_});
+ }
+ # 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 {
+ # 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;
+ return "inserting new package: $error";
}
# 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.
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "transferring $error";
}
if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
if ($error and $error == 0) {
# $old_pkg->transfer failed.
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "converting $error";
}
}
- 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;
- return "Unable to transfer all services from package ". $self->pkgnum;
+ return "unable to transfer all services";
}
#reset usage if changing pkgpart
if ($error) {
$dbh->rollback if $oldAutoCommit;
- return "Error setting usage values: $error";
+ return "setting usage values: $error";
}
} else {
# if NOT changing pkgpart, transfer any usage pools over
$error = $usage->replace;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "Error transferring usage pools: $error";
+ return "transferring usage pools: $error";
}
}
}
$error = $new_discount->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "Error transferring discounts: $error";
+ return "transferring discounts: $error";
}
}
}
- # Order any supplemental packages.
- my $part_pkg = $cust_pkg->part_pkg;
- my @old_supp_pkgs = $self->supplemental_pkgs;
- my @new_supp_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 => $self->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;
- }
+ # 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;
+ return "transferring package notes: $error";
+ }
+ }
+
+ # transfer scheduled expire/adjourn reasons
+ foreach my $action ('expire', 'adjourn') {
+ if ( $cust_pkg->get($action) ) {
+ my $reason = $self->last_cust_pkg_reason($action);
+ if ( $reason ) {
+ $reason->set('pkgnum', $cust_pkg->pkgnum);
+ $error = $reason->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "transferring $action reason: $error";
+ }
+ }
}
- push @new_supp_pkgs, $new;
}
+
+ 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.
#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 : '' ),
+ no_delay_cancel => 1,
);
if ($error) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "canceling old package: $error";
+ }
+
+ # transfer rt_field_charge, if we're not changing pkgpart
+ # after billing of old package, before billing of new package
+ if ( $same_pkgpart ) {
+ foreach my $rt_field_charge ($self->rt_field_charge) {
+ $rt_field_charge->set('pkgnum', $cust_pkg->pkgnum);
+ $error = $rt_field_charge->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "transferring rt_field_charge: $error";
+ }
+ }
}
if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "billing new package: $error";
}
}
}
+=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 discount
+
+Optional hashref that will be passed to $new_pkg->change_discount()
+
+=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 %discount;
+ %discount = %{$opt->{discount}} if ref $opt->{discount};
+
+ 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;
+ }
+
+ 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);
+
+ # Apply user-specified discount to new cust_pkg
+ $error = $err_or_pkg->change_discount(\%discount)
+ if !$error && %discount && $discount{discountnum} =~ /^-?\d+$/;
+ } 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;
+
+ # Apply user-specified discount to new cust_pkg
+ $error = $change_to->change_discount(\%discount)
+ if !$error && %discount && $discount{discountnum} =~ /^-?\d+$/;
+ }
+ 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 ) {
+ $self->set('change_to_pkgnum', $new->pkgnum);
+ $self->set('expire', $date);
+ $error = $self->replace;
+ }
+
+ # Apply user-specified discount to new cust_pkg
+ $new->change_discount(\%discount)
+ if !$error && %discount && $discount{discountnum} =~ /^-?\d+$/;
+
+ 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 the one package property
+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.
sub set_quantity {
my $self = shift;
$self = $self->replace_old; # just to make sure
- my $qty = shift;
- ($qty =~ /^\d+$/ and $qty > 0) or return "bad package quantity $qty";
- $self->set('quantity' => $qty);
+ $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);
+ }
+ 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;
+ die "Must select a new package definition\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 $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
+ my @old_pkgpart = ref($param->{'old_pkgpart'}) ? @{ $param->{'old_pkgpart'} }
+ : $param->{'old_pkgpart'};
+
+ my @cust_pkgs = qsearch({
+ 'table' => 'cust_pkg',
+ 'extra_sql' => ' WHERE pkgpart IN ('.
+ join(',', @old_pkgpart). ')',
+ });
my $i = 0;
foreach my $old_cust_pkg ( @cust_pkgs ) {
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
$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
=item cust_event
-Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
+Returns the customer billing events (see L<FS::cust_event>) for this invoice.
=cut
=item num_cust_event
-Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
+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(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
- " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
+ 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($self->pkgnum) or die $sth->errstr. " executing $sql";
- $sth->fetchrow_arrayref->[0];
+ $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(@_) };
+}
- return () unless $self->num_cust_svc(@_);
+sub cust_svc_unsorted_arrayref {
+ my $self = shift;
+
+ return [] unless $self->num_cust_svc(@_);
my %opt = ();
if ( @_ && $_[0] =~ /^\d+/ ) {
}
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};
- 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) ];
}
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,
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 ... ]
=over 4
-=item num_cust_svc (count)
+=item num_cust_svc
+
+(count)
-=item num_avail (quantity - count)
+=item num_avail
-=item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
+(quantity - count)
+
+=item cust_pkg_svc
+
+(services) - array reference containing the provisioned services, as cust_svc objects
=back
-Accepts one option: summarize_size. If specified and non-zero, will omit the
-extra cust_pkg_svc option for objects where num_cust_svc is this size or
-greater.
+Accepts two options:
+
+=over 4
+
+=item summarize_size
+
+If true, will omit the extra cust_pkg_svc option for objects where num_cust_svc
+is this size or greater.
+
+=item hide_discontinued
+
+If true, will omit looking for services that are no longer avaialble in the
+package definition.
+
+=back
=cut
$part_svc;
} $self->part_pkg->pkg_svc;
- #extras
- push @part_svc, map {
- my $part_svc = $_;
- my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
- $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
- $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
- $part_svc->{'Hash'}{'cust_pkg_svc'} =
- $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
- $part_svc;
- } $self->extra_part_svc;
+ unless ( $opt{hide_discontinued} ) {
+ #extras
+ push @part_svc, map {
+ my $part_svc = $_;
+ my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
+ $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
+ $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
+ $part_svc->{'Hash'}{'cust_pkg_svc'} =
+ $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
+ $part_svc;
+ } $self->extra_part_svc;
+ }
@part_svc;
=over 4
+=item on hold
+
=item not yet billed
=item one-time charge
my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
return 'cancelled' if $self->get('cancel');
+ return 'on hold' if $self->susp && ! $self->setup;
return 'suspended' if $self->susp;
return 'not yet billed' unless $self->setup;
return 'one-time charge' if $freq =~ /^(0|$)/;
=cut
tie my %statuscolor, 'Tie::IxHash',
+ 'on hold' => 'FF00F5', #brighter purple!
'not yet billed' => '009999', #teal? cyan?
- 'one-time charge' => '000000',
+ 'one-time charge' => '0000CC', #blue #'000000',
'active' => '00CC00',
'suspended' => 'FF9900',
'cancelled' => 'FF0000',
keys %statuscolor;
}
+sub statuscolors {
+ #my $self = shift;
+ \%statuscolor;
+}
+
=item statuscolor
Returns a hex triplet color string for this package's status.
$statuscolor{$self->status};
}
+=item is_status_delay_cancel
+
+Returns true if part_pkg has option delay_cancel,
+cust_pkg status is 'suspended' and expire is set
+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,%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 $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;
+}
+
=item pkg_label
Returns a label for this package. (Currently "pkgnum: pkg - comment" or
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 } );
}
sub tax_location {
my $self = shift;
- FS::cust_location->by_key( $self->tax_locationnum )
+ my $conf = FS::Conf->new;
+ if ( $conf->exists('tax-pkg_address') and $self->locationnum ) {
+ return FS::cust_location->by_key($self->locationnum);
+ }
+ elsif ( $conf->exists('tax-ship_address') ) {
+ return $self->cust_main->ship_location;
+ }
+ else {
+ return $self->cust_main->bill_location;
+ }
}
=item seconds_since TIMESTAMP
foreach my $cust_svc (
grep {
my $part_svc = $_->part_svc;
- $part_svc->svcdb eq 'svc_acct'
- && scalar($part_svc->part_export_usage);
+ scalar($part_svc->part_export_usage);
} $self->cust_svc
) {
$sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
return ('Package does not exist: '.$dest_pkgnum) unless $dest;
foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
- $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
+ $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
}
- foreach my $cust_svc ($dest->cust_svc) {
- $target{$cust_svc->svcpart}--;
+ unless ( $self->pkgnum == $dest->pkgnum ) {
+ foreach my $cust_svc ($dest->cust_svc) {
+ $target{$cust_svc->svcpart}--;
+ }
}
my %svcpart2svcparts = ();
}
}
+ my $error;
foreach my $cust_svc ($self->cust_svc) {
- if($target{$cust_svc->svcpart} > 0
- or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
+ my $svcnum = $cust_svc->svcnum;
+
+ if ( $target{$cust_svc->svcpart} > 0
+ or $FS::cust_svc::ignore_quantity # maybe should be a 'force' option
+ )
+ {
$target{$cust_svc->svcpart}--;
+
+ local $FS::cust_svc::ignore_quantity = 1
+ if $self->pkgnum == $dest->pkgnum;
+
+ #why run replace at all in the $self->pkgnum == $dest->pkgnum case?
+ # we do want to trigger location and pkg_change exports, but
+ # without pkgnum changing from an old to new package, cust_svc->replace
+ # doesn't know how to trigger those. :/
+ # does this mean we scrap the whole idea of "safe to modify it in place",
+ # or do we special-case and pass the info needed to cust_svc->replace? :/
+
my $new = new FS::cust_svc { $cust_svc->hash };
$new->pkgnum($dest_pkgnum);
- my $error = $new->replace($cust_svc);
- return $error if $error;
+ $error = $new->replace($cust_svc);
+
} elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
+
if ( $DEBUG ) {
warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
warn "alternates to consider: ".
join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
}
+
my @alternate = grep {
warn "considering alternate svcpart $_: ".
"$target{$_} available in new package\n"
if $DEBUG;
$target{$_} > 0;
} @{$svcpart2svcparts{$cust_svc->svcpart}};
+
if ( @alternate ) {
warn "alternate(s) found\n" if $DEBUG;
my $change_svcpart = $alternate[0];
my $new = new FS::cust_svc { $cust_svc->hash };
$new->svcpart($change_svcpart);
$new->pkgnum($dest_pkgnum);
- my $error = $new->replace($cust_svc);
- return $error if $error;
+ $error = $new->replace($cust_svc);
} else {
$remaining++;
}
+
} else {
$remaining++
}
+
+ if ( $error ) {
+ my @label = $cust_svc->label;
+ return "service $label[1]: $error";
+ }
+
+ }
+ 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;
+ }
}
- return $remaining;
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
}
=item 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
=item reason
-can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
+can be set to a cancellation reason (see L<FS::reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
=item reason_otaker
$reasonnum = $reason->reasonnum;
} else {
- return "Unparsable reason: ". $options{'reason'};
+ return "Unparseable reason: ". $options{'reason'};
}
my $cust_pkg_reason =
$cust_pkg_discount->insert;
}
+
+=item change_discount %opt
+
+Method checks if the given values represent a change in either setup or
+discount level. If so, the existing discounts are revoked, the new
+discounts are recorded.
+
+Usage:
+
+$error = change_discount(
+ {
+ # -1: Indicates a "custom discount"
+ # 0: Indicates to remove any discount
+ # >0: discountnum to apply
+ discountnum => [-1, 0, discountnum],
+
+ # When discountnum is "-1" to indicate custom discount, include
+ # the additional fields:
+ amount => AMOUNT_DISCOUNT
+ percent => PERCENTAGE_DISCOUNT
+ months => 12,
+ setup => 1, # APPLY TO SETUP
+ _type => amount/percentage
+ },
+);
+
+
+=cut
+
+sub change_discount {
+ my ($self, $opt) = @_;
+ return "change_discount() called with bad \%opt hashref"
+ unless ref $opt;
+
+ my %opt = %{$opt};
+
+ my @old_discount =
+ qsearch('cust_pkg_discount',{
+ pkgnum => $self->pkgnum,
+ disabled => '',
+ });
+
+ if ($DEBUG) {
+ warn "change_discount() pkgnum: ".$self->pkgnum." \n";
+ warn "change_discount() \%opt: \n";
+ warn Dumper(\%opt);
+ }
+
+ my @to_be_disabled;
+ my %change = %opt;
+
+ return "change_discount() called with bad discountnum"
+ unless $change{discountnum} =~ /^-?\d+$/;
+
+ if ($change{discountnum} eq 0) {
+ # Removing old discount
+
+ %change = ();
+
+ push @to_be_disabled, @old_discount;
+
+ } else {
+
+ if ( grep { $_->discountnum eq $change{discountnum} } @old_discount ){
+ # Duplicate, disregard this entry
+ %change = ();
+ } else {
+ # Mark any discounts we're replacing
+ push @to_be_disabled, @old_discount;
+ }
+ }
+
+ # If we still have changes queued, create data structures for
+ # insert_discount().
+ my @discount_insert;
+ if (%change) {
+ push @discount_insert, {
+ discountnum => $change{discountnum},
+ discountnum__type => $change{_type},
+ discountnum_amount => $change{amount},
+ discountnum_percent => $change{percent} ? $change{percent} : '0',
+ discountnum_months => $change{months},
+ discountnum_setup => $change{setup} ? 'Y' : '',
+ }
+ }
+
+ if ($DEBUG) {
+ warn "change_discount() \% opt before insert \n";
+ warn Dumper \%opt;
+ warn "\@to_be_disabled \n";
+ warn Dumper \@to_be_disabled;
+ }
+
+ # Roll these updates into a transaction
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error;
+
+ # The "waive setup fee" flag has traditionally been handled by setting
+ # $cust_pkg->waive_setup = Y. This has been appropriately, and separately
+ # handled, and it operates on a different table than cust_pkg_discount,
+ # so the "-2 for waive setup fee" option is not being reimplemented
+ # here. Perhaps this may change later.
+
+ # Create new discounts
+ for my $insert_discount (@discount_insert) {
+
+ # Set parameters for insert_discount into object, and insert
+ for my $k (keys %{$insert_discount}) {
+ $self->set($k, $insert_discount->{$k});
+ }
+ $error ||= $self->insert_discount();
+ }
+
+ # Disabling old discounts
+ for my $tbd (@to_be_disabled) {
+ unless ($error) {
+ $tbd->set(disabled => 'Y');
+ $error = $tbd->replace();
+ }
+ }
+
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit if $oldAutoCommit;
+ return undef;
+}
+
=item set_usage USAGE_VALUE_HASHREF
USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
minutes => min($cust_pkg_usage->minutes, $minutes),
});
$cust_pkg_usage->set('minutes',
- sprintf('%.0f', $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes)
+ $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;
AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
"; }
+=item on_hold_sql
+
+Returns an SQL expression identifying on-hold packages.
+
+=cut
+
+sub on_hold_sql {
+ #$_[0]->recurring_sql(). ' AND '.
+ "
+ ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
+ AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
+ AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
+ ";
+}
+
=item susp_sql
=item suspended_sql
"
( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
+ AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
";
}
"cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
}
+=item ncancelled_recurring_sql
+
+Returns an SQL expression identifying un-cancelled, recurring packages.
+
+=cut
+
+sub ncancelled_recurring_sql {
+ $_[0]->recurring_sql().
+ " AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) ";
+}
+
=item status_sql
Returns an SQL expression to give the package status as a string.
sub status_sql {
"CASE
WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
+ WHEN ( cust_pkg.susp IS NOT NULL AND cust_pkg.setup IS NULL ) THEN 'on hold'
WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
WHEN ".onetime_sql()." THEN 'one-time charge'
=item agentnum
-=item magic
+=item status
-active, inactive, suspended, cancel (or cancelled)
+on hold, active, inactive (or one-time charge), suspended, canceled (or cancelled)
-=item status
+=item magic
-active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
+Equivalent to "status", except that "canceled"/"cancelled" will exclude
+packages that were changed into a new package with the same pkgpart (i.e.
+location or quantity changes).
=item custom
Limit to packages with a service location in the specified state and country.
For FCC 477 reporting, mostly.
+=item location_cust
+
+Limit to packages whose service locations are the same as the customer's
+default service location.
+
+=item location_nocust
+
+Limit to packages whose service locations are not the customer's default
+service location.
+
+=item location_census
+
+Limit to packages whose service locations have census tracts.
+
+=item location_nocensus
+
+Limit to packages whose service locations do not have a census tract.
+
+=item location_geocode
+
+Limit to packages whose locations have geocodes.
+
+=item location_geocode
+
+Limit to packages whose locations do not have geocodes.
+
+=item towernum
+
+Limit to packages associated with a svc_broadband, associated with a sector,
+associated with this towernum (or any of these, if it's an arrayref) (or NO
+towernum, if it's zero). This is an extreme niche case.
+
+=item 477part, 477rownum, date
+
+Limit to packages included in a specific row of one of the FCC 477 reports.
+'477part' is the section name (see L<FS::Report::FCC_477> methods), 'date'
+is the report as-of date (completely unrelated to the package setup/bill/
+other date fields), and '477rownum' is the row number of the report starting
+with zero. Row numbers have no inherent meaning, so this is useful only
+for explaining a 477 report you've already run.
+
=back
=cut
}
##
+ # parse cust_status
+ ##
+
+ if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
+ push @where, FS::cust_main->cust_status_sql . " = '$1' ";
+ }
+
+ ##
+ # 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
##
push @where, FS::cust_pkg->inactive_sql();
+ } elsif ( $params->{'magic'} =~ /^on[ _]hold$/
+ || $params->{'status'} =~ /^on[ _]hold$/ ) {
+
+ push @where, FS::cust_pkg->on_hold_sql();
+
+
} elsif ( $params->{'magic'} eq 'suspended'
|| $params->{'status'} eq 'suspended' ) {
push @where, FS::cust_pkg->cancelled_sql();
}
+
+ ### special case: "magic" is used in detail links from browse/part_pkg,
+ # where "cancelled" has the restriction "and not replaced with a package
+ # of the same pkgpart". Be consistent with that.
+ ###
+
+ if ( $params->{'magic'} =~ /^cancell?ed$/ ) {
+ my $new_pkgpart = "SELECT pkgpart FROM cust_pkg AS cust_pkg_next ".
+ "WHERE cust_pkg_next.change_pkgnum = cust_pkg.pkgnum";
+ # ...may not exist, if this was just canceled and not changed; in that
+ # case give it a "new pkgpart" that never equals the old pkgpart
+ push @where, "COALESCE(($new_pkgpart), 0) != cust_pkg.pkgpart";
+ }
###
# parse package class
}
###
+ # parse (customer) refnum (advertising source)
+ ###
+
+ if ( exists($params->{'refnum'}) ) {
+ my @refnum;
+ if (ref $params->{'refnum'}) {
+ @refnum = @{ $params->{'refnum'} };
+ } else {
+ @refnum = ( $params->{'refnum'} );
+ }
+ my $in = join(',', grep /^\d+$/, @refnum);
+ push @where, "cust_main.refnum IN($in)" if length $in;
+ }
+
+ ###
# parse package report options
###
}
###
- # parse country/state
+ # parse country/state/zip
###
for (qw(state country)) { # parsing rules are the same for these
if ( exists($params->{$_})
push @where, "cust_location.$_ = '$1'";
}
}
+ if ( exists($params->{zip}) ) {
+ push @where, "cust_location.zip = " . dbh->quote($params->{zip});
+ }
+
+ ###
+ # location_* flags
+ ###
+ if ( $params->{location_cust} xor $params->{location_nocust} ) {
+ my $op = $params->{location_cust} ? '=' : '!=';
+ push @where, "cust_location.locationnum $op cust_main.ship_locationnum";
+ }
+ if ( $params->{location_census} xor $params->{location_nocensus} ) {
+ my $op = $params->{location_census} ? "IS NOT NULL" : "IS NULL";
+ push @where, "cust_location.censustract $op";
+ }
+ if ( $params->{location_geocode} xor $params->{location_nogeocode} ) {
+ my $op = $params->{location_geocode} ? "IS NOT NULL" : "IS NULL";
+ push @where, "cust_location.geocode $op";
+ }
###
# parse part_pkg
);
if( exists($params->{'active'} ) ) {
- # This overrides all the other date-related fields
+ # This overrides all the other date-related fields, and includes packages
+ # that were active at some time during the interval. It excludes:
+ # - packages that were set up after the end of the interval
+ # - packages that were canceled before the start of the interval
+ # - packages that were suspended before the start of the interval
+ # and are still suspended now
my($beginning, $ending) = @{$params->{'active'}};
push @where,
"cust_pkg.setup IS NOT NULL",
"cust_pkg.setup <= $ending",
"(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
+ "(cust_pkg.susp IS NULL OR cust_pkg.susp >= $beginning )",
"NOT (".FS::cust_pkg->onetime_sql . ")";
}
else {
+ my $exclude_change_from = 0;
+ my $exclude_change_to = 0;
+
foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
- next unless exists($params->{$field});
+ if ( $params->{$field.'_null'} ) {
- my($beginning, $ending) = @{$params->{$field}};
+ push @where, "cust_pkg.$field IS NULL";
+ # this should surely be obsoleted by now: OR cust_pkg.$field == 0
- next if $beginning == 0 && $ending == 4294967295;
+ } else {
- push @where,
- "cust_pkg.$field IS NOT NULL",
- "cust_pkg.$field >= $beginning",
- "cust_pkg.$field <= $ending";
+ next unless exists($params->{$field});
+
+ my($beginning, $ending) = @{$params->{$field}};
+
+ next if $beginning == 0 && $ending == 4294967295;
+
+ push @where,
+ "cust_pkg.$field IS NOT NULL",
+ "cust_pkg.$field >= $beginning",
+ "cust_pkg.$field <= $ending";
+
+ $orderby ||= "ORDER BY cust_pkg.$field";
+
+ if ( $field eq 'setup' ) {
+ $exclude_change_from = 1;
+ } elsif ( $field eq 'cancel' ) {
+ $exclude_change_to = 1;
+ } elsif ( $field eq 'change_date' ) {
+ # if we are given setup and change_date ranges, and the setup date
+ # falls in _both_ ranges, then include the package whether it was
+ # a change or not
+ $exclude_change_from = 0;
+ }
+ }
- $orderby ||= "ORDER BY cust_pkg.$field";
+ }
+ if ($exclude_change_from) {
+ push @where, "change_pkgnum IS NULL";
}
+ if ($exclude_change_to) {
+ # a join might be more efficient here
+ push @where, "NOT EXISTS(
+ SELECT 1 FROM cust_pkg AS changed_to_pkg
+ WHERE cust_pkg.pkgnum = changed_to_pkg.change_pkgnum
+ )";
+ }
+
}
$orderby ||= 'ORDER BY bill';
}
##
+ # parse the extremely weird 'towernum' param
+ ##
+
+ if ($params->{towernum}) {
+ my $towernum = $params->{towernum};
+ $towernum = [ $towernum ] if !ref($towernum);
+ my $in = join(',', grep /^\d+$/, @$towernum);
+ if (length $in) {
+ # inefficient, but this is an obscure feature
+ eval "use FS::Report::Table";
+ FS::Report::Table->_init_tower_pkg_cache; # probably does nothing
+ push @where, "EXISTS(
+ SELECT 1 FROM tower_pkg_cache
+ WHERE tower_pkg_cache.pkgnum = cust_pkg.pkgnum
+ AND tower_pkg_cache.towernum IN ($in)
+ )"
+ }
+ }
+
+ ##
+ # parse the 477 report drill-down options
+ ##
+
+ if ($params->{'477part'} =~ /^([a-z]+)$/) {
+ my $section = $1;
+ my ($date, $rownum, $agentnum);
+ if ($params->{'date'} =~ /^(\d+)$/) {
+ $date = $1;
+ }
+ if ($params->{'477rownum'} =~ /^(\d+)$/) {
+ $rownum = $1;
+ }
+ if ($params->{'agentnum'} =~ /^(\d+)$/) {
+ $agentnum = $1;
+ }
+ if ($date and defined($rownum)) {
+ my $report = FS::Report::FCC_477->report($section,
+ 'date' => $date,
+ 'agentnum' => $agentnum,
+ 'detail' => 1
+ );
+ my $pkgnums = $report->{detail}->[$rownum]
+ or die "row $rownum is past the end of the report";
+ # '0' so that if there are no pkgnums (empty string) it will create
+ # a valid query that returns nothing
+ warn "PKGNUMS:\n$pkgnums\n\n"; # XXX debug
+
+ # and this overrides everything
+ @where = ( "cust_pkg.pkgnum IN($pkgnums)" );
+ } # else we're missing some params, ignore the whole business
+ }
+
+ ##
# setup queries, links, subs, etc. for the search
##
push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
}
+ push @where, "cust_pkg_reason.reasonnum = '".$params->{reasonnum}."'" if $params->{reasonnum};
+
my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
my $addl_from = 'LEFT JOIN part_pkg USING ( pkgpart ) '.
'LEFT JOIN cust_location USING ( locationnum ) '.
FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg');
+ if ($params->{reasonnum}) {
+ $addl_from .= 'LEFT JOIN cust_pkg_reason ON (cust_pkg_reason.pkgnum = cust_pkg.pkgnum) ';
+ }
+
my $select;
my $count_query;
if ( $params->{'select_zip5'} ) {
}
+=item fcc_477_record
+
+Returns a fcc_477 record based on option name.
+
+=cut
+
+sub fcc_477_record {
+ my ($self, $option_name) = @_;
+
+ my $fcc_record = qsearchs({
+ 'table' => 'part_pkg_fcc_option',
+ 'hashref' => { 'pkgpart' => $self->{Hash}->{pkgpart}, 'fccoptionname' => $option_name, },
+ });
+
+ return ( $fcc_record );
+
+}
+
=item tax_locationnum_sql
Returns an SQL expression for the tax location for a package, based
=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
$dbh->rollback if $oldAutoCommit;
return "Unable to transfer all services from package ".$old_pkg->pkgnum;
}
- $error = $old_pkg->cancel( quiet=>1 );
+ $error = $old_pkg->cancel( quiet=>1, 'no_delay_cancel'=>1 );
if ($error) {
$dbh->rollback;
return $error;
'';
}
+=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) = @_;
my $sth = dbh->prepare($sql);
$sth->execute or die $sth->errstr;
}
+
+ # RT31194: supplemental package links that are deleted don't clean up
+ # linked records
+ my @pkglinknums = qsearch({
+ 'select' => 'DISTINCT cust_pkg.pkglinknum',
+ 'table' => 'cust_pkg',
+ 'addl_from' => ' LEFT JOIN part_pkg_link USING (pkglinknum) ',
+ 'extra_sql' => ' WHERE cust_pkg.pkglinknum IS NOT NULL
+ AND part_pkg_link.pkglinknum IS NULL',
+ });
+ foreach (@pkglinknums) {
+ my $pkglinknum = $_->pkglinknum;
+ warn "cleaning part_pkg_link #$pkglinknum\n";
+ my $part_pkg_link = FS::part_pkg_link->new({pkglinknum => $pkglinknum});
+ my $error = $part_pkg_link->remove_linked;
+ die $error if $error;
+ }
+
+ # RT#73607: canceling a package with billing addons sometimes changes its
+ # pkgpart.
+ # Find records where the last replace_new record for the package before it
+ # was canceled has a different pkgpart from the package itself.
+ my @cust_pkg = qsearch({
+ 'table' => 'cust_pkg',
+ 'select' => 'cust_pkg.*, h_cust_pkg.pkgpart AS h_pkgpart',
+ 'addl_from' => ' JOIN (
+ SELECT pkgnum, MAX(historynum) AS historynum FROM h_cust_pkg
+ WHERE cancel IS NULL
+ AND history_action = \'replace_new\'
+ GROUP BY pkgnum
+ ) AS last_history USING (pkgnum)
+ JOIN h_cust_pkg USING (historynum)',
+ 'extra_sql' => ' WHERE cust_pkg.cancel is not null
+ AND cust_pkg.pkgpart != h_cust_pkg.pkgpart'
+ });
+ foreach my $cust_pkg ( @cust_pkg ) {
+ my $pkgnum = $cust_pkg->pkgnum;
+ warn "fixing pkgpart on canceled pkg#$pkgnum\n";
+ $cust_pkg->set('pkgpart', $cust_pkg->h_pkgpart);
+ my $error = $cust_pkg->replace;
+ die $error if $error;
+ }
+
+}
+
+# will autoload in v4+
+sub rt_field_charge {
+ my $self = shift;
+ qsearch('rt_field_charge',{ 'pkgnum' => $self->pkgnum });
}
=back
=cut
1;
-
projects / freeside.git / blobdiff