package FS::cust_pkg;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin
+use base qw( FS::cust_pkg::API FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin
FS::contact_Mixin FS::location_Mixin
FS::m2m_Common FS::option_Common );
$upgrade = 0; #go away after setup+start dates cleaned up for old customers
+our $cache_enabled = 0;
+
+sub _simplecache {
+ my( $self, $hashref ) = @_;
+ if ( $cache_enabled && $hashref->{'pkg'} && $hashref->{'plan'} ) {
+ $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
+ }
+}
+
sub _cache {
my $self = shift;
my ( $hashref, $cache ) = @_;
- #if ( $hashref->{'pkgpart'} ) {
- if ( $hashref->{'pkg'} ) {
- # #@{ $self->{'_pkgnum'} } = ();
- # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
- # $self->{'_pkgpart'} = $subcache;
- # #push @{ $self->{'_pkgnum'} },
- # FS::part_pkg->new_or_cached($hashref, $subcache);
- $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
- }
+# #if ( $hashref->{'pkgpart'} ) {
+# if ( $hashref->{'pkg'} ) {
+# # #@{ $self->{'_pkgnum'} } = ();
+# # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
+# # $self->{'_pkgpart'} = $subcache;
+# # #push @{ $self->{'_pkgnum'} },
+# # FS::part_pkg->new_or_cached($hashref, $subcache);
+# $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
+# }
if ( exists $hashref->{'svcnum'} ) {
#@{ $self->{'_pkgnum'} } = ();
my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
$seconds = $record->seconds_since($timestamp);
+ #bulk cancel+order... perhaps slightly deprecated, only used by the bulk
+ # cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
$error = FS::cust_pkg::order( $custnum, \@pkgparts );
$error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
order taker (see L<FS::access_user>)
-=item manual_flag
-
-If this field is set to 1, disables the automatic
-unsuspension of this package when using the B<unsuspendauto> config option.
-
=item quantity
If not set, defaults to 1
' (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
if ( ! $options{'change'} ) {
+ # set order date to now
+ $self->order_date(time);
+
# 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];
$self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
}
- # set up any automatic expire/adjourn/contract_end timers
- # based on the start date
- foreach my $action ( qw(expire adjourn contract_end) ) {
- my $months = $part_pkg->option("${action}_months",1);
- if($months and !$self->$action) {
- my $start = $self->start_date || $self->setup || time;
- $self->$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 ( ! $options{'change'}
- && $part_pkg->option('free_days',1)
- && $part_pkg->option('delay_setup',1)
- #&& ! $self->start_date
- )
- {
- $self->start_date( $part_pkg->default_start_date );
+ 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;
}
-
- }
-
- # set order date unless this was previously a different package
- $self->order_date(time) unless $self->change_pkgnum;
+ } # else this is a package change, and shouldn't have "new package" behavior
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
- $self->susp( $self->order_date ) if $self->susp eq 'now';
-
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
my $conf = new FS::Conf;
+ if ($self->locationnum) {
+ my @part_export =
+ map qsearch( 'part_export', {exportnum=>$_} ),
+ $conf->config('cust_location-exports'); #, $agentnum
+
+ foreach my $part_export ( @part_export ) {
+ my $error = $part_export->export_pkg_location($self); #, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
#this init stuff is still inefficient, but at least its limited to
}
}
+ # also run exports if removing locationnum?
+ # doesn't seem to happen, and we don't export blank locationnum on insert...
+ if ($new->locationnum and ($new->locationnum != $old->locationnum)) {
+ my $conf = new FS::Conf;
+ my @part_export =
+ map qsearch( 'part_export', {exportnum=>$_} ),
+ $conf->config('cust_location-exports'); #, $agentnum
+
+ foreach my $part_export ( @part_export ) {
+ my $error = $part_export->export_pkg_location($new); #, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
|| $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_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', ])
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;
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 || $change_to->delete;
+ $error ||= $change_to->cancel('no_delay_cancel' => 1) || $change_to->delete;
}
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
}
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";
+ }
}
}
}
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') ],
'';
}
+=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),
=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) = @_;
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);
+ my $remaining_value = 0;
+
+ my $remain_pkg = $self;
+ $remaining_value = $remain_pkg->calc_remain('time' => $time);
+
+ # we may have to walk back past some package changes to get to the
+ # one that actually has unused time
+ while ( $remaining_value == 0 ) {
+ if ( $remain_pkg->change_pkgnum ) {
+ $remain_pkg = FS::cust_pkg->by_key($remain_pkg->change_pkgnum);
+ } else {
+ # the package has really never been billed
+ return;
+ }
+ $remaining_value = $remain_pkg->calc_remain('time' => $time);
+ }
+
if ( $remaining_value > 0 ) {
warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
if $DEBUG;
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;
- $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
- if $inactive > 0
+ # 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)
)
- && ! $self->option('suspend_bill',1)
- && ( ! $self->part_pkg->option('suspend_bill',1)
- || $self->option('no_suspend_bill',1)
- )
- && $hash{'order_date'} != $hash{'susp'}
- ;
+ ) {
+ $adjust_bill = 1;
+ }
+
+ # 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'} = '';
$hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
my $unsusp_pkg;
- if ( $reason && $reason->unsuspend_pkgpart ) {
- my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
- or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
- " not found.";
- my $start_date = $self->cust_main->next_bill_date
- if $reason->unsuspend_hold;
-
- if ( $part_pkg ) {
- $unsusp_pkg = FS::cust_pkg->new({
- 'custnum' => $self->custnum,
- 'pkgpart' => $reason->unsuspend_pkgpart,
- 'start_date' => $start_date,
- 'locationnum' => $self->locationnum,
- # discount? probably not...
+ if ( $reason ) {
+ if ( $reason->unsuspend_pkgpart ) {
+ #warn "Suspend reason '".$reason->reason."' uses deprecated unsuspend_pkgpart feature.\n"; # in 4.x
+ my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
+ or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
+ " not found.";
+ my $start_date = $self->cust_main->next_bill_date
+ if $reason->unsuspend_hold;
+
+ if ( $part_pkg ) {
+ $unsusp_pkg = FS::cust_pkg->new({
+ 'custnum' => $self->custnum,
+ 'pkgpart' => $reason->unsuspend_pkgpart,
+ 'start_date' => $start_date,
+ 'locationnum' => $self->locationnum,
+ # discount? probably not...
+ });
+
+ $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+ }
+ }
+ # new way, using fees
+ if ( $reason->feepart and $reason->fee_on_unsuspend ) {
+ # register the need to charge a fee, cust_main->bill will do the rest
+ warn "registering unsuspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
+ if $DEBUG;
+ my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
+ 'pkgreasonnum' => $cust_pkg_reason->num,
+ 'pkgnum' => $self->pkgnum,
+ 'feepart' => $reason->feepart,
+ 'nextbill' => $reason->fee_hold,
});
-
- $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+ $error ||= $cust_pkg_reason_fee->insert;
}
if ( $error ) {
=item unadjourn
-Cancels any pending suspension (sets the adjourn field to null).
+Cancels any pending suspension (sets the adjourn field to null)
+for this package and any supplemental packages.
If there is an error, returns the error, otherwise returns false.
=cut
sub unadjourn {
- my( $self, %options ) = @_;
+ my( $self ) = @_;
my $error;
local $SIG{HUP} = 'IGNORE';
return $error;
}
+ foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+ $error = $supp_pkg->unadjourn;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "unadjourning supplemental pkg#".$supp_pkg->pkgnum.": $error";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no errors
If unprotect_svcs is true, this method will transfer as many services as
it can and then unconditionally cancel the old package.
+=item contract_end
+
+If specified, sets this value for the contract_end date on the new package
+(without regard for keep_dates or the usual date-preservation behavior.)
+Will throw an error if defined but false; the UI doesn't allow editing
+this unless it already exists, making removal impossible to undo.
+
=back
At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or
=cut
+#used by change and change_later
+#didn't put with documented check methods because it depends on change-specific opts
+#and it also possibly edits the value of opts
+sub _check_change {
+ my $self = shift;
+ my $opt = shift;
+ if ( defined($opt->{'contract_end'}) ) {
+ my $current_contract_end = $self->get('contract_end');
+ unless ($opt->{'contract_end'}) {
+ if ($current_contract_end) {
+ return "Cannot remove contract end date when changing packages";
+ } else {
+ #shouldn't even pass this option if there's not a current value
+ #but can be handled gracefully if the option is empty
+ warn "Contract end date passed unexpectedly";
+ delete $opt->{'contract_end'};
+ return '';
+ }
+ }
+ unless ($current_contract_end) {
+ #option shouldn't be passed, throw error if it's non-empty
+ return "Cannot add contract end date when changing packages " . $self->pkgnum;
+ }
+ }
+ return '';
+}
+
#some false laziness w/order
sub change {
my $self = shift;
my $conf = new FS::Conf;
+ # handle contract_end on cust_pkg same as passed option
+ if ( $opt->{'cust_pkg'} ) {
+ $opt->{'contract_end'} = $opt->{'cust_pkg'}->contract_end;
+ delete $opt->{'contract_end'} unless $opt->{'contract_end'};
+ }
+
+ # check contract_end, prevent adding/removing
+ my $error = $self->_check_change($opt);
+ return $error if $error;
+
# Transactionize this whole mess
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $error;
+ if ( $opt->{'cust_location'} ) {
+ $error = $opt->{'cust_location'}->find_or_insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "creating location record: $error";
+ }
+ $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
+ }
+
+ # Before going any further here: if the package is still in the pre-setup
+ # state, it's safe to modify it in place. No need to charge/credit for
+ # partial period, transfer services, transfer usage pools, copy invoice
+ # details, or change any dates.
+ if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) {
+ foreach ( qw( locationnum pkgpart quantity refnum salesnum ) ) {
+ if ( length($opt->{$_}) ) {
+ $self->set($_, $opt->{$_});
+ }
+ }
+ # almost. if the new pkgpart specifies start/adjourn/expire timers,
+ # apply those.
+ if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
+ $self->set_initial_timers;
+ }
+ # but if contract_end was explicitly specified, that overrides all else
+ $self->set('contract_end', $opt->{'contract_end'})
+ if $opt->{'contract_end'};
+ $error = $self->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "modifying package: $error";
+ } else {
+ $dbh->commit if $oldAutoCommit;
+ return $self;
+ }
+ }
my %hash = ();
my $time = time;
- $hash{'setup'} = $time if $self->setup;
+ $hash{'setup'} = $time if $self->get('setup');
$hash{'change_date'} = $time;
$hash{"change_$_"} = $self->$_()
foreach qw( pkgnum pkgpart locationnum );
- if ( $opt->{'cust_location'} ) {
- $error = $opt->{'cust_location'}->find_or_insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "creating location record: $error";
- }
- $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
- }
-
if ( $opt->{'cust_pkg'} ) {
# treat changing to a package with a different pkgpart as a
# pkgpart change (because it is)
my $unused_credit = 0;
my $keep_dates = $opt->{'keep_dates'};
- # Special case. If the pkgpart is changing, and the customer is
- # going to be credited for remaining time, don't keep setup, bill,
- # or last_bill dates, and DO pass the flag to cancel() to credit
- # the customer.
+
+ # Special case. If the pkgpart is changing, and the customer is going to be
+ # credited for remaining time, don't keep setup, bill, or last_bill dates,
+ # and DO pass the flag to cancel() to credit the customer. If the old
+ # package had a setup date, set the new package's setup to the package
+ # change date so that it has the same status as before.
if ( $opt->{'pkgpart'}
and $opt->{'pkgpart'} != $self->pkgpart
and $self->part_pkg->option('unused_credit_change', 1) ) {
$unused_credit = 1;
$keep_dates = 0;
- $hash{$_} = '' foreach qw(setup bill last_bill);
+ $hash{'last_bill'} = '';
+ $hash{'bill'} = '';
}
if ( $keep_dates ) {
- foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
- resume start_date contract_end ) ) {
+ foreach my $date ( qw(setup bill last_bill) ) {
$hash{$date} = $self->getfield($date);
}
}
- # always keep this date, regardless of anything
- # (the date of the package change is in a different field)
- $hash{'order_date'} = $self->getfield('order_date');
+ # always keep the following dates
+ foreach my $date (qw(order_date susp adjourn cancel expire resume
+ start_date contract_end)) {
+ $hash{$date} = $self->getfield($date);
+ }
+ # but if contract_end was explicitly specified, that overrides all else
+ $hash{'contract_end'} = $opt->{'contract_end'}
+ if $opt->{'contract_end'};
# allow $opt->{'locationnum'} = '' to specifically set it to null
# (i.e. customer default location)
# 2. (more importantly) changing a package before it's billed
$hash{'waive_setup'} = $self->waive_setup;
+ # if this package is scheduled for a future package change, preserve that
+ $hash{'change_to_pkgnum'} = $self->change_to_pkgnum;
+
my $custnum = $self->custnum;
if ( $opt->{cust_main} ) {
my $cust_main = $opt->{cust_main};
# changed from this package.
$cust_pkg = $opt->{'cust_pkg'};
- foreach ( qw( pkgnum pkgpart locationnum ) ) {
- $cust_pkg->set("change_$_", $self->get($_));
+ # follow all the above rules for date changes, etc.
+ foreach (keys %hash) {
+ $cust_pkg->set($_, $hash{$_});
}
- $cust_pkg->set('change_date', $time);
+ # except those that implement the future package change behavior
+ foreach (qw(change_to_pkgnum start_date expire)) {
+ $cust_pkg->set($_, '');
+ }
+
$error = $cust_pkg->replace;
} else {
}
# Transfer services and cancel old package.
-
+ # Enforce service limits only if this is a pkgpart change.
+ local $FS::cust_svc::ignore_quantity;
+ $FS::cust_svc::ignore_quantity = 1 if $same_pkgpart;
$error = $self->transfer($cust_pkg);
if ($error and $error == 0) {
# $old_pkg->transfer failed.
unused_credit => $unused_credit,
nobill => $keep_dates,
change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
+ no_delay_cancel => 1,
);
if ($error) {
$dbh->rollback if $oldAutoCommit;
=item quantity
-The pkgpart. locationnum, and quantity of the new package, with the same
-meaning as in C<change>.
+=item contract_end
+
+The pkgpart, locationnum, quantity and optional contract_end of the new
+package, with the same meaning as in C<change>.
=back
my $self = shift;
my $opt = ref($_[0]) ? shift : { @_ };
+ # check contract_end, prevent adding/removing
+ my $error = $self->_check_change($opt);
+ return $error if $error;
+
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
return "start_date $date is in the past";
}
- my $error;
+ # If the user entered a new location, set it up now.
+ if ( $opt->{'cust_location'} ) {
+ $error = $opt->{'cust_location'}->find_or_insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "creating location record: $error";
+ }
+ $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
+ }
if ( $self->change_to_pkgnum ) {
my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum;
my $new_quantity = $opt->{'quantity'}
if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity;
- if ( $new_pkgpart or $new_locationnum or $new_quantity ) {
+ my $new_contract_end = $opt->{'contract_end'}
+ if $opt->{'contract_end'} and $opt->{'contract_end'} != $change_to->contract_end;
+ if ( $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end ) {
# it hasn't been billed yet, so in principle we could just edit
# it in place (w/o a package change), but that's bad form.
# So change the package according to the new options...
$error = $self->replace ||
$err_or_pkg->replace ||
- $change_to->cancel ||
- $change_to->delete;
+ #because change() might've edited existing scheduled change in place
+ (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' :
+ $change_to->cancel('no_delay_cancel' => 1) ||
+ $change_to->delete);
} else {
$error = $err_or_pkg;
}
if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum;
my $new_quantity = $opt->{'quantity'}
if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity;
+ my $new_contract_end = $opt->{'contract_end'}
+ if $opt->{'contract_end'} and $opt->{'contract_end'} != $self->contract_end;
- return '' unless $new_pkgpart or $new_locationnum or $new_quantity; # wouldn't do anything
+ return '' unless $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end; # wouldn't do anything
# allow $opt->{'locationnum'} = '' to specifically set it to null
# (i.e. customer default location)
locationnum => $opt->{'locationnum'},
start_date => $date,
map { $_ => ( $opt->{$_} || $self->$_() ) }
- qw( pkgpart quantity refnum salesnum )
+ qw( pkgpart quantity refnum salesnum contract_end )
} );
$error = $new->insert('change' => 1,
'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
- 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.
}
if ( !$self->get('setup') ) {
- # not yet billed, so allow amount and quantity
+ # 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{'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{'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?
$self->part_pkg->calc_recur($self, @_);
}
+=item base_setup
+
+Returns the base setup fee (per unit) of this package, from the package
+definition.
+
+=cut
+
+# minimal version for 3.x; in 4.x this can invoke currency conversion
+
+sub base_setup {
+ my $self = shift;
+ $self->part_pkg->unit_setup($self);
+}
+
=item base_recur
Calls the I<base_recur> of the FS::part_pkg object associated with this billing
}
my %search = (
- 'table' => 'cust_svc',
- 'hashref' => { 'pkgnum' => $self->pkgnum },
+ 'select' => 'cust_svc.*, part_svc.*',
+ 'table' => 'cust_svc',
+ 'hashref' => { 'pkgnum' => $self->pkgnum },
+ 'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
);
- if ( $opt{svcpart} ) {
- $search{hashref}->{svcpart} = $opt{'svcpart'};
- }
- if ( $opt{'svcdb'} ) {
- $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) ';
- $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} );
- }
+ $search{hashref}->{svcpart} = $opt{svcpart}
+ if $opt{svcpart};
+ $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{svcdb} )
+ if $opt{svcdb};
[ qsearch(\%search) ];
package but not yet provisioned. Each FS::part_svc object also has an extra
field, I<num_avail>, which specifies the number of available services.
+Accepts option I<provision_hold>; if true, only returns part_svc for which the
+associated pkg_svc has the provision_hold flag set.
+
=cut
sub available_part_svc {
my $self = shift;
+ my %opt = @_;
my $pkg_quantity = $self->quantity || 1;
grep { $_->num_avail > 0 }
- map {
- my $part_svc = $_->part_svc;
- $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
- $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
-
- # more evil encapsulation breakage
- if($part_svc->{'Hash'}{'num_avail'} > 0) {
- my @exports = $part_svc->part_export_did;
- $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
- }
-
- $part_svc;
- }
- $self->part_pkg->pkg_svc;
+ map {
+ my $part_svc = $_->part_svc;
+ $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
+ $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
+
+ # more evil encapsulation breakage
+ if ($part_svc->{'Hash'}{'num_avail'} > 0) {
+ my @exports = $part_svc->part_export_did;
+ $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
+ }
+
+ $part_svc;
+ }
+ grep { $opt{'provision_hold'} ? $_->provision_hold : 1 }
+ $self->part_pkg->pkg_svc;
}
=item part_svc [ OPTION => VALUE ... ]
=cut
tie my %statuscolor, 'Tie::IxHash',
- 'on hold' => '7E0079', #purple!
+ 'on hold' => 'FF00F5', #brighter purple!
'not yet billed' => '009999', #teal? cyan?
'one-time charge' => '0000CC', #blue #'000000',
'active' => '00CC00',
$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 } );
}
$reasonnum = $reason->reasonnum;
} else {
- return "Unparsable reason: ". $options{'reason'};
+ return "Unparseable reason: ". $options{'reason'};
}
my $cust_pkg_reason =
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 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, "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
"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});
$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;
+ }
+ }
+
+ 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
+ )";
}
}
}
##
+ # 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
##
=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;
+ }
}
=back
projects / freeside.git / blobdiff