X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=059384911237c614822257b687ed8ada0e9a9523;hb=2eb4ef92fbea43f55fd705d604fda5c815f9eb9c;hp=6124ad498873fa1721015197ecd86cb233505d37;hpb=901729ec75ad9635d5a14c7688288c8985795d56;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 6124ad498..059384911 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -4,7 +4,7 @@ use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin 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); @@ -35,6 +35,8 @@ use FS::cust_pkg_discount; use FS::discount; use FS::UI::Web; use FS::sales; +# for modify_charge +use FS::cust_credit; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } @@ -52,6 +54,8 @@ $me = '[FS::cust_pkg]'; $disable_agentcheck = 0; +$upgrade = 0; #go away after setup+start dates cleaned up for old customers + sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; @@ -261,7 +265,8 @@ The following options are available: =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 @@ -294,37 +299,42 @@ sub insert { 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'; @@ -333,6 +343,8 @@ sub insert { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + $self->susp( $self->order_date ) if $self->susp eq 'now'; + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -644,7 +656,7 @@ sub check { || $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') @@ -654,7 +666,7 @@ sub check { 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; @@ -925,6 +937,8 @@ sub cancel { '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? @@ -1366,6 +1380,8 @@ sub suspend { 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n", ( map { "Service : $_\n" } @labels ), ], + 'custnum' => $self->custnum, + 'msgtype' => 'admin' ); if ( $error ) { @@ -1552,16 +1568,19 @@ sub unsuspend { my $conf = new FS::Conf; - if ( $inactive > 0 && - ( $hash{'bill'} || $hash{'setup'} ) && - ( $opt{'adjust_next_bill'} || - $conf->exists('unsuspend-always_adjust_next_bill_date') || - $self->part_pkg->option('unsuspend_adjust_bill', 1) ) - ) { - - $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive; - - } + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive + if $inactive > 0 + && ( $hash{'bill'} || $hash{'setup'} ) + && ( $opt{'adjust_next_bill'} + || $conf->exists('unsuspend-always_adjust_next_bill_date') + || $self->part_pkg->option('unsuspend_adjust_bill', 1) + ) + && ! $self->option('suspend_bill',1) + && ( ! $self->part_pkg->option('suspend_bill',1) + || $self->option('no_suspend_bill',1) + ) + && $hash{'order_date'} != $hash{'susp'} + ; $hash{'susp'} = ''; $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time; @@ -1619,6 +1638,8 @@ sub unsuspend { : '' ), ], + 'custnum' => $self->custnum, + 'msgtype' => 'admin', ); if ( $error ) { @@ -1804,7 +1825,7 @@ sub change { $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; } @@ -1841,6 +1862,9 @@ sub change { $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) @@ -1856,10 +1880,10 @@ sub change { 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; @@ -1894,7 +1918,7 @@ sub change { } if ($error) { $dbh->rollback if $oldAutoCommit; - return $error; + return "inserting new package: $error"; } # Transfer services and cancel old package. @@ -1903,7 +1927,7 @@ sub change { 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') ) { @@ -1912,7 +1936,7 @@ sub change { if ($error and $error == 0) { # $old_pkg->transfer failed. $dbh->rollback if $oldAutoCommit; - return $error; + return "converting $error"; } } @@ -1924,7 +1948,7 @@ sub change { # 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 @@ -1939,7 +1963,7 @@ sub change { 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 @@ -1948,7 +1972,7 @@ sub change { $error = $usage->replace; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "Error transferring usage pools: $error"; + return "transferring usage pools: $error"; } } } @@ -1965,7 +1989,7 @@ sub change { $error = $new_discount->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "Error transferring discounts: $error"; + return "transferring discounts: $error"; } } } @@ -1978,7 +2002,7 @@ sub change { $error = $new_detail->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "Error transferring package notes: $error"; + return "transferring package notes: $error"; } } @@ -2057,7 +2081,7 @@ sub change { ); if ($error) { $dbh->rollback if $oldAutoCommit; - return $error; + return "canceling old package: $error"; } if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) { @@ -2067,7 +2091,7 @@ sub change { ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "billing new package: $error"; } } @@ -2256,8 +2280,196 @@ sub set_salesnum { $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: +- 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; @@ -2545,7 +2757,7 @@ sub set_cust_pkg_detail { =item cust_event -Returns the new-style customer billing events (see L) for this invoice. +Returns the customer billing events (see L) for this invoice. =cut @@ -2562,35 +2774,73 @@ sub cust_event { =item num_cust_event -Returns the number of new-style customer billing events (see L) for this invoice. +Returns the number of customer billing events (see L) for this package. =cut #false laziness w/cust_bill.pm sub num_cust_event { my $self = shift; - my $sql = - "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ". - " WHERE tablenum = ? AND eventtable = 'cust_pkg'"; + my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where; + $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0]; +} + +=item exists_cust_event + +Returns true if there are customer billing events (see L) for this package. More efficient than using num_cust_event. + +=cut + +sub exists_cust_event { + my $self = shift; + my $sql = "SELECT 1 ". $self->_from_cust_event_where. " LIMIT 1"; + my $row = $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref; + $row ? $row->[0] : ''; +} + +sub _from_cust_event_where { + #my $self = shift; + " FROM cust_event JOIN part_event USING ( eventpart ) ". + " WHERE tablenum = ? AND eventtable = 'cust_pkg' "; +} + +sub _prep_ex { + my( $self, $sql, @args ) = @_; my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql"; - $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql"; - $sth->fetchrow_arrayref->[0]; + $sth->execute(@args) or die $sth->errstr. " executing $sql"; + $sth; } =item cust_svc [ SVCPART ] (old, deprecated usage) =item cust_svc [ OPTION => VALUE ... ] (current usage) +=item cust_svc_unsorted [ OPTION => VALUE ... ] + Returns the services for this package, as FS::cust_svc objects (see L). 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(@_) ); +} - return () unless $self->num_cust_svc(@_); +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(@_); my %opt = (); if ( @_ && $_[0] =~ /^\d+/ ) { @@ -2613,13 +2863,7 @@ sub 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) ]; } @@ -2774,17 +3018,35 @@ following extra fields: =over 4 -=item num_cust_svc (count) +=item num_cust_svc + +(count) + +=item num_avail -=item num_avail (quantity - count) +(quantity - count) -=item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects +=item cust_pkg_svc + +(services) - array reference containing the provisioned services, as cust_svc objects =back -Accepts one option: summarize_size. If specified and non-zero, will omit the -extra cust_pkg_svc option for objects where num_cust_svc is this size or -greater. +Accepts two options: + +=over 4 + +=item summarize_size + +If true, will omit the extra cust_pkg_svc option for objects where num_cust_svc +is this size or greater. + +=item hide_discontinued + +If true, will omit looking for services that are no longer avaialble in the +package definition. + +=back =cut @@ -2813,16 +3075,18 @@ sub part_svc { $part_svc; } $self->part_pkg->pkg_svc; - #extras - push @part_svc, map { - my $part_svc = $_; - my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart); - $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail - $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ? - $part_svc->{'Hash'}{'cust_pkg_svc'} = - $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []; - $part_svc; - } $self->extra_part_svc; + unless ( $opt{hide_discontinued} ) { + #extras + push @part_svc, map { + my $part_svc = $_; + my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart); + $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail + $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ? + $part_svc->{'Hash'}{'cust_pkg_svc'} = + $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []; + $part_svc; + } $self->extra_part_svc; + } @part_svc; @@ -2889,6 +3153,8 @@ Returns a short status string for this package, currently: =over 4 +=item on hold + =item not yet billed =item one-time charge @@ -2909,6 +3175,7 @@ sub status { my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq; return 'cancelled' if $self->get('cancel'); + return 'on hold' if $self->susp && ! $self->setup; return 'suspended' if $self->susp; return 'not yet billed' unless $self->setup; return 'one-time charge' if $freq =~ /^(0|$)/; @@ -2935,8 +3202,9 @@ Class method that returns the list of possible status strings for packages =cut tie my %statuscolor, 'Tie::IxHash', + 'on hold' => '7E0079', #purple! 'not yet billed' => '009999', #teal? cyan? - 'one-time charge' => '000000', + 'one-time charge' => '0000CC', #blue #'000000', 'active' => '00CC00', 'suspended' => 'FF9900', 'cancelled' => 'FF0000', @@ -2949,6 +3217,11 @@ sub statuses { keys %statuscolor; } +sub statuscolors { + #my $self = shift; + \%statuscolor; +} + =item statuscolor Returns a hex triplet color string for this package's status. @@ -3216,7 +3489,16 @@ Returns the L object for tax_locationnum. sub tax_location { my $self = shift; - FS::cust_location->by_key( $self->tax_locationnum ) + my $conf = FS::Conf->new; + if ( $conf->exists('tax-pkg_address') and $self->locationnum ) { + return FS::cust_location->by_key($self->locationnum); + } + elsif ( $conf->exists('tax-ship_address') ) { + return $self->cust_main->ship_location; + } + else { + return $self->cust_main->bill_location; + } } =item seconds_since TIMESTAMP @@ -3296,8 +3578,7 @@ sub attribute_since_sqlradacct { 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); @@ -3358,7 +3639,7 @@ sub transfer { return ('Package does not exist: '.$dest_pkgnum) unless $dest; foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) { - $target{$pkg_svc->svcpart} = $pkg_svc->quantity; + $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 ); } foreach my $cust_svc ($dest->cust_svc) { @@ -3393,14 +3674,15 @@ sub transfer { } } + 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"; @@ -3420,14 +3702,17 @@ sub transfer { 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; } @@ -3794,7 +4079,7 @@ sub apply_usage { minutes => min($cust_pkg_usage->minutes, $minutes), }); $cust_pkg_usage->set('minutes', - sprintf('%.0f', $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes) + $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes ); $error = $cust_pkg_usage->replace || $cdr_cust_pkg_usage->insert; $minutes -= $cdr_cust_pkg_usage->minutes; @@ -3994,6 +4279,21 @@ sub inactive_sql { " AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) "; } +=item on_hold_sql + +Returns an SQL expression identifying on-hold packages. + +=cut + +sub on_hold_sql { + #$_[0]->recurring_sql(). ' AND '. + " + ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 + AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) + "; +} + =item susp_sql =item suspended_sql @@ -4007,6 +4307,7 @@ sub susp_sql { " ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 + AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0 "; } @@ -4032,6 +4333,7 @@ Returns an SQL expression to give the package status as a string. sub status_sql { "CASE WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled' + WHEN ( cust_pkg.susp IS NOT NULL AND cust_pkg.setup IS NULL ) THEN 'on hold' WHEN cust_pkg.susp IS NOT NULL THEN 'suspended' WHEN cust_pkg.setup IS NULL THEN 'not yet billed' WHEN ".onetime_sql()." THEN 'one-time charge' @@ -4050,13 +4352,15 @@ Valid parameters are =item agentnum -=item magic +=item status -active, inactive, suspended, cancel (or cancelled) +on hold, active, inactive (or one-time charge), suspended, canceled (or cancelled) -=item status +=item magic -active, inactive, suspended, one-time charge, inactive, cancel (or cancelled) +Equivalent to "status", except that "canceled"/"cancelled" will exclude +packages that were changed into a new package with the same pkgpart (i.e. +location or quantity changes). =item custom @@ -4117,6 +4421,32 @@ boolean; if true, returns only packages with more than 0 FCC phone lines. 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 @@ -4135,6 +4465,14 @@ sub search { } ## + # parse cust_status + ## + + if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) { + push @where, FS::cust_main->cust_status_sql . " = '$1' "; + } + + ## # parse customer sales person ## @@ -4190,6 +4528,12 @@ sub search { push @where, FS::cust_pkg->inactive_sql(); + } elsif ( $params->{'magic'} =~ /^on[ _]hold$/ + || $params->{'status'} =~ /^on[ _]hold$/ ) { + + push @where, FS::cust_pkg->on_hold_sql(); + + } elsif ( $params->{'magic'} eq 'suspended' || $params->{'status'} eq 'suspended' ) { @@ -4201,6 +4545,19 @@ sub search { push @where, FS::cust_pkg->cancelled_sql(); } + + ### special case: "magic" is used in detail links from browse/part_pkg, + # where "cancelled" has the restriction "and not replaced with a package + # of the same pkgpart". Be consistent with that. + ### + + if ( $params->{'magic'} =~ /^cancell?ed$/ ) { + my $new_pkgpart = "SELECT pkgpart FROM cust_pkg AS cust_pkg_next ". + "WHERE cust_pkg_next.change_pkgnum = cust_pkg.pkgnum"; + # ...may not exist, if this was just canceled and not changed; in that + # case give it a "new pkgpart" that never equals the old pkgpart + push @where, "COALESCE(($new_pkgpart), 0) != cust_pkg.pkgpart"; + } ### # parse package class @@ -4341,6 +4698,22 @@ sub search { } ### + # 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 ### @@ -4380,12 +4753,18 @@ sub search { ); 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 {