FS::m2m_Common FS::option_Common );
use strict;
-use vars qw($disable_agentcheck $DEBUG $me);
+use vars qw( $disable_agentcheck $DEBUG $me $upgrade );
use Carp qw(cluck);
use Scalar::Util qw( blessed );
use List::Util qw(min max);
use FS::cust_pkg_discount;
use FS::discount;
use FS::UI::Web;
-use Data::Dumper;
+use FS::sales;
+# for modify_charge
+use FS::cust_credit;
# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
# setup }
$disable_agentcheck = 0;
+$upgrade = 0; #go away after setup+start dates cleaned up for old customers
+
sub _cache {
my $self = shift;
my ( $hashref, $cache ) = @_;
=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 ( ! $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) );
+ }
+
+ # set up any automatic expire/adjourn/contract_end timers
+ # based on the start date
+ foreach my $action ( qw(expire adjourn contract_end) ) {
+ my $months = $part_pkg->option("${action}_months",1);
+ if($months and !$self->$action) {
+ my $start = $self->start_date || $self->setup || time;
+ $self->$action( $part_pkg->add_freq($start, $months) );
+ }
+ }
+
+ # if this package has "free days" and delayed setup fee, then
+ # set start date that many days in the future.
+ # (this should have been set in the UI, but enforce it here)
+ if ( ! $options{'change'}
+ && $part_pkg->option('free_days',1)
+ && $part_pkg->option('delay_setup',1)
+ #&& ! $self->start_date
+ )
+ {
+ $self->start_date( $part_pkg->default_start_date );
}
- }
- # if 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);
+ # set order date unless this was previously a different package
+ $self->order_date(time) unless $self->change_pkgnum;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
|| $self->ut_numbern('pkgpart')
|| $self->ut_foreign_keyn('contactnum', 'contact', 'contactnum' )
|| $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
+ || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
+ || $self->ut_numbern('quantity')
|| $self->ut_numbern('start_date')
|| $self->ut_numbern('setup')
|| $self->ut_numbern('bill')
|| $self->ut_numbern('dundate')
|| $self->ut_enum('no_auto', [ '', 'Y' ])
|| $self->ut_enum('waive_setup', [ '', 'Y' ])
- || $self->ut_numbern('agent_pkgid')
+ || $self->ut_textn('agent_pkgid')
|| $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
|| $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])
|| $self->ut_foreign_keyn('main_pkgnum', 'cust_pkg', 'pkgnum')
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;
'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?
'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
( map { "Service : $_\n" } @labels ),
],
+ 'custnum' => $self->custnum,
+ 'msgtype' => 'admin'
);
if ( $error ) {
: ''
),
],
+ 'custnum' => $self->custnum,
+ 'msgtype' => 'admin',
);
if ( $error ) {
$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";
}
}
}
$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;
+ my $pkg_opt_modified = 0;
+
+ $opt{'additional'} ||= [];
+ my $i;
+ my @old_additional;
+ foreach (grep /^additional/, keys %pkg_opt) {
+ ($i) = ($_ =~ /^additional_info(\d+)$/);
+ $old_additional[$i] = $pkg_opt{$_} if $i;
+ delete $pkg_opt{$_};
+ }
+
+ for ( $i = 0; exists($opt{'additional'}->[$i]); $i++ ) {
+ $pkg_opt{ "additional_info$i" } = $opt{'additional'}->[$i];
+ if (!exists($old_additional[$i])
+ or $old_additional[$i] ne $opt{'additional'}->[$i])
+ {
+ $pkg_opt_modified = 1;
+ }
+ }
+ $pkg_opt_modified = 1 if (scalar(@old_additional) - 1) != $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 ( exists($opt{'amount'})
+ and $part_pkg->option('setup_fee') != $opt{'amount'}
+ and $opt{'amount'} > 0 ) {
+
+ $pkg_opt{'setup_fee'} = $opt{'amount'};
+ $pkg_opt_modified = 1;
+
+ }
+ } # else simply ignore them; the UI shouldn't allow editing the fields
+
+ my $error;
+ if ( $part_pkg->modified or $pkg_opt_modified ) {
+ # can we safely modify the package def?
+ # Yes, if it's not available for purchase, and this is the only instance
+ # of it.
+ if ( $part_pkg->disabled
+ and FS::cust_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 1
+ and FS::quotation_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 0
+ ) {
+ $error = $part_pkg->replace( options => \%pkg_opt );
+ } else {
+ # clone it
+ $part_pkg = $part_pkg->clone;
+ $part_pkg->set('disabled' => 'Y');
+ $error = $part_pkg->insert( options => \%pkg_opt );
+ # and associate this as yet-unbilled package to the new package def
+ $self->set('pkgpart' => $part_pkg->pkgpart);
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ if ($self->modified) { # for quantity or start_date change, or if we had
+ # to clone the existing package def
+ my $error = $self->replace;
+ return $error if $error;
+ }
+ if (defined $old_classnum) {
+ # fix invoice grouping records
+ my $old_catname = $old_classnum
+ ? FS::pkg_class->by_key($old_classnum)->categoryname
+ : '';
+ my $new_catname = $opt{'classnum'}
+ ? $part_pkg->pkg_class->categoryname
+ : '';
+ if ( $old_catname ne $new_catname ) {
+ foreach my $cust_bill_pkg ($self->cust_bill_pkg) {
+ # (there should only be one...)
+ my @display = qsearch( 'cust_bill_pkg_display', {
+ 'billpkgnum' => $cust_bill_pkg->billpkgnum,
+ 'section' => $old_catname,
+ });
+ foreach (@display) {
+ $_->set('section', $new_catname);
+ $error = $_->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ } # foreach $cust_bill_pkg
+ }
+
+ if ( $opt{'adjust_commission'} ) {
+ # fix commission credits...tricky.
+ foreach my $cust_event ($self->cust_event) {
+ my $part_event = $cust_event->part_event;
+ foreach my $table (qw(sales agent)) {
+ my $class =
+ "FS::part_event::Action::Mixin::credit_${table}_pkg_class";
+ my $credit = qsearchs('cust_credit', {
+ 'eventnum' => $cust_event->eventnum,
+ });
+ if ( $part_event->isa($class) ) {
+ # Yes, this results in current commission rates being applied
+ # retroactively to a one-time charge. For accounting purposes
+ # there ought to be some kind of time limit on doing this.
+ my $amount = $part_event->_calc_credit($self);
+ if ( $credit and $credit->amount ne $amount ) {
+ # Void the old credit.
+ $error = $credit->void('Package class changed');
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error (adjusting commission credit)";
+ }
+ }
+ # redo the event action to recreate the credit.
+ local $@ = '';
+ eval { $part_event->do_action( $self, $cust_event ) };
+ if ( $@ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $@;
+ }
+ } # if $part_event->isa($class)
+ } # foreach $table
+ } # foreach $cust_event
+ } # if $opt{'adjust_commission'}
+ } # if defined $old_classnum
+
+ $dbh->commit if $oldAutoCommit;
+ '';
}
+
+
use Storable 'thaw';
use MIME::Base64;
+use Data::Dumper;
sub process_bulk_cust_pkg {
my $job = shift;
my $param = thaw(decode_base64(shift));
=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) ];
}
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 "service $label[1]: $error";
+ }
}
return $remaining;
}
Limit to packages with a service location in the specified state and country.
For FCC 477 reporting, mostly.
+=item location_cust
+
+Limit to packages whose service locations are the same as the customer's
+default service location.
+
+=item location_nocust
+
+Limit to packages whose service locations are not the customer's default
+service location.
+
+=item location_census
+
+Limit to packages whose service locations have census tracts.
+
+=item location_nocensus
+
+Limit to packages whose service locations do not have a census tract.
+
+=item location_geocode
+
+Limit to packages whose locations have geocodes.
+
+=item location_geocode
+
+Limit to packages whose locations do not have geocodes.
+
=back
=cut
}
##
+ # parse cust_status
+ ##
+
+ if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
+ push @where, FS::cust_main->cust_status_sql . " = '$1' ";
+ }
+
+ ##
+ # parse customer sales person
+ ##
+
+ if ( $params->{'cust_main_salesnum'} =~ /^(\d+)$/ ) {
+ push @where, ($1 > 0) ? "cust_main.salesnum = $1"
+ : 'cust_main.salesnum IS NULL';
+ }
+
+
+ ##
+ # parse sales person
+ ##
+
+ if ( $params->{'salesnum'} =~ /^(\d+)$/ ) {
+ push @where, ($1 > 0) ? "cust_pkg.salesnum = $1"
+ : 'cust_pkg.salesnum IS NULL';
+ }
+
+ ##
# parse custnum
##
}
###
+ # location_* flags
+ ###
+ if ( $params->{location_cust} xor $params->{location_nocust} ) {
+ my $op = $params->{location_cust} ? '=' : '!=';
+ push @where, "cust_location.locationnum $op cust_main.ship_locationnum";
+ }
+ if ( $params->{location_census} xor $params->{location_nocensus} ) {
+ my $op = $params->{location_census} ? "IS NOT NULL" : "IS NULL";
+ push @where, "cust_location.censustract $op";
+ }
+ if ( $params->{location_geocode} xor $params->{location_nogeocode} ) {
+ my $op = $params->{location_geocode} ? "IS NOT NULL" : "IS NULL";
+ push @where, "cust_location.geocode $op";
+ }
+
+ ###
# parse part_pkg
###
);
if( exists($params->{'active'} ) ) {
- # This overrides all the other date-related fields
+ # This overrides all the other date-related fields, and includes packages
+ # that were active at some time during the interval. It excludes:
+ # - packages that were set up after the end of the interval
+ # - packages that were canceled before the start of the interval
+ # - packages that were suspended before the start of the interval
+ # and are still suspended now
my($beginning, $ending) = @{$params->{'active'}};
push @where,
"cust_pkg.setup IS NOT NULL",
"cust_pkg.setup <= $ending",
"(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
+ "(cust_pkg.susp IS NULL OR cust_pkg.susp >= $beginning )",
"NOT (".FS::cust_pkg->onetime_sql . ")";
}
else {
projects / freeside.git / blobdiff