package FS::cust_pkg;
+use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin
+ FS::contact_Mixin FS::location_Mixin
+ FS::m2m_Common FS::option_Common );
use strict;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin
- FS::m2m_Common FS::option_Common );
use vars qw($disable_agentcheck $DEBUG $me);
use Carp qw(cluck);
use Scalar::Util qw( blessed );
-use List::Util qw(max);
+use List::Util qw(min max);
use Tie::IxHash;
use Time::Local qw( timelocal timelocal_nocheck );
use MIME::Entity;
-use FS::UID qw( getotaker dbh );
+use FS::UID qw( dbh driver_name );
use FS::Misc qw( send_email );
-use FS::Record qw( qsearch qsearchs );
+use FS::Record qw( qsearch qsearchs fields );
use FS::CurrentUser;
use FS::cust_svc;
use FS::part_pkg;
use FS::cust_main;
+use FS::contact;
use FS::cust_location;
use FS::pkg_svc;
use FS::cust_bill_pkg;
use FS::cust_pkg_detail;
+use FS::cust_pkg_usage;
+use FS::cdr_cust_pkg_usage;
use FS::cust_event;
use FS::h_cust_svc;
use FS::reg_code;
use FS::cust_pkg_discount;
use FS::discount;
use FS::UI::Web;
-use Data::Dumper;
+use FS::sales;
# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
# setup }
=item waive_setup
+=item main_pkgnum
+
+The pkgnum of the package that this package is supplemental to, if any.
+
+=item pkglinknum
+
+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
=cut
sub table { 'cust_pkg'; }
-sub cust_linked { $_[0]->cust_main_custnum; }
+sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum }
sub cust_unlinked_msg {
my $self = shift;
"WARNING: can't find cust_main.custnum ". $self->custnum.
=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.)
=item options
an optional queue name for ticket additions
+=item allow_pkgpart
+
+Don't check the legality of the package definition. This should be used
+when performing a package change that doesn't change the pkgpart (i.e.
+a location change).
+
=back
=cut
sub insert {
my( $self, %options ) = @_;
- my $error = $self->check_pkgpart;
+ my $error;
+ $error = $self->check_pkgpart unless $options{'allow_pkgpart'};
return $error if $error;
my $part_pkg = $self->part_pkg;
+ # 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;
$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 $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 this package has "free days" and delayed setup fee, tehn
+ # set start date that many days in the future.
+ # (this should have been set in the UI, but enforce it here)
+ if ( ! $options{'change'}
+ && ( my $free_days = $part_pkg->option('free_days',1) )
+ && $part_pkg->option('delay_setup',1)
+ #&& ! $self->start_date
+ )
+ {
+ $self->start_date( $part_pkg->default_start_date );
}
$self->order_date(time);
}
}
- #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 ( $conf->config('ticket_system') && $options{ticket_subject} ) {
+ #this init stuff is still inefficient, but at least its limited to
+ # the small number (any?) folks using ticket emailing on pkg order
+
#eval '
# use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
# use RT;
}
- 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;
sub check {
my $self = shift;
- $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
+ if ( !$self->locationnum or $self->locationnum == -1 ) {
+ $self->set('locationnum', $self->cust_main->ship_locationnum);
+ }
my $error =
$self->ut_numbern('pkgnum')
|| $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
|| $self->ut_numbern('pkgpart')
- || $self->check_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('susp')
|| $self->ut_numbern('cancel')
|| $self->ut_numbern('adjourn')
+ || $self->ut_numbern('resume')
|| $self->ut_numbern('expire')
|| $self->ut_numbern('dundate')
|| $self->ut_enum('no_auto', [ '', 'Y' ])
|| $self->ut_numbern('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;
+ 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;
+
$self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
if ( $self->dbdef_table->column('manual_flag') ) {
=item check_pkgpart
+Check the pkgpart to make sure it's allowed with the reg_code and/or
+promo_code of the package (if present) and with the customer's agent.
+Called from C<insert>, unless we are doing a package change that doesn't
+affect pkgpart.
+
=cut
sub check_pkgpart {
my $self = shift;
- my $error = $self->ut_numbern('pkgpart');
- return $error if $error;
+ # my $error = $self->ut_numbern('pkgpart'); # already done
+ my $error;
if ( $self->reg_code ) {
unless ( grep { $self->pkgpart == $_->pkgpart }
my( $self, %options ) = @_;
my $error;
+ # pass all suspend/cancel actions to the main package
+ if ( $self->main_pkgnum and !$options{'from_main'} ) {
+ return $self->main_pkg->cancel(%options);
+ }
+
my $conf = new FS::Conf;
warn "cust_pkg::cancel called with options".
$do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
}
if ( $do_credit ) {
- my $error = $self->credit_remaining($cancel_time);
+ my $error = $self->credit_remaining('cancel', $cancel_time);
if ($error) {
$dbh->rollback if $oldAutoCommit;
return $error;
} #unless $date
my %hash = $self->hash;
- $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
+ if ( $date ) {
+ $hash{'expire'} = $date;
+ } else {
+ $hash{'cancel'} = $cancel_time;
+ }
+ $hash{'change_custnum'} = $options{'change_custnum'};
+
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;
+ }
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
+ foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+ $error = $supp_pkg->cancel(%options, 'from_main' => 1);
+ 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";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return '' if $date; #no errors
'';
}
+=item uncancel
+
+"Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
+locationnum, (other fields?). Attempts to re-provision cancelled services
+using history information (errors at this stage are not fatal).
+
+cust_pkg: pass a scalar reference, will be filled in with the new cust_pkg object
+
+svc_fatal: service provisioning errors are fatal
+
+svc_errors: pass an array reference, will be filled in with any provisioning errors
+
+main_pkgnum: link the package as a supplemental package of this one. For
+internal use only.
+
+=cut
+
+sub uncancel {
+ my( $self, %options ) = @_;
+
+ #in case you try do do $uncancel-date = $cust_pkg->uncacel
+ return '' unless $self->get('cancel');
+
+ if ( $self->main_pkgnum and !$options{'main_pkgnum'} ) {
+ return $self->main_pkg->uncancel(%options);
+ }
+
+ ##
+ # Transaction-alize
+ ##
+
+ 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;
+
+ ##
+ # insert the new package
+ ##
+
+ my $cust_pkg = new FS::cust_pkg {
+ last_bill => ( $options{'last_bill'} || $self->get('last_bill') ),
+ bill => ( $options{'bill'} || $self->get('bill') ),
+ uncancel => time,
+ uncancel_pkgnum => $self->pkgnum,
+ main_pkgnum => ($options{'main_pkgnum'} || ''),
+ map { $_ => $self->get($_) } qw(
+ custnum pkgpart locationnum
+ 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
+ ),
+ };
+
+ my $error = $cust_pkg->insert(
+ 'change' => 1, #supresses any referral credit to a referring customer
+ 'allow_pkgpart' => 1, # allow this even if the package def is disabled
+ );
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ ##
+ # 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) ] );
+ }
+
+ my $svc_error = $svc_x->insert;
+ if ( $svc_error ) {
+ if ( $options{svc_fatal} ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $svc_error;
+ } else {
+ # if we've failed to insert the svc_x object, svc_Common->insert
+ # will have removed the cust_svc already. if not, then both records
+ # were inserted but we failed for some other reason (export, most
+ # likely). in that case, report the error and delete the records.
+ push @svc_errors, $svc_error;
+ my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum });
+ if ( $cust_svc ) {
+ # except if export_insert failed, export_delete probably won't be
+ # much better
+ local $FS::svc_Common::noexport_hack = 1;
+ my $cleanup_error = $svc_x->delete; # also deletes cust_svc
+ if ( $cleanup_error ) { # and if THAT fails, then run away
+ $dbh->rollback if $oldAutoCommit;
+ return $cleanup_error;
+ }
+ }
+ } # 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)
+
+ ##
+ # also move over any services that didn't unprovision at cancellation
+ ##
+
+ foreach my $cust_svc ( qsearch('cust_svc', { pkgnum => $self->pkgnum } ) ) {
+ $cust_svc->pkgnum( $cust_pkg->pkgnum );
+ my $error = $cust_svc->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ ##
+ # Uncancel any supplemental packages, and make them supplemental to the
+ # new one.
+ ##
+
+ foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+ my $new_pkg;
+ $error = $supp_pkg->uncancel(%options, 'main_pkgnum' => $cust_pkg->pkgnum);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
+ }
+ }
+
+ ##
+ # Finish
+ ##
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ${ $options{cust_pkg} } = $cust_pkg if ref($options{cust_pkg});
+ @{ $options{svc_errors} } = @svc_errors if ref($options{svc_errors});
+
+ '';
+}
+
=item unexpire
Cancels any pending expiration (sets the expire field to null).
=over 4
-=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.
+=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.
+
+=item date - can be set to a unix style timestamp to specify when to
+suspend (adjourn)
+
+=item time - can be set to override the current time, for calculation
+of final invoices or unused-time credits
-=item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
+=item resume_date - can be set to a time when the package should be
+unsuspended. This may be more convenient than calling C<unsuspend()>
+separately.
+
+=item from_main - allows a supplemental package to be suspended, rather
+than redirecting the method call to its main package. For internal use.
=back
my( $self, %options ) = @_;
my $error;
+ # pass all suspend/cancel actions to the main package
+ if ( $self->main_pkgnum and !$options{'from_main'} ) {
+ return $self->main_pkg->suspend(%options);
+ }
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
my $suspend_time = $options{'time'} || time;
my $date = $options{date} if $options{date}; # adjourn/suspend later
- $date = '' if ($date && $date <= time); # complain instead?
+ $date = '' if ($date && $date <= $suspend_time); # complain instead?
if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
dbh->rollback if $oldAutoCommit;
} else {
$hash{'susp'} = $suspend_time;
}
+
+ my $resume_date = $options{'resume_date'} || 0;
+ if ( $resume_date > ($date || $suspend_time) ) {
+ $hash{'resume'} = $resume_date;
+ }
+
+ $options{options} ||= {};
+
my $new = new FS::cust_pkg ( \%hash );
- $error = $new->replace( $self, options => { $self->options } );
+ $error = $new->replace( $self, options => { $self->options,
+ %{ $options{options} },
+ }
+ );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
unless ( $date ) {
# credit remaining time if appropriate
if ( $self->part_pkg->option('unused_credit_suspend', 1) ) {
- my $error = $self->credit_remaining($suspend_time);
+ my $error = $self->credit_remaining('suspend', $suspend_time);
if ($error) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
+ foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+ $error = $supp_pkg->suspend(%options, 'from_main' => 1);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "suspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no errors
}
+=item credit_remaining MODE TIME
+
+Generate a credit for this package for the time remaining in the current
+billing period. MODE is either "suspend" or "cancel" (determines the
+credit type). TIME is the time of suspension/cancellation. Both arguments
+are mandatory.
+
+=cut
+
sub credit_remaining {
# Add a credit for remaining service
- my $self = shift;
- my $time = shift or die 'no suspend/cancel time';
+ my ($self, $mode, $time) = @_;
+ die 'credit_remaining requires suspend or cancel'
+ unless $mode eq 'suspend' or $mode eq 'cancel';
+ die 'no suspend/cancel time' unless $time > 0;
+
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
my $error = $self->cust_main->credit(
$remaining_value,
'Credit for unused time on '. $self->part_pkg->pkg,
- 'reason_type' => $conf->config('cancel_credit_type'),
- ); # need 'suspend_credit_type'?
+ 'reason_type' => $reason_type,
+ );
return "Error crediting customer \$$remaining_value for unused time".
" on ". $self->part_pkg->pkg. ": $error"
if $error;
Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
package, then unsuspends the package itself (clears the susp field and the
-adjourn field if it is in the past).
+adjourn field if it is in the past). If the suspend reason includes an
+unsuspension package, that package will be ordered.
Available options are:
=over 4
+=item date
+
+Can be set to a date to unsuspend the package in the future (the 'resume'
+field).
+
=item adjust_next_bill
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
my( $self, %opt ) = @_;
my $error;
+ # pass all suspend/cancel actions to the main package
+ if ( $self->main_pkgnum and !$opt{'from_main'} ) {
+ return $self->main_pkg->unsuspend(%opt);
+ }
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
my $pkgnum = $old->pkgnum;
if ( $old->get('cancel') || $self->get('cancel') ) {
- dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit;
return "Can't unsuspend cancelled package $pkgnum";
}
unless ( $old->get('susp') && $self->get('susp') ) {
- dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit;
return ""; # no error # complain instead?
}
+ my $date = $opt{'date'};
+ if ( $date and $date > time ) { # return an error if $date <= time?
+
+ if ( $old->get('expire') && $old->get('expire') < $date ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Package $pkgnum expires before it would be unsuspended.";
+ }
+
+ my $new = new FS::cust_pkg { $self->hash };
+ $new->set('resume', $date);
+ $error = $new->replace($self, options => $self->options);
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ else {
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+ }
+
+ } #if $date
+
+ my @labels = ();
+
foreach my $cust_svc (
qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
+ my( $label, $value ) = $cust_svc->label;
+ push @labels, "$label: $value";
}
}
+ my $cust_pkg_reason = $self->last_cust_pkg_reason('susp');
+ my $reason = $cust_pkg_reason ? $cust_pkg_reason->reason : '';
+
my %hash = $self->hash;
my $inactive = time - $hash{'susp'};
}
$hash{'susp'} = '';
- $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
+ $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
+ $hash{'resume'} = '' if !$hash{'adjourn'};
my $new = new FS::cust_pkg ( \%hash );
$error = $new->replace( $self, options => { $self->options } );
if ( $error ) {
return $error;
}
+ my $unsusp_pkg;
+
+ if ( $reason && $reason->unsuspend_pkgpart ) {
+ my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
+ or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
+ " not found.";
+ my $start_date = $self->cust_main->next_bill_date
+ if $reason->unsuspend_hold;
+
+ if ( $part_pkg ) {
+ $unsusp_pkg = FS::cust_pkg->new({
+ 'custnum' => $self->custnum,
+ 'pkgpart' => $reason->unsuspend_pkgpart,
+ 'start_date' => $start_date,
+ 'locationnum' => $self->locationnum,
+ # discount? probably not...
+ });
+
+ $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ if ( $conf->config('unsuspend_email_admin') ) {
+
+ my $error = send_email(
+ 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
+ #invoice_from ??? well as good as any
+ 'to' => $conf->config('unsuspend_email_admin'),
+ 'subject' => 'FREESIDE NOTIFICATION: Customer package unsuspended', 'body' => [
+ "This is an automatic message from your Freeside installation\n",
+ "informing you that the following customer package has been unsuspended:\n",
+ "\n",
+ 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
+ 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
+ ( map { "Service : $_\n" } @labels ),
+ ($unsusp_pkg ?
+ "An unsuspension fee was charged: ".
+ $unsusp_pkg->part_pkg->pkg_comment."\n"
+ : ''
+ ),
+ ],
+ );
+
+ if ( $error ) {
+ warn "WARNING: can't send unsuspension admin email (unsuspending anyway): ".
+ "$error\n";
+ }
+
+ }
+
+ foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+ $error = $supp_pkg->unsuspend(%opt, 'from_main' => 1);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "unsuspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no errors
my %hash = $self->hash;
$hash{'adjourn'} = '';
+ $hash{'resume'} = '';
my $new = new FS::cust_pkg ( \%hash );
$error = $new->replace( $self, options => { $self->options } );
if ( $error ) {
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.
+
=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.
my $self = shift;
my $opt = ref($_[0]) ? shift : { @_ };
-# my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
-#
-
my $conf = new FS::Conf;
# Transactionize this whole mess
my $time = time;
- #$hash{$_} = $self->$_() foreach qw( last_bill bill );
-
- #$hash{$_} = $self->$_() foreach qw( setup );
-
$hash{'setup'} = $time if $self->setup;
$hash{'change_date'} = $time;
$hash{"change_$_"} = $self->$_()
foreach qw( pkgnum pkgpart locationnum );
- if ( $opt->{'cust_location'} &&
- ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
- $error = $opt->{'cust_location'}->insert;
+ if ( $opt->{'cust_location'} ) {
+ $error = $opt->{'cust_location'}->find_or_insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "inserting cust_location (transaction rolled back): $error";
$opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
}
+ if ( $opt->{'cust_pkg'} ) {
+ # treat changing to a package with a different pkgpart as a
+ # pkgpart change (because it is)
+ $opt->{'pkgpart'} = $opt->{'cust_pkg'}->pkgpart;
+ }
+
+ # whether to override pkgpart checking on the new package
+ my $same_pkgpart = 1;
+ if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) {
+ $same_pkgpart = 0;
+ }
+
my $unused_credit = 0;
my $keep_dates = $opt->{'keep_dates'};
# Special case. If the pkgpart is changing, and the customer is
# going to be credited for remaining time, don't keep setup, bill,
# or last_bill dates, and DO pass the flag to cancel() to credit
# the customer.
- if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
+ if ( $opt->{'pkgpart'}
+ and $opt->{'pkgpart'} != $self->pkgpart
+ and $self->part_pkg->option('unused_credit_change', 1) ) {
+ $unused_credit = 1;
$keep_dates = 0;
- $unused_credit = 1 if $self->part_pkg->option('unused_credit_change', 1);
$hash{$_} = '' foreach qw(setup bill last_bill);
}
if ( $keep_dates ) {
foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
- start_date contract_end ) ) {
+ resume start_date contract_end ) ) {
$hash{$date} = $self->getfield($date);
}
}
+
# allow $opt->{'locationnum'} = '' to specifically set it to null
# (i.e. customer default location)
$opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
- # 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,
- };
+ # usually this doesn't matter. the two cases where it does are:
+ # 1. unused_credit_change + pkgpart change + setup fee on the new package
+ # and
+ # 2. (more importantly) changing a package before it's billed
+ $hash{'waive_setup'} = $self->waive_setup;
+
+ my $custnum = $self->custnum;
+ if ( $opt->{cust_main} ) {
+ my $cust_main = $opt->{cust_main};
+ unless ( $cust_main->custnum ) {
+ my $error = $cust_main->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "inserting cust_main (transaction rolled back): $error";
+ }
+ }
+ $custnum = $cust_main->custnum;
+ }
+
+ $hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'};
+
+ my $cust_pkg;
+ if ( $opt->{'cust_pkg'} ) {
+ # The target package already exists; update it to show that it was
+ # changed from this package.
+ $cust_pkg = $opt->{'cust_pkg'};
+
+ foreach ( qw( pkgnum pkgpart locationnum ) ) {
+ $cust_pkg->set("change_$_", $self->get($_));
+ }
+ $cust_pkg->set('change_date', $time);
+ $error = $cust_pkg->replace;
- $error = $cust_pkg->insert( 'change' => 1 );
+ } 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;
}
}
- 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;
$dbh->rollback if $oldAutoCommit;
return "Error setting usage values: $error";
}
+ } else {
+ # if NOT changing pkgpart, transfer any usage pools over
+ foreach my $usage ($self->cust_pkg_usage) {
+ $usage->set('pkgnum', $cust_pkg->pkgnum);
+ $error = $usage->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error transferring usage pools: $error";
+ }
+ }
+ }
+
+ # transfer discounts, if we're not changing pkgpart
+ if ( $same_pkgpart ) {
+ foreach my $old_discount ($self->cust_pkg_discount_active) {
+ # don't remove the old discount, we may still need to bill that package.
+ my $new_discount = new FS::cust_pkg_discount {
+ 'pkgnum' => $cust_pkg->pkgnum,
+ 'discountnum' => $old_discount->discountnum,
+ 'months_used' => $old_discount->months_used,
+ };
+ $error = $new_discount->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error transferring discounts: $error";
+ }
+ }
}
+ # transfer (copy) invoice details
+ foreach my $detail ($self->cust_pkg_detail) {
+ my $new_detail = FS::cust_pkg_detail->new({ $detail->hash });
+ $new_detail->set('pkgdetailnum', '');
+ $new_detail->set('pkgnum', $cust_pkg->pkgnum);
+ $error = $new_detail->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error transferring package notes: $error";
+ }
+ }
+
+ my @new_supp_pkgs;
+
+ if ( !$opt->{'cust_pkg'} ) {
+ # Order any supplemental packages.
+ my $part_pkg = $cust_pkg->part_pkg;
+ my @old_supp_pkgs = $self->supplemental_pkgs;
+ foreach my $link ($part_pkg->supp_part_pkg_link) {
+ my $old;
+ foreach (@old_supp_pkgs) {
+ if ($_->pkgpart == $link->dst_pkgpart) {
+ $old = $_;
+ $_->pkgpart(0); # so that it can't match more than once
+ }
+ last if $old;
+ }
+ # false laziness with FS::cust_main::Packages::order_pkg
+ my $new = FS::cust_pkg->new({
+ pkgpart => $link->dst_pkgpart,
+ pkglinknum => $link->pkglinknum,
+ custnum => $custnum,
+ main_pkgnum => $cust_pkg->pkgnum,
+ locationnum => $cust_pkg->locationnum,
+ start_date => $cust_pkg->start_date,
+ order_date => $cust_pkg->order_date,
+ expire => $cust_pkg->expire,
+ adjourn => $cust_pkg->adjourn,
+ contract_end => $cust_pkg->contract_end,
+ refnum => $cust_pkg->refnum,
+ discountnum => $cust_pkg->discountnum,
+ waive_setup => $cust_pkg->waive_setup,
+ });
+ if ( $old and $opt->{'keep_dates'} ) {
+ foreach (qw(setup bill last_bill)) {
+ $new->set($_, $old->get($_));
+ }
+ }
+ $error = $new->insert( allow_pkgpart => $same_pkgpart );
+ # transfer services
+ if ( $old ) {
+ $error ||= $old->transfer($new);
+ }
+ if ( $error and $error > 0 ) {
+ # no reason why this should ever fail, but still...
+ $error = "Unable to transfer all services from supplemental package ".
+ $old->pkgnum;
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ push @new_supp_pkgs, $new;
+ }
+ } # if !$opt->{'cust_pkg'}
+ # because if there is one, then supplemental packages would already
+ # have been created for it.
+
#Good to go, cancel old package. Notify 'cancel' of whether to credit
#remaining time.
#Don't allow billing the package (preceding period packages and/or
#outstanding usage) if we are keeping dates (i.e. location changing),
#because the new package will be billed for the same date range.
+ #Supplemental packages are also canceled here.
+
+ # during scheduled changes, avoid canceling the package we just
+ # changed to (duh)
+ $self->set('change_to_pkgnum' => '');
+
$error = $self->cancel(
- quiet => 1,
- unused_credit => $unused_credit,
- nobill => $keep_dates
+ quiet => 1,
+ unused_credit => $unused_credit,
+ nobill => $keep_dates,
+ change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
);
if ($error) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
- if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
- #$self->cust_main
- my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
+ if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
+ #$self->cust_main
+ my $error = $cust_pkg->cust_main->bill(
+ 'pkg_list' => [ $cust_pkg, @new_supp_pkgs ]
+ );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ $cust_pkg;
+
+}
+
+=item change_later OPTION => VALUE...
+
+Schedule a package change for a later date. This actually orders the new
+package immediately, but sets its start date for a future date, and sets
+the current package to expire on the same date.
+
+If the package is already scheduled for a change, this can be called with
+'start_date' to change the scheduled date, or with pkgpart and/or
+locationnum to modify the package change. To cancel the scheduled change
+entirely, see C<abort_change>.
+
+Options include:
+
+=over 4
+
+=item start_date
+
+The date for the package change. Required, and must be in the future.
+
+=item pkgpart
+
+=item locationnum
+
+=item quantity
+
+The pkgpart. locationnum, and quantity of the new package, with the same
+meaning as in C<change>.
+
+=back
+
+=cut
+
+sub change_later {
+ my $self = shift;
+ my $opt = ref($_[0]) ? shift : { @_ };
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $cust_main = $self->cust_main;
+
+ my $date = delete $opt->{'start_date'} or return 'start_date required';
+
+ if ( $date <= time ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "start_date $date is in the past";
+ }
+
+ my $error;
+
+ if ( $self->change_to_pkgnum ) {
+ my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
+ my $new_pkgpart = $opt->{'pkgpart'}
+ if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $change_to->pkgpart;
+ my $new_locationnum = $opt->{'locationnum'}
+ if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum;
+ my $new_quantity = $opt->{'quantity'}
+ if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity;
+ if ( $new_pkgpart or $new_locationnum or $new_quantity ) {
+ # it hasn't been billed yet, so in principle we could just edit
+ # it in place (w/o a package change), but that's bad form.
+ # So change the package according to the new options...
+ my $err_or_pkg = $change_to->change(%$opt);
+ if ( ref $err_or_pkg ) {
+ # Then set that package up for a future start.
+ $self->set('change_to_pkgnum', $err_or_pkg->pkgnum);
+ $self->set('expire', $date); # in case it's different
+ $err_or_pkg->set('start_date', $date);
+ $err_or_pkg->set('change_date', '');
+ $err_or_pkg->set('change_pkgnum', '');
+
+ $error = $self->replace ||
+ $err_or_pkg->replace ||
+ $change_to->cancel ||
+ $change_to->delete;
+ } else {
+ $error = $err_or_pkg;
+ }
+ } else { # change the start date only.
+ $self->set('expire', $date);
+ $change_to->set('start_date', $date);
+ $error = $self->replace || $change_to->replace;
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ } else {
+ $dbh->commit if $oldAutoCommit;
+ return '';
+ }
+ } # if $self->change_to_pkgnum
+
+ my $new_pkgpart = $opt->{'pkgpart'}
+ if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart;
+ my $new_locationnum = $opt->{'locationnum'}
+ if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum;
+ my $new_quantity = $opt->{'quantity'}
+ if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity;
+
+ return '' unless $new_pkgpart or $new_locationnum or $new_quantity; # wouldn't do anything
+
+ # allow $opt->{'locationnum'} = '' to specifically set it to null
+ # (i.e. customer default location)
+ $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
+
+ my $new = FS::cust_pkg->new( {
+ custnum => $self->custnum,
+ locationnum => $opt->{'locationnum'},
+ start_date => $date,
+ map { $_ => ( $opt->{$_} || $self->$_() ) }
+ qw( pkgpart quantity refnum salesnum )
+ } );
+ $error = $new->insert('change' => 1,
+ 'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
+ if ( !$error ) {
+ $self->set('change_to_pkgnum', $new->pkgnum);
+ $self->set('expire', $date);
+ $error = $self->replace;
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ } else {
+ $dbh->commit if $oldAutoCommit;
+ }
+
+ $error;
+}
+
+=item abort_change
+
+Cancels a future package change scheduled by C<change_later>.
+
+=cut
+
+sub abort_change {
+ my $self = shift;
+ my $pkgnum = $self->change_to_pkgnum;
+ my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum;
+ my $error;
+ if ( $change_to ) {
+ $error = $change_to->cancel || $change_to->delete;
+ return $error if $error;
+ }
+ $self->set('change_to_pkgnum', '');
+ $self->set('expire', '');
+ $self->replace;
+}
+
+=item set_quantity QUANTITY
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+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.
- $cust_pkg;
+=cut
+
+sub set_quantity {
+ my $self = shift;
+ $self = $self->replace_old; # just to make sure
+ $self->quantity(shift);
+ $self->replace;
+}
+=item set_salesnum SALESNUM
+
+Change the package's salesnum (sales person) field. This is one of the few
+package properties that can safely be changed without canceling and reordering
+the package (because it doesn't affect tax eligibility). Returns an error or
+an empty string.
+
+=cut
+
+sub set_salesnum {
+ my $self = shift;
+ $self = $self->replace_old; # just to make sure
+ $self->salesnum(shift);
+ $self->replace;
}
use Storable 'thaw';
use MIME::Base64;
+use Data::Dumper;
sub process_bulk_cust_pkg {
my $job = shift;
my $param = thaw(decode_base64(shift));
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
+
+Calls the I<base_setup> of the FS::part_pkg object associated with this billing
+item.
+
+=cut
+
+sub base_setup {
+ my $self = shift;
+ $self->part_pkg->base_setup($self, @_);
+}
+
=item base_recur
Calls the I<base_recur> of the FS::part_pkg object associated with this billing
$sth->fetchrow_arrayref->[0];
}
+=item part_pkg_currency_option OPTIONNAME
+
+Returns a two item list consisting of the currency of this customer, if any,
+and a value for the provided option. If the customer has a currency, the value
+is the option value the given name and the currency (see
+L<FS::part_pkg_currency>). Otherwise, if the customer has no currency, is the
+regular option value for the given name (see L<FS::part_pkg_option>).
+
+=cut
+
+sub part_pkg_currency_option {
+ my( $self, $optionname ) = @_;
+ my $part_pkg = $self->part_pkg;
+ if ( my $currency = $self->cust_main->currency ) {
+ ($currency, $part_pkg->part_pkg_currency_option($currency, $optionname) );
+ } else {
+ ('', $part_pkg->option($optionname) );
+ }
+}
+
=item cust_svc [ SVCPART ] (old, deprecated usage)
=item cust_svc [ OPTION => VALUE ... ] (current usage)
+=item cust_svc_unsorted [ OPTION => VALUE ... ]
+
Returns the services for this package, as FS::cust_svc objects (see
L<FS::cust_svc>). Available options are svcpart and svcdb. If either is
spcififed, returns only the matching services.
+As an optimization, use the cust_svc_unsorted version if you are not displaying
+the results.
+
=cut
sub cust_svc {
my $self = shift;
+ cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
+ $self->_sort_cust_svc( $self->cust_svc_unsorted_arrayref );
+}
+
+sub cust_svc_unsorted {
+ my $self = shift;
+ @{ $self->cust_svc_unsorted_arrayref };
+}
+
+sub cust_svc_unsorted_arrayref {
+ my $self = shift;
return () unless $self->num_cust_svc(@_);
}
if ( $opt{'svcdb'} ) {
$search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) ';
- $search{hashref}->{svcdb} = $opt{'svcdb'};
+ $search{extra_sql} = ' AND svcdb = '. dbh->quote( $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,
sub available_part_svc {
my $self = shift;
+
+ my $pkg_quantity = $self->quantity || 1;
+
grep { $_->num_avail > 0 }
map {
my $part_svc = $_->part_svc;
$part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
- $_->quantity - $self->num_cust_svc($_->svcpart);
+ $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
# more evil encapsulation breakage
if($part_svc->{'Hash'}{'num_avail'} > 0) {
my $self = shift;
my %opt = @_;
+ my $pkg_quantity = $self->quantity || 1;
+
#XXX some sort of sort order besides numeric by svcpart...
my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
my $pkg_svc = $_;
my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
$part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
$part_svc->{'Hash'}{'num_avail'} =
- max( 0, $pkg_svc->quantity - $num_cust_svc );
+ max( 0, $pkg_quantity * $pkg_svc->quantity - $num_cust_svc );
$part_svc->{'Hash'}{'cust_pkg_svc'} =
$num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
=item pkg_label
Returns a label for this package. (Currently "pkgnum: pkg - comment" or
-"pkg-comment" depending on user preference).
+"pkg - comment" depending on user preference).
=cut
$label;
}
+=item pkg_locale
+
+Returns a customer-localized label for this package.
+
+=cut
+
+sub pkg_locale {
+ my $self = shift;
+ $self->part_pkg->pkg_locale( $self->cust_main->locale );
+}
+
=item primary_cust_svc
Returns a primary service (as FS::cust_svc object) if one can be identified.
qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
}
+=item balance
+
+Returns the balance for this specific package, when using
+experimental package balance.
+
+=cut
+
+sub balance {
+ my $self = shift;
+ $self->cust_main->balance_pkgnum( $self->pkgnum );
+}
+
#these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
=item cust_location
#end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
+=item tax_locationnum
+
+Returns the foreign key to a L<FS::cust_location> object for calculating
+tax on this package, as determined by the C<tax-pkg_address> and
+C<tax-ship_address> configuration flags.
+
+=cut
+
+sub tax_locationnum {
+ my $self = shift;
+ my $conf = FS::Conf->new;
+ if ( $conf->exists('tax-pkg_address') ) {
+ return $self->locationnum;
+ }
+ elsif ( $conf->exists('tax-ship_address') ) {
+ return $self->cust_main->ship_locationnum;
+ }
+ else {
+ return $self->cust_main->bill_locationnum;
+ }
+}
+
+=item tax_location
+
+Returns the L<FS::cust_location> object for tax_locationnum.
+
+=cut
+
+sub tax_location {
+ my $self = shift;
+ FS::cust_location->by_key( $self->tax_locationnum )
+}
+
=item seconds_since TIMESTAMP
Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
grep {
my $part_svc = $_->part_svc;
$part_svc->svcdb eq 'svc_acct'
- && scalar($part_svc->part_export('sqlradius'));
+ && scalar($part_svc->part_export_usage);
} $self->cust_svc
) {
$seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
grep {
my $part_svc = $_->part_svc;
$part_svc->svcdb eq 'svc_acct'
- && scalar($part_svc->part_export('sqlradius'));
+ && scalar($part_svc->part_export_usage);
} $self->cust_svc
) {
$sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
}
foreach my $cust_svc ($self->cust_svc) {
- if($target{$cust_svc->svcpart} > 0) {
+ if($target{$cust_svc->svcpart} > 0
+ or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
$target{$cust_svc->svcpart}--;
my $new = new FS::cust_svc { $cust_svc->hash };
$new->pkgnum($dest_pkgnum);
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;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
=item reexport
This method is deprecated. See the I<depend_jobnum> option to the insert and
=cut
+#looks like this is still used by the order_pkg and change_pkg methods in
+# ClientAPI/MyAccount, need to look into those before removing
sub reexport {
my $self = shift;
}
+=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
grep { $_->status eq 'active' } $self->cust_pkg_discount;
}
+=item cust_pkg_usage
+
+Returns a list of all voice usage counters attached to this package.
+
+=cut
+
+sub cust_pkg_usage {
+ my $self = shift;
+ qsearch('cust_pkg_usage', { pkgnum => $self->pkgnum });
+}
+
+=item apply_usage OPTIONS
+
+Takes the following options:
+- cdr: a call detail record (L<FS::cdr>)
+- rate_detail: the rate determined for this call (L<FS::rate_detail>)
+- minutes: the maximum number of minutes to be charged
+
+Finds available usage minutes for a call of this class, and subtracts
+up to that many minutes from the usage pool. If the usage pool is empty,
+and the C<cdr-minutes_priority> global config option is set, minutes may
+be taken from other calls as well. Either way, an allocation record will
+be created (L<FS::cdr_cust_pkg_usage>) and this method will return the
+number of minutes of usage applied to the call.
+
+=cut
+
+sub apply_usage {
+ my ($self, %opt) = @_;
+ my $cdr = $opt{cdr};
+ my $rate_detail = $opt{rate_detail};
+ my $minutes = $opt{minutes};
+ my $classnum = $rate_detail->classnum;
+ my $pkgnum = $self->pkgnum;
+ my $custnum = $self->custnum;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+ my $order = FS::Conf->new->config('cdr-minutes_priority');
+
+ my $is_classnum;
+ if ( $classnum ) {
+ $is_classnum = ' part_pkg_usage_class.classnum = '.$classnum;
+ } else {
+ $is_classnum = ' part_pkg_usage_class.classnum IS NULL';
+ }
+ my @usage_recs = qsearch({
+ 'table' => 'cust_pkg_usage',
+ 'addl_from' => ' JOIN part_pkg_usage USING (pkgusagepart)'.
+ ' JOIN cust_pkg USING (pkgnum)'.
+ ' JOIN part_pkg_usage_class USING (pkgusagepart)',
+ 'select' => 'cust_pkg_usage.*',
+ 'extra_sql' => " WHERE ( cust_pkg.pkgnum = $pkgnum OR ".
+ " ( cust_pkg.custnum = $custnum AND ".
+ " part_pkg_usage.shared IS NOT NULL ) ) AND ".
+ $is_classnum . ' AND '.
+ " cust_pkg_usage.minutes > 0",
+ 'order_by' => " ORDER BY priority ASC",
+ });
+
+ my $orig_minutes = $minutes;
+ my $error;
+ while (!$error and $minutes > 0 and @usage_recs) {
+ my $cust_pkg_usage = shift @usage_recs;
+ $cust_pkg_usage->select_for_update;
+ my $cdr_cust_pkg_usage = FS::cdr_cust_pkg_usage->new({
+ pkgusagenum => $cust_pkg_usage->pkgusagenum,
+ acctid => $cdr->acctid,
+ minutes => min($cust_pkg_usage->minutes, $minutes),
+ });
+ $cust_pkg_usage->set('minutes',
+ sprintf('%.0f', $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;
+ }
+ if ( $order and $minutes > 0 and !$error ) {
+ # then try to steal minutes from another call
+ my %search = (
+ 'table' => 'cdr_cust_pkg_usage',
+ 'addl_from' => ' JOIN cust_pkg_usage USING (pkgusagenum)'.
+ ' JOIN part_pkg_usage USING (pkgusagepart)'.
+ ' JOIN cust_pkg USING (pkgnum)'.
+ ' JOIN part_pkg_usage_class USING (pkgusagepart)'.
+ ' JOIN cdr USING (acctid)',
+ 'select' => 'cdr_cust_pkg_usage.*',
+ 'extra_sql' => " WHERE cdr.freesidestatus = 'rated' AND ".
+ " ( cust_pkg.pkgnum = $pkgnum OR ".
+ " ( cust_pkg.custnum = $custnum AND ".
+ " part_pkg_usage.shared IS NOT NULL ) ) AND ".
+ " part_pkg_usage_class.classnum = $classnum",
+ 'order_by' => ' ORDER BY part_pkg_usage.priority ASC',
+ );
+ if ( $order eq 'time' ) {
+ # find CDRs that are using minutes, but have a later startdate
+ # than this call
+ my $startdate = $cdr->startdate;
+ if ($startdate !~ /^\d+$/) {
+ die "bad cdr startdate '$startdate'";
+ }
+ $search{'extra_sql'} .= " AND cdr.startdate > $startdate";
+ # minimize needless reshuffling
+ $search{'order_by'} .= ', cdr.startdate DESC';
+ } else {
+ # XXX may not work correctly with rate_time schedules. Could
+ # fix this by storing ratedetailnum in cdr_cust_pkg_usage, I
+ # think...
+ $search{'addl_from'} .=
+ ' JOIN rate_detail'.
+ ' ON (cdr.rated_ratedetailnum = rate_detail.ratedetailnum)';
+ if ( $order eq 'rate_high' ) {
+ $search{'extra_sql'} .= ' AND rate_detail.min_charge < '.
+ $rate_detail->min_charge;
+ $search{'order_by'} .= ', rate_detail.min_charge ASC';
+ } elsif ( $order eq 'rate_low' ) {
+ $search{'extra_sql'} .= ' AND rate_detail.min_charge > '.
+ $rate_detail->min_charge;
+ $search{'order_by'} .= ', rate_detail.min_charge DESC';
+ } else {
+ # this should really never happen
+ die "invalid cdr-minutes_priority value '$order'\n";
+ }
+ }
+ my @cdr_usage_recs = qsearch(\%search);
+ my %reproc_cdrs;
+ while (!$error and @cdr_usage_recs and $minutes > 0) {
+ my $cdr_cust_pkg_usage = shift @cdr_usage_recs;
+ my $cust_pkg_usage = $cdr_cust_pkg_usage->cust_pkg_usage;
+ my $old_cdr = $cdr_cust_pkg_usage->cdr;
+ $reproc_cdrs{$old_cdr->acctid} = $old_cdr;
+ $cdr_cust_pkg_usage->select_for_update;
+ $old_cdr->select_for_update;
+ $cust_pkg_usage->select_for_update;
+ # in case someone else stole the usage from this CDR
+ # while waiting for the lock...
+ next if $old_cdr->acctid != $cdr_cust_pkg_usage->acctid;
+ # steal the usage allocation and flag the old CDR for reprocessing
+ $cdr_cust_pkg_usage->set('acctid', $cdr->acctid);
+ # if the allocation is more minutes than we need, adjust it...
+ my $delta = $cdr_cust_pkg_usage->minutes - $minutes;
+ if ( $delta > 0 ) {
+ $cdr_cust_pkg_usage->set('minutes', $minutes);
+ $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $delta);
+ $error = $cust_pkg_usage->replace;
+ }
+ #warn 'CDR '.$cdr->acctid . ' stealing allocation '.$cdr_cust_pkg_usage->cdrusagenum.' from CDR '.$old_cdr->acctid."\n";
+ $error ||= $cdr_cust_pkg_usage->replace;
+ # deduct the stolen minutes
+ $minutes -= $cdr_cust_pkg_usage->minutes;
+ }
+ # after all minute-stealing is done, reset the affected CDRs
+ foreach (values %reproc_cdrs) {
+ $error ||= $_->set_status('');
+ # XXX or should we just call $cdr->rate right here?
+ # it's not like we can create a loop this way, since the min_charge
+ # or call time has to go monotonically in one direction.
+ # we COULD get some very deep recursions going, though...
+ }
+ } # if $order and $minutes
+ if ( $error ) {
+ $dbh->rollback;
+ die "error applying included minutes\npkgnum ".$self->pkgnum.", class $classnum, acctid ".$cdr->acctid."\n$error\n"
+ } else {
+ $dbh->commit if $oldAutoCommit;
+ return $orig_minutes - $minutes;
+ }
+}
+
+=item supplemental_pkgs
+
+Returns a list of all packages supplemental to this one.
+
+=cut
+
+sub supplemental_pkgs {
+ my $self = shift;
+ qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum });
+}
+
+=item main_pkg
+
+Returns the package that this one is supplemental to, if any.
+
+=cut
+
+sub main_pkg {
+ my $self = shift;
+ if ( $self->main_pkgnum ) {
+ return FS::cust_pkg->by_key($self->main_pkgnum);
+ }
+ return;
+}
+
=back
=head1 CLASS METHODS
=item fcc_line
- boolean selects packages containing fcc form 477 telco lines
+boolean; if true, returns only packages with more than 0 FCC phone lines.
+
+=item state, country
+
+Limit to packages with a service location in the specified state and country.
+For FCC 477 reporting, mostly.
=back
"cust_main.agentnum = $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
##
} elsif ( @c_where ) {
push @where, ' ( '. join(' OR ', @c_where). ' ) ';
}
- warn $where[-1];
}
if ( exists($params->{'censustract'}) ) {
$params->{'censustract'} =~ /^([.\d]*)$/;
- my $censustract = "cust_main.censustract = '$1'";
- $censustract .= ' OR cust_main.censustract is NULL' unless $1;
+ my $censustract = "cust_location.censustract = '$1'";
+ $censustract .= ' OR cust_location.censustract is NULL' unless $1;
push @where, "( $censustract )";
}
)
{
if ($1) {
- push @where, "cust_main.censustract LIKE '$1%'";
+ push @where, "cust_location.censustract LIKE '$1%'";
} else {
push @where,
- "( cust_main.censustract = '' OR cust_main.censustract IS NULL )";
+ "( cust_location.censustract = '' OR cust_location.censustract IS NULL )";
+ }
+ }
+
+ ###
+ # parse country/state
+ ###
+ for (qw(state country)) { # parsing rules are the same for these
+ if ( exists($params->{$_})
+ && uc($params->{$_}) =~ /^([A-Z]{2})$/ )
+ {
+ # XXX post-2.3 only--before that, state/country may be in cust_main
+ push @where, "cust_location.$_ = '$1'";
}
}
"NOT (".FS::cust_pkg->onetime_sql . ")";
}
else {
- foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) {
+ foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
next unless exists($params->{$field});
my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
- my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
- 'LEFT JOIN part_pkg USING ( pkgpart ) '.
- 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
+ my $addl_from = 'LEFT JOIN part_pkg USING ( pkgpart ) '.
+ 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '.
+ 'LEFT JOIN cust_location USING ( locationnum ) '.
+ FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg');
+
+ my $select;
+ my $count_query;
+ if ( $params->{'select_zip5'} ) {
+ my $zip = 'cust_location.zip';
+
+ $select = "DISTINCT substr($zip,1,5) as zip";
+ $orderby = "ORDER BY substr($zip,1,5)";
+ $count_query = "SELECT COUNT( DISTINCT substr($zip,1,5) )";
+ } else {
+ $select = join(', ',
+ 'cust_pkg.*',
+ ( map "part_pkg.$_", qw( pkg freq ) ),
+ 'pkg_class.classname',
+ 'cust_main.custnum AS cust_main_custnum',
+ FS::UI::Web::cust_sql_fields(
+ $params->{'cust_fields'}
+ ),
+ );
+ $count_query = 'SELECT COUNT(*)';
+ }
- my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
+ $count_query .= " FROM cust_pkg $addl_from $extra_sql";
my $sql_query = {
'table' => 'cust_pkg',
'hashref' => {},
- 'select' => join(', ',
- 'cust_pkg.*',
- ( map "part_pkg.$_", qw( pkg freq ) ),
- 'pkg_class.classname',
- 'cust_main.custnum AS cust_main_custnum',
- FS::UI::Web::cust_sql_fields(
- $params->{'cust_fields'}
- ),
- ),
+ 'select' => $select,
'extra_sql' => $extra_sql,
'order_by' => $orderby,
'addl_from' => $addl_from,
}
+=item tax_locationnum_sql
+
+Returns an SQL expression for the tax location for a package, based
+on the settings of 'tax-pkg_address' and 'tax-ship_address'.
+
+=cut
+
+sub tax_locationnum_sql {
+ my $conf = FS::Conf->new;
+ if ( $conf->exists('tax-pkg_address') ) {
+ 'cust_pkg.locationnum';
+ }
+ elsif ( $conf->exists('tax-ship_address') ) {
+ 'cust_main.ship_locationnum';
+ }
+ else {
+ 'cust_main.bill_locationnum';
+ }
+}
=item location_sql
# '?' placeholders in _location_sql_where
my $x = $ornull ? 3 : 2;
- my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
+ my @bill_param = (
+ ('district')x3,
+ ('city')x3,
+ ('county')x$x,
+ ('state')x$x,
+ 'country'
+ );
my $main_where;
my @main_param;
$ornull = $ornull ? ' OR ? IS NULL ' : '';
- my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) ";
- my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
- my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
+ my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL )";
+ my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL )";
+ my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL )";
+
+ my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
# ( $table.${prefix}city = ? $or_empty_city $ornull )
"
- ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
- AND ( $table.${prefix}county = ? $or_empty_county $ornull )
- AND ( $table.${prefix}state = ? $or_empty_state $ornull )
- AND $table.${prefix}country = ?
+ ( $table.district = ? OR ? = '' OR CAST(? AS $text) IS NULL )
+ AND ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS $text) IS NULL )
+ AND ( $table.${prefix}county = ? $or_empty_county $ornull )
+ AND ( $table.${prefix}state = ? $or_empty_state $ornull )
+ AND $table.${prefix}country = ?
";
}
%hash,
};
$error = $cust_pkg->insert( 'change' => $change );
+ push @$return_cust_pkg, $cust_pkg;
+
+ foreach my $link ($cust_pkg->part_pkg->supp_part_pkg_link) {
+ my $supp_pkg = FS::cust_pkg->new({
+ custnum => $custnum,
+ pkgpart => $link->dst_pkgpart,
+ refnum => $refnum,
+ main_pkgnum => $cust_pkg->pkgnum,
+ %hash,
+ });
+ $error ||= $supp_pkg->insert( 'change' => $change );
+ push @$return_cust_pkg, $supp_pkg;
+ }
+
if ($error) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
- push @$return_cust_pkg, $cust_pkg;
+
}
# $return_cust_pkg now contains refs to all of the newly
# created packages.