package FS::cust_pkg;
+use base qw( FS::cust_pkg::Search
+ 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::contact_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(min max);
use FS::part_svc;
use FS::cust_pkg_reason;
use FS::reason;
+use FS::cust_pkg_usageprice;
use FS::cust_pkg_discount;
use FS::discount;
-use FS::UI::Web;
-use Data::Dumper;
+use FS::sales;
+# for modify_charge
+use FS::cust_credit;
# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
# setup }
# for sending cancel emails in sub cancel
use FS::Conf;
-$DEBUG = 0;
-$me = '[FS::cust_pkg]';
+our ($disable_agentcheck, $DEBUG, $me, $import) = (0, 0, '[FS::cust_pkg]', 0);
-$disable_agentcheck = 0;
+our $upgrade = 0; #go away after setup+start dates cleaned up for old customers
sub _cache {
my $self = shift;
refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
record will be created corresponding to cust_main.refnum.
+If the additional field I<cust_pkg_usageprice> is defined, it will be treated
+as an arrayref of FS::cust_pkg_usageprice objects, which will be inserted.
+(Note that this field cannot be set with a usual ->cust_pkg_usageprice method.
+It can be set as part of the hash when creating the object, or with the B<set>
+method.)
+
The following options are available:
=over 4
=item change
If set true, supresses actions that should only be taken for new package
-orders. (Currently this includes: intro periods when delay_setup is on.)
+orders. (Currently this includes: intro periods when delay_setup is on,
+auto-adding a 1st start date, auto-adding expiration/adjourn/contract_end dates)
=item options
my $part_pkg = $self->part_pkg;
- # if the package def says to start only on the first of the month:
- if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
- my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
- $mon += 1 unless $mday == 1;
- until ( $mon < 12 ) { $mon -= 12; $year++; }
- $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
- }
-
- # 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 ( ! $import && ! $options{'change'} ) {
+
+ # if the package def says to start only on the first of the month:
+ if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
+ my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
+ $mon += 1 unless $mday == 1;
+ until ( $mon < 12 ) { $mon -= 12; $year++; }
+ $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
}
- }
- # 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 );
- }
+ # 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) );
+ }
+ }
- $self->order_date(time);
+ # 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 );
+ }
+ }
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
+ # set order date unless it was specified as part of an import
+ # or this was previously a different package
+ $self->order_date(time) unless ($import && $self->order_date)
+ or $self->change_pkgnum;
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
'params' => $self->refnum,
);
+ if ( $self->hashref->{cust_pkg_usageprice} ) {
+ for my $cust_pkg_usageprice ( @{ $self->hashref->{cust_pkg_usageprice} } ) {
+ $cust_pkg_usageprice->pkgnum( $self->pkgnum );
+ my $error = $cust_pkg_usageprice->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
if ( $self->discountnum ) {
my $error = $self->insert_discount();
if ( $error ) {
my $conf = new FS::Conf;
- if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
+ if ( ! $import && $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
);
}
- if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
+ if (! $import && $conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
my $queue = new FS::queue {
'job' => 'FS::cust_main::queueable_print',
};
sub delete {
my $self = 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;
local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
- 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;
|| $self->ut_numbern('pkgpart')
|| $self->ut_foreign_keyn('contactnum', 'contact', 'contactnum' )
|| $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
+ || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
+ || $self->ut_numbern('quantity')
|| $self->ut_numbern('start_date')
|| $self->ut_numbern('setup')
|| $self->ut_numbern('bill')
return $error if $error;
return "A package with both start date (future start) and setup date (already started) will never bill"
- if $self->start_date && $self->setup;
+ if $self->start_date && $self->setup && ! $upgrade;
return "A future unsuspend date can only be set for a package with a suspend date"
if $self->resume and !$self->susp and !$self->adjourn;
join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
if $DEBUG;
- 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;
'to' => \@invoicing_list,
'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
'body' => [ map "$_\n", $conf->config('cancelmessage') ],
+ 'custnum' => $self->custnum,
+ 'msgtype' => '', #admin?
);
}
#should this do something on errors?
# 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;
my( $self, %options ) = @_;
my $error;
- 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;
return $self->main_pkg->suspend(%options);
}
- 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;
'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
( map { "Service : $_\n" } @labels ),
],
+ 'custnum' => $self->custnum,
+ 'msgtype' => 'admin'
);
if ( $error ) {
return $self->main_pkg->unsuspend(%opt);
}
- 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;
: ''
),
],
+ 'custnum' => $self->custnum,
+ 'msgtype' => 'admin',
);
if ( $error ) {
my( $self, %options ) = @_;
my $error;
- 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 $conf = new FS::Conf;
# Transactionize this whole mess
- 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;
$error = $opt->{'cust_location'}->find_or_insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "inserting cust_location (transaction rolled back): $error";
+ return "creating location record: $error";
}
$opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
}
$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');
+
# allow $opt->{'locationnum'} = '' to specifically set it to null
# (i.e. customer default location)
$opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
if ( $opt->{cust_main} ) {
my $cust_main = $opt->{cust_main};
unless ( $cust_main->custnum ) {
- my $error = $cust_main->insert;
+ my $error = $cust_main->insert( @{ $opt->{cust_main_insert_args}||[] } );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "inserting cust_main (transaction rolled back): $error";
+ return "inserting customer record: $error";
}
}
$custnum = $cust_main->custnum;
}
$hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'};
- $hash{'quantity'} = $opt->{'quantity'} || $self->quantity;
my $cust_pkg;
if ( $opt->{'cust_pkg'} ) {
} else {
# Create the new package.
$cust_pkg = new FS::cust_pkg {
- custnum => $custnum,
- pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
- refnum => ( $opt->{'refnum'} || $self->refnum ),
- locationnum => ( $opt->{'locationnum'} ),
+ custnum => $custnum,
+ locationnum => $opt->{'locationnum'},
+ ( map { $_ => ( $opt->{$_} || $self->$_() ) }
+ qw( pkgpart quantity refnum salesnum )
+ ),
%hash,
};
$error = $cust_pkg->insert( 'change' => 1,
}
if ($error) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "inserting new package: $error";
}
# Transfer services and cancel old package.
if ($error and $error == 0) {
# $old_pkg->transfer failed.
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "transferring $error";
}
if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
if ($error and $error == 0) {
# $old_pkg->transfer failed.
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "converting $error";
}
}
# Transfers were successful, but we still had services left on the old
# package. We can't change the package under this circumstances, so abort.
$dbh->rollback if $oldAutoCommit;
- return "Unable to transfer all services from package ". $self->pkgnum;
+ return "unable to transfer all services";
}
#reset usage if changing pkgpart
if ($error) {
$dbh->rollback if $oldAutoCommit;
- return "Error setting usage values: $error";
+ return "setting usage values: $error";
}
} else {
# if NOT changing pkgpart, transfer any usage pools over
$error = $usage->replace;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "Error transferring usage pools: $error";
+ return "transferring usage pools: $error";
+ }
+ }
+ }
+
+ # transfer usage pricing add-ons, if we're not changing pkgpart
+ if ( $same_pkgpart ) {
+ foreach my $old_cust_pkg_usageprice ($self->cust_pkg_usageprice) {
+ my $new_cust_pkg_usageprice = new FS::cust_pkg_usageprice {
+ 'pkgnum' => $cust_pkg->pkgnum,
+ 'usagepricepart' => $old_cust_pkg_usageprice->usagepricepart,
+ 'quantity' => $old_cust_pkg_usageprice->quantity,
+ };
+ $error = $new_cust_pkg_usageprice->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error transferring usage pricing add-on: $error";
}
}
}
$error = $new_discount->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "Error transferring discounts: $error";
+ return "transferring discounts: $error";
}
}
}
$error = $new_detail->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "Error transferring package notes: $error";
+ return "transferring package notes: $error";
}
}
);
if ($error) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "canceling old package: $error";
}
if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "billing new package: $error";
}
}
return '' unless $new_pkgpart or $new_locationnum or $new_quantity; # wouldn't do anything
- my %hash = (
- 'custnum' => $self->custnum,
- 'pkgpart' => ($opt->{'pkgpart'} || $self->pkgpart),
- 'locationnum' => ($opt->{'locationnum'} || $self->locationnum),
- 'quantity' => ($opt->{'quantity'} || $self->quantity),
- 'start_date' => $date,
- );
- my $new = FS::cust_pkg->new(\%hash);
+ # 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 ) {
=item set_quantity QUANTITY
-Change the package's quantity field. This is the one package property
+Change the package's quantity field. This is one of the few package properties
that can safely be changed without canceling and reordering the package
(because it doesn't affect tax eligibility). Returns an error or an
empty string.
sub set_quantity {
my $self = shift;
$self = $self->replace_old; # just to make sure
- my $qty = shift;
- ($qty =~ /^\d+$/ and $qty > 0) or return "bad package quantity $qty";
- $self->set('quantity' => $qty);
+ $self->quantity(shift);
+ $self->replace;
+}
+
+=item set_salesnum SALESNUM
+
+Change the package's salesnum (sales person) field. This is one of the few
+package properties that can safely be changed without canceling and reordering
+the package (because it doesn't affect tax eligibility). Returns an error or
+an empty string.
+
+=cut
+
+sub set_salesnum {
+ my $self = shift;
+ $self = $self->replace_old; # just to make sure
+ $self->salesnum(shift);
$self->replace;
+ # XXX this should probably reassign any credit that's already been given
}
+=item modify_charge OPTIONS
+
+Change the properties of a one-time charge. The following properties can
+be changed this way:
+- pkg: the package description
+- classnum: the package class
+- additional: arrayref of additional invoice details to add to this package
+
+and, I<if the charge has not yet been billed>:
+- start_date: the date when it will be billed
+- amount: the setup fee to be charged
+- quantity: the multiplier for the setup fee
+
+If you pass 'adjust_commission' => 1, and the classnum changes, and there are
+commission credits linked to this charge, they will be recalculated.
+
+=cut
+
+sub modify_charge {
+ my $self = shift;
+ my %opt = @_;
+ my $part_pkg = $self->part_pkg;
+ my $pkgnum = $self->pkgnum;
+
+ my $dbh = dbh;
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+
+ return "Can't use modify_charge except on one-time charges"
+ unless $part_pkg->freq eq '0';
+
+ if ( length($opt{'pkg'}) and $part_pkg->pkg ne $opt{'pkg'} ) {
+ $part_pkg->set('pkg', $opt{'pkg'});
+ }
+
+ my %pkg_opt = $part_pkg->options;
+ if ( ref($opt{'additional'}) ) {
+ delete $pkg_opt{$_} foreach grep /^additional/, keys %pkg_opt;
+ my $i;
+ for ( $i = 0; exists($opt{'additional'}->[$i]); $i++ ) {
+ $pkg_opt{ "additional_info$i" } = $opt{'additional'}->[$i];
+ }
+ $pkg_opt{'additional_count'} = $i if $i > 0;
+ }
+
+ my $old_classnum;
+ if ( exists($opt{'classnum'}) and $part_pkg->classnum ne $opt{'classnum'} )
+ {
+ # remember it
+ $old_classnum = $part_pkg->classnum;
+ $part_pkg->set('classnum', $opt{'classnum'});
+ }
+
+ if ( !$self->get('setup') ) {
+ # not yet billed, so allow amount and quantity
+ 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 ($self->modified) { # for quantity or start_date change
+ my $error = $self->replace;
+ return $error if $error;
+ }
+
+ if ( exists($opt{'amount'})
+ and $part_pkg->option('setup_fee') != $opt{'amount'}
+ and $opt{'amount'} > 0 ) {
+
+ $pkg_opt{'setup_fee'} = $opt{'amount'};
+ # standard for one-time charges is to set comment = (formatted) amount
+ # update it to avoid confusion
+ my $conf = FS::Conf->new;
+ $part_pkg->set('comment',
+ ($conf->config('money_char') || '$') .
+ sprintf('%.2f', $opt{'amount'})
+ );
+ }
+ } # else simply ignore them; the UI shouldn't allow editing the fields
+
+ my $error = $part_pkg->replace( options => \%pkg_opt );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ if (defined $old_classnum) {
+ # fix invoice grouping records
+ my $old_catname = $old_classnum
+ ? FS::pkg_class->by_key($old_classnum)->categoryname
+ : '';
+ my $new_catname = $opt{'classnum'}
+ ? $part_pkg->pkg_class->categoryname
+ : '';
+ if ( $old_catname ne $new_catname ) {
+ foreach my $cust_bill_pkg ($self->cust_bill_pkg) {
+ # (there should only be one...)
+ my @display = qsearch( 'cust_bill_pkg_display', {
+ 'billpkgnum' => $cust_bill_pkg->billpkgnum,
+ 'section' => $old_catname,
+ });
+ foreach (@display) {
+ $_->set('section', $new_catname);
+ $error = $_->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ } # foreach $cust_bill_pkg
+ }
+
+ if ( $opt{'adjust_commission'} ) {
+ # fix commission credits...tricky.
+ foreach my $cust_event ($self->cust_event) {
+ my $part_event = $cust_event->part_event;
+ foreach my $table (qw(sales agent)) {
+ my $class =
+ "FS::part_event::Action::Mixin::credit_${table}_pkg_class";
+ my $credit = qsearchs('cust_credit', {
+ 'eventnum' => $cust_event->eventnum,
+ });
+ if ( $part_event->isa($class) ) {
+ # Yes, this results in current commission rates being applied
+ # retroactively to a one-time charge. For accounting purposes
+ # there ought to be some kind of time limit on doing this.
+ my $amount = $part_event->_calc_credit($self);
+ if ( $credit and $credit->amount ne $amount ) {
+ # Void the old credit.
+ $error = $credit->void('Package class changed');
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error (adjusting commission credit)";
+ }
+ }
+ # redo the event action to recreate the credit.
+ local $@ = '';
+ eval { $part_event->do_action( $self, $cust_event ) };
+ if ( $@ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $@;
+ }
+ } # if $part_event->isa($class)
+ } # foreach $table
+ } # foreach $cust_event
+ } # if $opt{'adjust_commission'}
+ } # if defined $old_classnum
+
+ $dbh->commit if $oldAutoCommit;
+ '';
+}
+
+
+
use Storable 'thaw';
use MIME::Base64;
+use Data::Dumper;
sub process_bulk_cust_pkg {
my $job = shift;
my $param = thaw(decode_base64(shift));
#my $keep_dates = $param->{'keep_dates'} || 0;
my $keep_dates = 1; # there is no good reason to turn this off
- 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;
sub set_cust_pkg_detail {
my( $self, $detailtype, @details ) = @_;
- 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;
=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(@_);
$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) ];
}
sub pkg_label {
my $self = shift;
- my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
+ my $label = $self->part_pkg->pkg_comment( cust_pkg=>$self, nopkgpart=>1 );
$label = $self->pkgnum. ": $label"
if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
$label;
Returns the parent customer object (see L<FS::cust_main>).
-=cut
-
-sub cust_main {
- my $self = shift;
- qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
=item balance
Returns the balance for this specific package, when using
foreach my $cust_svc (
grep {
my $part_svc = $_->part_svc;
- $part_svc->svcdb eq 'svc_acct'
- && scalar($part_svc->part_export_usage);
+ scalar($part_svc->part_export_usage);
} $self->cust_svc
) {
$sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
}
}
+ my $error;
foreach my $cust_svc ($self->cust_svc) {
+ my $svcnum = $cust_svc->svcnum;
if($target{$cust_svc->svcpart} > 0
or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
$target{$cust_svc->svcpart}--;
my $new = new FS::cust_svc { $cust_svc->hash };
$new->pkgnum($dest_pkgnum);
- my $error = $new->replace($cust_svc);
- return $error if $error;
+ $error = $new->replace($cust_svc);
} elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
if ( $DEBUG ) {
warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
my $new = new FS::cust_svc { $cust_svc->hash };
$new->svcpart($change_svcpart);
$new->pkgnum($dest_pkgnum);
- my $error = $new->replace($cust_svc);
- return $error if $error;
+ $error = $new->replace($cust_svc);
} else {
$remaining++;
}
} else {
$remaining++
}
+ if ( $error ) {
+ my @label = $cust_svc->label;
+ return "$label[0] $label[1]: $error";
+ }
}
return $remaining;
}
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;
sub reexport {
my $self = 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;
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;
}
}
-=item cust_pkg_discount
+=item apply_usageprice
=cut
-sub cust_pkg_discount {
+sub apply_usageprice {
my $self = shift;
- qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = '';
+
+ foreach my $cust_pkg_usageprice ( $self->cust_pkg_usageprice ) {
+ $error ||= $cust_pkg_usageprice->apply;
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die "error applying part_pkg_usageprice add-ons, pkgnum ". $self->pkgnum.
+ ": $error\n";
+ } else {
+ $dbh->commit if $oldAutoCommit;
+ }
+
+
}
+=item cust_pkg_discount
+
=item cust_pkg_discount_active
=cut
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:
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;
END"
}
-=item search HASHREF
-
-(Class method)
-
-Returns a qsearch hash expression to search for parameters specified in HASHREF.
-Valid parameters are
-
-=over 4
-
-=item agentnum
-
-=item magic
-
-active, inactive, suspended, cancel (or cancelled)
-
-=item status
-
-active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
-
-=item custom
-
- boolean selects custom packages
-
-=item classnum
-
-=item pkgpart
-
-pkgpart or arrayref or hashref of pkgparts
-
-=item setup
-
-arrayref of beginning and ending epoch date
-
-=item last_bill
-
-arrayref of beginning and ending epoch date
-
-=item bill
-
-arrayref of beginning and ending epoch date
-
-=item adjourn
-
-arrayref of beginning and ending epoch date
-
-=item susp
-
-arrayref of beginning and ending epoch date
-
-=item expire
-
-arrayref of beginning and ending epoch date
-
-=item cancel
-
-arrayref of beginning and ending epoch date
-
-=item query
-
-pkgnum or APKG_pkgnum
-
-=item cust_fields
-
-a value suited to passing to FS::UI::Web::cust_header
-
-=item CurrentUser
-
-specifies the user for agent virtualization
-
-=item fcc_line
-
-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
-
-=cut
-
-sub search {
- my ($class, $params) = @_;
- my @where = ();
-
- ##
- # parse agent
- ##
-
- if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
- push @where,
- "cust_main.agentnum = $1";
- }
-
- ##
- # parse custnum
- ##
-
- if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
- push @where,
- "cust_pkg.custnum = $1";
- }
-
- ##
- # custbatch
- ##
-
- if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
- push @where,
- "cust_pkg.pkgbatch = '$1'";
- }
-
- ##
- # parse status
- ##
-
- if ( $params->{'magic'} eq 'active'
- || $params->{'status'} eq 'active' ) {
-
- push @where, FS::cust_pkg->active_sql();
-
- } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
- || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
-
- push @where, FS::cust_pkg->not_yet_billed_sql();
-
- } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
- || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
-
- push @where, FS::cust_pkg->inactive_sql();
-
- } elsif ( $params->{'magic'} eq 'suspended'
- || $params->{'status'} eq 'suspended' ) {
-
- push @where, FS::cust_pkg->suspended_sql();
-
- } elsif ( $params->{'magic'} =~ /^cancell?ed$/
- || $params->{'status'} =~ /^cancell?ed$/ ) {
-
- push @where, FS::cust_pkg->cancelled_sql();
-
- }
-
- ###
- # parse package class
- ###
-
- if ( exists($params->{'classnum'}) ) {
-
- my @classnum = ();
- if ( ref($params->{'classnum'}) ) {
-
- if ( ref($params->{'classnum'}) eq 'HASH' ) {
- @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} };
- } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) {
- @classnum = @{ $params->{'classnum'} };
- } else {
- die 'unhandled classnum ref '. $params->{'classnum'};
- }
-
-
- } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) {
- @classnum = ( $1 );
- }
-
- if ( @classnum ) {
-
- my @c_where = ();
- my @nums = grep $_, @classnum;
- push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums;
- my $null = scalar( grep { $_ eq '' } @classnum );
- push @c_where, 'part_pkg.classnum IS NULL' if $null;
-
- if ( scalar(@c_where) == 1 ) {
- push @where, @c_where;
- } elsif ( @c_where ) {
- push @where, ' ( '. join(' OR ', @c_where). ' ) ';
- }
-
- }
-
-
- }
-
- ###
- # parse package report options
- ###
-
- my @report_option = ();
- if ( exists($params->{'report_option'}) ) {
- if ( ref($params->{'report_option'}) eq 'ARRAY' ) {
- @report_option = @{ $params->{'report_option'} };
- } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) {
- @report_option = split(',', $1);
- }
-
- }
-
- if (@report_option) {
- # this will result in the empty set for the dangling comma case as it should
- push @where,
- map{ "0 < ( SELECT count(*) FROM part_pkg_option
- WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
- AND optionname = 'report_option_$_'
- AND optionvalue = '1' )"
- } @report_option;
- }
-
- foreach my $any ( grep /^report_option_any/, keys %$params ) {
-
- my @report_option_any = ();
- if ( ref($params->{$any}) eq 'ARRAY' ) {
- @report_option_any = @{ $params->{$any} };
- } elsif ( $params->{$any} =~ /^([,\d]*)$/ ) {
- @report_option_any = split(',', $1);
- }
-
- if (@report_option_any) {
- # this will result in the empty set for the dangling comma case as it should
- push @where, ' ( '. join(' OR ',
- map{ "0 < ( SELECT count(*) FROM part_pkg_option
- WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
- AND optionname = 'report_option_$_'
- AND optionvalue = '1' )"
- } @report_option_any
- ). ' ) ';
- }
-
- }
-
- ###
- # parse custom
- ###
-
- push @where, "part_pkg.custom = 'Y'" if $params->{custom};
-
- ###
- # parse fcc_line
- ###
-
- push @where, "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)"
- if $params->{fcc_line};
-
- ###
- # parse censustract
- ###
-
- if ( exists($params->{'censustract'}) ) {
- $params->{'censustract'} =~ /^([.\d]*)$/;
- my $censustract = "cust_location.censustract = '$1'";
- $censustract .= ' OR cust_location.censustract is NULL' unless $1;
- push @where, "( $censustract )";
- }
-
- ###
- # parse censustract2
- ###
- if ( exists($params->{'censustract2'})
- && $params->{'censustract2'} =~ /^(\d*)$/
- )
- {
- if ($1) {
- push @where, "cust_location.censustract LIKE '$1%'";
- } else {
- push @where,
- "( 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'";
- }
- }
-
- ###
- # parse part_pkg
- ###
-
- if ( ref($params->{'pkgpart'}) ) {
-
- my @pkgpart = ();
- if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
- @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
- } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
- @pkgpart = @{ $params->{'pkgpart'} };
- } else {
- die 'unhandled pkgpart ref '. $params->{'pkgpart'};
- }
-
- @pkgpart = grep /^(\d+)$/, @pkgpart;
-
- push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
-
- } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
- push @where, "pkgpart = $1";
- }
-
- ###
- # parse dates
- ###
-
- my $orderby = '';
-
- #false laziness w/report_cust_pkg.html
- my %disable = (
- 'all' => {},
- 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
- 'active' => { 'susp'=>1, 'cancel'=>1 },
- 'suspended' => { 'cancel' => 1 },
- 'cancelled' => {},
- '' => {},
- );
-
- if( exists($params->{'active'} ) ) {
- # This overrides all the other date-related fields
- my($beginning, $ending) = @{$params->{'active'}};
- push @where,
- "cust_pkg.setup IS NOT NULL",
- "cust_pkg.setup <= $ending",
- "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
- "NOT (".FS::cust_pkg->onetime_sql . ")";
- }
- else {
- foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
-
- next unless exists($params->{$field});
-
- my($beginning, $ending) = @{$params->{$field}};
-
- next if $beginning == 0 && $ending == 4294967295;
-
- push @where,
- "cust_pkg.$field IS NOT NULL",
- "cust_pkg.$field >= $beginning",
- "cust_pkg.$field <= $ending";
-
- $orderby ||= "ORDER BY cust_pkg.$field";
-
- }
- }
-
- $orderby ||= 'ORDER BY bill';
-
- ###
- # parse magic, legacy, etc.
- ###
-
- if ( $params->{'magic'} &&
- $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
- ) {
-
- $orderby = 'ORDER BY pkgnum';
-
- if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
- push @where, "pkgpart = $1";
- }
-
- } elsif ( $params->{'query'} eq 'pkgnum' ) {
-
- $orderby = 'ORDER BY pkgnum';
-
- } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
-
- $orderby = 'ORDER BY pkgnum';
-
- push @where, '0 < (
- SELECT count(*) FROM pkg_svc
- WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
- AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
- WHERE cust_svc.pkgnum = cust_pkg.pkgnum
- AND cust_svc.svcpart = pkg_svc.svcpart
- )
- )';
-
- }
-
- ##
- # setup queries, links, subs, etc. for the search
- ##
-
- # here is the agent virtualization
- if ($params->{CurrentUser}) {
- my $access_user =
- qsearchs('access_user', { username => $params->{CurrentUser} });
-
- if ($access_user) {
- push @where, $access_user->agentnums_sql('table'=>'cust_main');
- } else {
- push @where, "1=0";
- }
- } else {
- push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
- }
-
- my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
-
- 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(*)';
- }
-
- $count_query .= " FROM cust_pkg $addl_from $extra_sql";
-
- my $sql_query = {
- 'table' => 'cust_pkg',
- 'hashref' => {},
- 'select' => $select,
- 'extra_sql' => $extra_sql,
- 'order_by' => $orderby,
- 'addl_from' => $addl_from,
- 'count_query' => $count_query,
- };
-
-}
-
=item fcc_477_count
Returns a list of two package counts. The first is a count of packages
my $conf = new FS::Conf;
# Transactionize this whole mess
- 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 ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
# Transactionize this whole mess
- 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;
projects / freeside.git / blobdiff