X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=c5a3d2e581e11535bb31106915e579cd3c2d3dbf;hb=41aef8bd93f7cc3a39056a8fd997d3072dfcdf8a;hp=8aea17d345891bede4a77a238523e92f7f0799bf;hpb=0654d57f76f9a7ac4544da7ecc65cb924fe67d05;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 8aea17d34..c5a3d2e58 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,7 +1,9 @@ package FS::cust_pkg; -use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin +use base qw( FS::cust_pkg::Search FS::cust_pkg::API + FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin FS::contact_Mixin FS::location_Mixin - FS::m2m_Common FS::option_Common ); + FS::m2m_Common FS::option_Common + ); use strict; use Carp qw(cluck); @@ -33,7 +35,6 @@ use FS::reason; use FS::cust_pkg_usageprice; use FS::cust_pkg_discount; use FS::discount; -use FS::UI::Web; use FS::sales; # for modify_charge use FS::cust_credit; @@ -105,6 +106,8 @@ FS::cust_pkg - Object methods for cust_pkg objects $seconds = $record->seconds_since($timestamp); + #bulk cancel+order... perhaps slightly deprecated, only used by the bulk + # cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi) $error = FS::cust_pkg::order( $custnum, \@pkgparts ); $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] ); @@ -240,6 +243,74 @@ sub cust_unlinked_msg { ' (cust_pkg.pkgnum '. $self->pkgnum. ')'; } +=item set_initial_timers + +If required by the package definition, sets any automatic expire, adjourn, +or contract_end timers to some number of months after the start date +(or setup date, if the package has already been setup). If the package has +a delayed setup fee after a period of "free days", will also set the +start date to the end of that period. + +If the package has an automatic transfer rule (C), then +this will also order the package and set its start date. + +=cut + +sub set_initial_timers { + my $self = shift; + my $part_pkg = $self->part_pkg; + my $start = $self->start_date || $self->setup || time; + + foreach my $action ( qw(expire adjourn contract_end) ) { + my $months = $part_pkg->get("${action}_months"); + if($months and !$self->get($action)) { + $self->set($action, $part_pkg->add_freq($start, $months) ); + } + } + + # if this package has an expire date and a change_to_pkgpart, set automatic + # package transfer + # (but don't call change_later, as that would call $self->replace, and we're + # probably in the middle of $self->insert right now) + if ( $part_pkg->expire_months and $part_pkg->change_to_pkgpart ) { + if ( $self->change_to_pkgnum ) { + # this can happen if a package is ordered on hold, scheduled for a + # future change _while on hold_, and then released from hold, causing + # the automatic transfer to schedule. + # + # what's correct behavior in that case? I think it's to disallow + # future-changing an on-hold package that has an automatic transfer. + # but if we DO get into this situation, let the manual package change + # win. + warn "pkgnum ".$self->pkgnum.": manual future package change blocks ". + "automatic transfer.\n"; + } else { + my $change_to = FS::cust_pkg->new( { + start_date => $self->get('expire'), + pkgpart => $part_pkg->change_to_pkgpart, + map { $_ => $self->get($_) } + qw( custnum locationnum quantity refnum salesnum contract_end ) + } ); + my $error = $change_to->insert; + + return $error if $error; + $self->set('change_to_pkgnum', $change_to->pkgnum); + } + } + + # if this package has "free days" and delayed setup fee, then + # set start date that many days in the future. + # (this should have been set in the UI, but enforce it here) + if ( $part_pkg->option('free_days',1) + && $part_pkg->option('delay_setup',1) + ) + { + $self->start_date( $part_pkg->default_start_date ); + } + + ''; +} + =item insert [ OPTION => VALUE ... ] Adds this billing item to the database ("Orders" the item). If there is an @@ -268,7 +339,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 @@ -295,13 +367,20 @@ a location change). sub insert { my( $self, %options ) = @_; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $error; $error = $self->check_pkgpart unless $options{'allow_pkgpart'}; - return $error if $error; my $part_pkg = $self->part_pkg; - if (! $import) { + if ( ! $import && ! $options{'change'} ) { + + # set order date to now + $self->order_date(time) unless ($import && $self->order_date); + # 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]; @@ -310,37 +389,20 @@ sub insert { $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, 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 ); + if ($self->susp eq 'now' or $part_pkg->start_on_hold) { + # if the package was ordered on hold: + # - suspend it + # - don't set the start date (it will be started manually) + $self->set('susp', $self->order_date); + $self->set('start_date', ''); + } else { + # set expire/adjourn/contract_end timers, and free days, if appropriate + # and automatic package transfer, which can fail, so capture the result + $error = $self->set_initial_timers; } - } - - # set order date unless it was specified as part of an import - $self->order_date(time) unless $import && $self->order_date; + } # else this is a package change, and shouldn't have "new package" behavior - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ()); + $error ||= $self->SUPER::insert($options{options} ? %{$options{options}} : ()); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -434,9 +496,26 @@ hide cancelled packages. =cut +# this is still used internally to abort future package changes, so it +# does need to work + sub delete { my $self = shift; + # The following foreign keys to cust_pkg are not cleaned up here, and will + # cause package deletion to fail: + # + # cust_credit.pkgnum and commission_pkgnum (and cust_credit_void) + # cust_credit_bill.pkgnum + # cust_pay_pending.pkgnum + # cust_pay.pkgnum (and cust_pay_void) + # cust_bill_pay.pkgnum (wtf, shouldn't reference pkgnum) + # cust_pkg_usage.pkgnum + # cust_pkg.uncancel_pkgnum, change_pkgnum, main_pkgnum, and change_to_pkgnum + + # cust_svc is handled by canceling the package before deleting it + # cust_pkg_option is handled via option_Common + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -472,7 +551,13 @@ sub delete { } } - #pkg_referral? + foreach my $pkg_referral ( $self->pkg_referral ) { + my $error = $pkg_referral->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } my $error = $self->SUPER::delete(@_); if ( $error ) { @@ -642,9 +727,10 @@ sub check { || $self->ut_numbern('resume') || $self->ut_numbern('expire') || $self->ut_numbern('dundate') - || $self->ut_enum('no_auto', [ '', 'Y' ]) - || $self->ut_enum('waive_setup', [ '', 'Y' ]) - || $self->ut_numbern('agent_pkgid') + || $self->ut_flag('no_auto', [ '', 'Y' ]) + || $self->ut_flag('waive_setup', [ '', 'Y' ]) + || $self->ut_flag('separate_bill') + || $self->ut_textn('agent_pkgid') || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ]) || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ]) || $self->ut_foreign_keyn('main_pkgnum', 'cust_pkg', 'pkgnum') @@ -759,20 +845,35 @@ to a different pkgpart or location, and probably shouldn't be in any other case. If it's not set, the 'unused_credit_cancel' part_pkg option will be used. +=item no_delay_cancel - prevents delay_cancel behavior +no matter what other options say, for use when changing packages (or any +other time you're really sure you want an immediate cancel) + =back If there is an error, returns the error, otherwise returns false. =cut +#NOT DOCUMENTING - this should only be used when calling recursively +#=item delay_cancel - for internal use, to allow proper handling of +#supplemental packages when the main package is flagged to suspend +#before cancelling, probably shouldn't be used otherwise (set the +#corresponding package option instead) + sub cancel { my( $self, %options ) = @_; my $error; - # pass all suspend/cancel actions to the main package - if ( $self->main_pkgnum and !$options{'from_main'} ) { - return $self->main_pkg->cancel(%options); - } + # supplemental packages can now be separately canceled, though the UI + # shouldn't permit it + # + ## pass all suspend/cancel actions to the main package + ## (unless the pkglinknum has been removed, then the link is defunct and + ## this package can be canceled on its own) + #if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) { + # return $self->main_pkg->cancel(%options); + #} my $conf = new FS::Conf; @@ -796,6 +897,21 @@ sub cancel { my $date = $options{'date'} if $options{'date'}; # expire/cancel later $date = '' if ($date && $date <= $cancel_time); # complain instead? + my $delay_cancel = $options{'no_delay_cancel'} ? 0 : $options{'delay_cancel'}; + if ( !$date && $self->part_pkg->option('delay_cancel',1) + && (($self->status eq 'active') || ($self->status eq 'suspended')) + && !$options{'no_delay_cancel'} + ) { + my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1; + my $expsecs = 60*60*24*$expdays; + my $suspfor = $self->susp ? $cancel_time - $self->susp : 0; + $expsecs = $expsecs - $suspfor if $suspfor; + unless ($expsecs <= 0) { #if it's already been suspended long enough, don't re-suspend + $delay_cancel = 1; + $date = $cancel_time + $expsecs; + } + } + #race condition: usage could be ongoing until unprovisioned #resolved by performing a change package instead (which unprovisions) and #later cancelling @@ -860,22 +976,38 @@ sub cancel { return $error; } } - } #unless $date my %hash = $self->hash; if ( $date ) { $hash{'expire'} = $date; + if ($delay_cancel) { + # just to be sure these are clear + $hash{'adjourn'} = undef; + $hash{'resume'} = undef; + } } else { $hash{'cancel'} = $cancel_time; } $hash{'change_custnum'} = $options{'change_custnum'}; + # if this is a supplemental package that's lost its part_pkg_link, and it's + # being canceled for real, unlink it completely + if ( !$date and ! $self->pkglinknum ) { + $hash{main_pkgnum} = ''; + } + + # if there is a future package change scheduled, unlink from it (like + # abort_change) first, then delete it. + $hash{'change_to_pkgnum'} = ''; + + # save the package state my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace( $self, options => { $self->options } ); + if ( $self->change_to_pkgnum ) { my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum); - $error ||= $change_to->cancel || $change_to->delete; + $error ||= $change_to->cancel('no_delay_cancel' => 1) || $change_to->delete; } if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -883,18 +1015,31 @@ sub cancel { } foreach my $supp_pkg ( $self->supplemental_pkgs ) { - $error = $supp_pkg->cancel(%options, 'from_main' => 1); + $error = $supp_pkg->cancel(%options, + 'from_main' => 1, + 'date' => $date, #in case it got changed by delay_cancel + 'delay_cancel' => $delay_cancel, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error"; } } - foreach my $usage ( $self->cust_pkg_usage ) { - $error = $usage->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "deleting usage pools: $error"; + if ($delay_cancel && !$options{'from_main'}) { + $error = $new->suspend( + 'from_cancel' => 1, + 'time' => $cancel_time + ); + } + + unless ($date) { + foreach my $usage ( $self->cust_pkg_usage ) { + $error = $usage->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "deleting usage pools: $error"; + } } } @@ -914,10 +1059,12 @@ sub cancel { } else { $error = send_email( - 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), + 'from' => $conf->invoice_from_full( $self->cust_main->agentnum ), 'to' => \@invoicing_list, 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ), 'body' => [ map "$_\n", $conf->config('cancelmessage') ], + 'custnum' => $self->custnum, + 'msgtype' => '', #admin? ); } #should this do something on errors? @@ -995,7 +1142,8 @@ sub uncancel { setup susp adjourn resume expire start_date contract_end dundate change_date change_pkgpart change_locationnum - manual_flag no_auto quantity agent_pkgid recur_show_zero setup_show_zero + manual_flag no_auto separate_bill quantity agent_pkgid + recur_show_zero setup_show_zero ), }; @@ -1172,7 +1320,7 @@ Available options are: =over 4 -=item reason - can be set to a cancellation reason (see L), +=item reason - can be set to a cancellation reason (see L), 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 @@ -1191,6 +1339,9 @@ separately. =item from_main - allows a supplemental package to be suspended, rather than redirecting the method call to its main package. For internal use. +=item from_cancel - used when suspending from the cancel method, forces +this to skip everything besides basic suspension. For internal use. + =back If there is an error, returns the error, otherwise returns false. @@ -1201,9 +1352,13 @@ sub suspend { my( $self, %options ) = @_; my $error; - # pass all suspend/cancel actions to the main package + # supplemental packages still can't be separately suspended, but silently + # exit instead of failing or passing the action to the main package (so + # that the "Suspend customer" action doesn't trip over the supplemental + # packages and die) + if ( $self->main_pkgnum and !$options{'from_main'} ) { - return $self->main_pkg->suspend(%options); + return; } my $oldAutoCommit = $FS::UID::AutoCommit; @@ -1233,7 +1388,7 @@ sub suspend { } # some false laziness with sub cancel - if ( !$options{nobill} && !$date && + if ( !$options{nobill} && !$date && !$options{'from_cancel'} && $self->part_pkg->option('bill_suspend_as_cancel',1) ) { # kind of a kludge--'bill_suspend_as_cancel' to avoid having to # make the entire cust_main->bill path recognize 'suspend' and @@ -1250,6 +1405,7 @@ sub suspend { if $error; } + my $cust_pkg_reason; if ( $options{'reason'} ) { $error = $self->insert_reason( 'reason' => $options{'reason'}, 'action' => $date ? 'adjourn' : 'suspend', @@ -1260,6 +1416,21 @@ sub suspend { dbh->rollback if $oldAutoCommit; return "Error inserting cust_pkg_reason: $error"; } + $cust_pkg_reason = qsearchs('cust_pkg_reason', { + 'date' => $date ? $date : $suspend_time, + 'action' => $date ? 'A' : 'S', + 'pkgnum' => $self->pkgnum, + }); + } + + # if a reasonnum was passed, get the actual reason object so we can check + # unused_credit + # (passing a reason hashref is still allowed, but it can't be used with + # the fancy behavioral options.) + + my $reason; + if ($options{'reason'} =~ /^\d+$/) { + $reason = FS::reason->by_key($options{'reason'}); } my %hash = $self->hash; @@ -1286,44 +1457,76 @@ sub suspend { return $error; } - unless ( $date ) { - # credit remaining time if appropriate - if ( $self->part_pkg->option('unused_credit_suspend', 1) ) { - my $error = $self->credit_remaining('suspend', $suspend_time); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; + unless ( $date ) { # then we are suspending now + + unless ($options{'from_cancel'}) { + # credit remaining time if appropriate + # (if required by the package def, or the suspend reason) + my $unused_credit = $self->part_pkg->option('unused_credit_suspend',1) + || ( defined($reason) && $reason->unused_credit ); + + if ( $unused_credit ) { + warn "crediting unused time on pkg#".$self->pkgnum."\n" if $DEBUG; + my $error = $self->credit_remaining('suspend', $suspend_time); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } } - my @labels = (); + my @cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); + + #attempt ordering ala cust_svc_suspend_cascade (without infinite-looping + # on the circular dep case) + # (this is too simple for multi-level deps, we need to use something + # to resolve the DAG properly when possible) + my %svcpart = (); + $svcpart{$_->svcpart} = 0 foreach @cust_svc; + foreach my $svcpart ( keys %svcpart ) { + foreach my $part_svc_link ( + FS::part_svc_link->by_agentnum($self->cust_main->agentnum, + src_svcpart => $svcpart, + link_type => 'cust_svc_suspend_cascade' + ) + ) { + $svcpart{$part_svc_link->dst_svcpart} = max( + $svcpart{$part_svc_link->dst_svcpart}, + $svcpart{$part_svc_link->src_svcpart} + 1 + ); + } + } + @cust_svc = sort { $svcpart{ $a->svcpart } <=> $svcpart{ $b->svcpart } } + @cust_svc; - foreach my $cust_svc ( - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) - ) { - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); + my @labels = (); + foreach my $cust_svc ( @cust_svc ) { + $cust_svc->suspend( 'labels_arrayref' => \@labels ); + } - $part_svc->svcdb =~ /^([\w\-]+)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal svcdb value in part_svc!"; - }; - my $svcdb = $1; - require "FS/$svcdb.pm"; + # suspension fees: if there is a feepart, and it's not an unsuspend fee, + # and this is not a suspend-before-cancel + if ( $cust_pkg_reason ) { + my $reason_obj = $cust_pkg_reason->reason; + if ( $reason_obj->feepart and + ! $reason_obj->fee_on_unsuspend and + ! $options{'from_cancel'} ) { - my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); - if ($svc) { - $error = $svc->suspend; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - my( $label, $value ) = $cust_svc->label; - push @labels, "$label: $value"; + # register the need to charge a fee, cust_main->bill will do the rest + warn "registering suspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n" + if $DEBUG; + my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({ + 'pkgreasonnum' => $cust_pkg_reason->num, + 'pkgnum' => $self->pkgnum, + 'feepart' => $reason->feepart, + 'nextbill' => $reason->fee_hold, + }); + $error ||= $cust_pkg_reason_fee->insert; } } my $conf = new FS::Conf; - if ( $conf->config('suspend_email_admin') ) { + if ( $conf->config('suspend_email_admin') && !$options{'from_cancel'} ) { my $error = send_email( 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), @@ -1338,6 +1541,8 @@ sub suspend { 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n", ( map { "Service : $_\n" } @labels ), ], + 'custnum' => $self->custnum, + 'msgtype' => 'admin' ); if ( $error ) { @@ -1371,6 +1576,21 @@ are mandatory. =cut +# Implementation note: +# +# If you pkgpart-change a package that has been billed, and it's set to give +# credit on package change, then this method gets called and then the new +# package will have no last_bill date. Therefore the customer will be credited +# only once (per billing period) even if there are multiple package changes. +# +# If you location-change a package that has been billed, this method will NOT +# be called and the new package WILL have the last bill date of the old +# package. +# +# If the new package is then canceled within the same billing cycle, +# credit_remaining needs to run calc_remain on the OLD package to determine +# the amount of unused time to credit. + sub credit_remaining { # Add a credit for remaining service my ($self, $mode, $time) = @_; @@ -1387,7 +1607,30 @@ sub credit_remaining { and $next_bill > 0 # the package has a next bill date and $next_bill >= $time # which is in the future ) { - my $remaining_value = $self->calc_remain('time' => $time); + my @cust_credit_source_bill_pkg = (); + my $remaining_value = 0; + + my $remain_pkg = $self; + $remaining_value = $remain_pkg->calc_remain( + 'time' => $time, + 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg, + ); + + # we may have to walk back past some package changes to get to the + # one that actually has unused time + while ( $remaining_value == 0 ) { + if ( $remain_pkg->change_pkgnum ) { + $remain_pkg = FS::cust_pkg->by_key($remain_pkg->change_pkgnum); + } else { + # the package has really never been billed + return; + } + $remaining_value = $remain_pkg->calc_remain( + 'time' => $time, + 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg, + ); + } + if ( $remaining_value > 0 ) { warn "Crediting for $remaining_value on package ".$self->pkgnum."\n" if $DEBUG; @@ -1395,6 +1638,7 @@ sub credit_remaining { $remaining_value, 'Credit for unused time on '. $self->part_pkg->pkg, 'reason_type' => $reason_type, + 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg, ); return "Error crediting customer \$$remaining_value for unused time". " on ". $self->part_pkg->pkg. ": $error" @@ -1459,6 +1703,8 @@ sub unsuspend { return ""; # no error # complain instead? } + # handle the case of setting a future unsuspend (resume) date + # and do not continue to actually unsuspend the package my $date = $opt{'date'}; if ( $date and $date > time ) { # return an error if $date <= time? @@ -1482,6 +1728,15 @@ sub unsuspend { } #if $date + if (!$self->setup) { + # then this package is being released from on-hold status + $error = $self->set_initial_timers; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + my @labels = (); foreach my $cust_svc ( @@ -1517,15 +1772,46 @@ 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) ) - ) { + #adjust the next bill date forward + # increment next bill date if certain conditions are met: + # - it was due to be billed at some point + # - either the global or local config says to do this + my $adjust_bill = 0; + if ( + $inactive > 0 + && ( $hash{'bill'} || $hash{'setup'} ) + && ( $opt{'adjust_next_bill'} + || $conf->exists('unsuspend-always_adjust_next_bill_date') + || $self->part_pkg->option('unsuspend_adjust_bill', 1) + ) + ) { + $adjust_bill = 1; + } + + # but not if: + # - the package billed during suspension + # - or it was ordered on hold + # - or the customer was credited for the unused time - $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive; - + if ( $self->option('suspend_bill',1) + or ( $self->part_pkg->option('suspend_bill',1) + and ! $self->option('no_suspend_bill',1) + ) + or $hash{'order_date'} == $hash{'susp'} + ) { + $adjust_bill = 0; + } + + if ( $adjust_bill ) { + if ( $self->part_pkg->option('unused_credit_suspend') + or ( ref($reason) and $reason->unused_credit ) ) { + # then the customer was credited for the unused time before suspending, + # so their next bill should be immediate + $hash{'bill'} = time; + } else { + # add the length of time suspended to the bill date + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive; + } } $hash{'susp'} = ''; @@ -1540,23 +1826,39 @@ sub unsuspend { my $unsusp_pkg; - if ( $reason && $reason->unsuspend_pkgpart ) { - my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart) - or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart. - " not found."; - my $start_date = $self->cust_main->next_bill_date - if $reason->unsuspend_hold; - - if ( $part_pkg ) { - $unsusp_pkg = FS::cust_pkg->new({ - 'custnum' => $self->custnum, - 'pkgpart' => $reason->unsuspend_pkgpart, - 'start_date' => $start_date, - 'locationnum' => $self->locationnum, - # discount? probably not... + if ( $reason ) { + if ( $reason->unsuspend_pkgpart ) { + warn "Suspend reason '".$reason->reason."' uses deprecated unsuspend_pkgpart feature.\n"; + my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart) + or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart. + " not found."; + my $start_date = $self->cust_main->next_bill_date + if $reason->unsuspend_hold; + + if ( $part_pkg ) { + $unsusp_pkg = FS::cust_pkg->new({ + 'custnum' => $self->custnum, + 'pkgpart' => $reason->unsuspend_pkgpart, + 'start_date' => $start_date, + 'locationnum' => $self->locationnum, + # discount? probably not... + }); + + $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg ); + } + } + # new way, using fees + if ( $reason->feepart and $reason->fee_on_unsuspend ) { + # register the need to charge a fee, cust_main->bill will do the rest + warn "registering unsuspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n" + if $DEBUG; + my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({ + 'pkgreasonnum' => $cust_pkg_reason->num, + 'pkgnum' => $self->pkgnum, + 'feepart' => $reason->feepart, + 'nextbill' => $reason->fee_hold, }); - - $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg ); + $error ||= $cust_pkg_reason_fee->insert; } if ( $error ) { @@ -1584,6 +1886,8 @@ sub unsuspend { : '' ), ], + 'custnum' => $self->custnum, + 'msgtype' => 'admin', ); if ( $error ) { @@ -1714,6 +2018,13 @@ can't be transferred (also see the I config option). If unprotect_svcs is true, this method will transfer as many services as it can and then unconditionally cancel the old package. +=item contract_end + +If specified, sets this value for the contract_end date on the new package +(without regard for keep_dates or the usual date-preservation behavior.) +Will throw an error if defined but false; the UI doesn't allow editing +this unless it already exists, making removal impossible to undo. + =back At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or @@ -1727,6 +2038,33 @@ For example: =cut +#used by change and change_later +#didn't put with documented check methods because it depends on change-specific opts +#and it also possibly edits the value of opts +sub _check_change { + my $self = shift; + my $opt = shift; + if ( defined($opt->{'contract_end'}) ) { + my $current_contract_end = $self->get('contract_end'); + unless ($opt->{'contract_end'}) { + if ($current_contract_end) { + return "Cannot remove contract end date when changing packages"; + } else { + #shouldn't even pass this option if there's not a current value + #but can be handled gracefully if the option is empty + warn "Contract end date passed unexpectedly"; + delete $opt->{'contract_end'}; + return ''; + } + } + unless ($current_contract_end) { + #option shouldn't be passed, throw error if it's non-empty + return "Cannot add contract end date when changing packages " . $self->pkgnum; + } + } + return ''; +} + #some false laziness w/order sub change { my $self = shift; @@ -1734,12 +2072,57 @@ sub change { my $conf = new FS::Conf; + # handle contract_end on cust_pkg same as passed option + if ( $opt->{'cust_pkg'} ) { + $opt->{'contract_end'} = $opt->{'cust_pkg'}->contract_end; + delete $opt->{'contract_end'} unless $opt->{'contract_end'}; + } + + # check contract_end, prevent adding/removing + my $error = $self->_check_change($opt); + return $error if $error; + # Transactionize this whole mess my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error; + if ( $opt->{'cust_location'} ) { + $error = $opt->{'cust_location'}->find_or_insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "creating location record: $error"; + } + $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum; + } + + # Before going any further here: if the package is still in the pre-setup + # state, it's safe to modify it in place. No need to charge/credit for + # partial period, transfer services, transfer usage pools, copy invoice + # details, or change any dates. + if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) { + foreach ( qw( locationnum pkgpart quantity refnum salesnum ) ) { + if ( length($opt->{$_}) ) { + $self->set($_, $opt->{$_}); + } + } + # almost. if the new pkgpart specifies start/adjourn/expire timers, + # apply those. + if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) { + $error ||= $self->set_initial_timers; + } + # but if contract_end was explicitly specified, that overrides all else + $self->set('contract_end', $opt->{'contract_end'}) + if $opt->{'contract_end'}; + $error ||= $self->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "modifying package: $error"; + } else { + $dbh->commit if $oldAutoCommit; + return $self; + } + } my %hash = (); @@ -1751,15 +2134,6 @@ sub change { $hash{"change_$_"} = $self->$_() foreach qw( pkgnum pkgpart locationnum ); - if ( $opt->{'cust_location'} ) { - $error = $opt->{'cust_location'}->find_or_insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "creating location record: $error"; - } - $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum; - } - if ( $opt->{'cust_pkg'} ) { # treat changing to a package with a different pkgpart as a # pkgpart change (because it is) @@ -1774,6 +2148,7 @@ sub change { 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 @@ -1787,11 +2162,18 @@ sub change { } if ( $keep_dates ) { - foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire - resume start_date contract_end ) ) { + foreach my $date ( qw(setup bill last_bill) ) { $hash{$date} = $self->getfield($date); } } + # always keep the following dates + foreach my $date (qw(order_date susp adjourn cancel expire resume + start_date contract_end)) { + $hash{$date} = $self->getfield($date); + } + # but if contract_end was explicitly specified, that overrides all else + $hash{'contract_end'} = $opt->{'contract_end'} + if $opt->{'contract_end'}; # allow $opt->{'locationnum'} = '' to specifically set it to null # (i.e. customer default location) @@ -1803,6 +2185,9 @@ sub change { # 2. (more importantly) changing a package before it's billed $hash{'waive_setup'} = $self->waive_setup; + # if this package is scheduled for a future package change, preserve that + $hash{'change_to_pkgnum'} = $self->change_to_pkgnum; + my $custnum = $self->custnum; if ( $opt->{cust_main} ) { my $cust_main = $opt->{cust_main}; @@ -1824,10 +2209,15 @@ sub change { # changed from this package. $cust_pkg = $opt->{'cust_pkg'}; - foreach ( qw( pkgnum pkgpart locationnum ) ) { - $cust_pkg->set("change_$_", $self->get($_)); + # follow all the above rules for date changes, etc. + foreach (keys %hash) { + $cust_pkg->set($_, $hash{$_}); + } + # except those that implement the future package change behavior + foreach (qw(change_to_pkgnum start_date expire)) { + $cust_pkg->set($_, ''); } - $cust_pkg->set('change_date', $time); + $error = $cust_pkg->replace; } else { @@ -1849,7 +2239,9 @@ sub change { } # Transfer services and cancel old package. - + # Enforce service limits only if this is a pkgpart change. + local $FS::cust_svc::ignore_quantity; + $FS::cust_svc::ignore_quantity = 1 if $same_pkgpart; $error = $self->transfer($cust_pkg); if ($error and $error == 0) { # $old_pkg->transfer failed. @@ -2021,6 +2413,7 @@ sub change { unused_credit => $unused_credit, nobill => $keep_dates, change_custnum => ( $self->custnum != $custnum ? $custnum : '' ), + no_delay_cancel => 1, ); if ($error) { $dbh->rollback if $oldAutoCommit; @@ -2069,8 +2462,10 @@ The date for the package change. Required, and must be in the future. =item quantity -The pkgpart. locationnum, and quantity of the new package, with the same -meaning as in C. +=item contract_end + +The pkgpart, locationnum, quantity and optional contract_end of the new +package, with the same meaning as in C. =back @@ -2080,6 +2475,10 @@ sub change_later { my $self = shift; my $opt = ref($_[0]) ? shift : { @_ }; + # check contract_end, prevent adding/removing + my $error = $self->_check_change($opt); + return $error if $error; + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -2093,8 +2492,6 @@ sub change_later { 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'} @@ -2103,7 +2500,9 @@ sub change_later { if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum; my $new_quantity = $opt->{'quantity'} if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity; - if ( $new_pkgpart or $new_locationnum or $new_quantity ) { + my $new_contract_end = $opt->{'contract_end'} + if $opt->{'contract_end'} and $opt->{'contract_end'} != $change_to->contract_end; + if ( $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end ) { # it hasn't been billed yet, so in principle we could just edit # it in place (w/o a package change), but that's bad form. # So change the package according to the new options... @@ -2118,8 +2517,10 @@ sub change_later { $error = $self->replace || $err_or_pkg->replace || - $change_to->cancel || - $change_to->delete; + #because change() might've edited existing scheduled change in place + (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' : + $change_to->cancel('no_delay_cancel' => 1) || + $change_to->delete); } else { $error = $err_or_pkg; } @@ -2143,8 +2544,10 @@ sub change_later { if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum; my $new_quantity = $opt->{'quantity'} if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity; + my $new_contract_end = $opt->{'contract_end'} + if $opt->{'contract_end'} and $opt->{'contract_end'} != $self->contract_end; - return '' unless $new_pkgpart or $new_locationnum or $new_quantity; # wouldn't do anything + return '' unless $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end; # wouldn't do anything # allow $opt->{'locationnum'} = '' to specifically set it to null # (i.e. customer default location) @@ -2155,7 +2558,7 @@ sub change_later { locationnum => $opt->{'locationnum'}, start_date => $date, map { $_ => ( $opt->{$_} || $self->$_() ) } - qw( pkgpart quantity refnum salesnum ) + qw( pkgpart quantity refnum salesnum contract_end ) } ); $error = $new->insert('change' => 1, 'allow_pkgpart' => ($new_pkgpart ? 0 : 1)); @@ -2181,16 +2584,28 @@ Cancels a future package change scheduled by C. sub abort_change { my $self = shift; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + 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; + $error = $self->replace; + if ( $change_to ) { + $error ||= $change_to->cancel || $change_to->delete; + } + + if ( $oldAutoCommit ) { + if ( $error ) { + dbh->rollback; + } else { + dbh->commit; + } + } + + return $error; } =item set_quantity QUANTITY @@ -2238,6 +2653,7 @@ 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 +- separate_bill: whether to put the charge on a separate invoice If you pass 'adjust_commission' => 1, and the classnum changes, and there are commission credits linked to this charge, they will be recalculated. @@ -2262,14 +2678,27 @@ sub modify_charge { } 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]; + 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{'additional_count'} = $i if $i > 0; } + $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'} ) @@ -2280,44 +2709,82 @@ sub modify_charge { } if ( !$self->get('setup') ) { - # not yet billed, so allow amount and quantity + # not yet billed, so allow amount, setup_cost, quantity, start_date, + # and separate_bill + + if ( exists($opt{'amount'}) + and $part_pkg->option('setup_fee') != $opt{'amount'} + and $opt{'amount'} > 0 ) { + + $pkg_opt{'setup_fee'} = $opt{'amount'}; + $pkg_opt_modified = 1; + } + + if ( exists($opt{'setup_cost'}) + and $part_pkg->setup_cost != $opt{'setup_cost'} + and $opt{'setup_cost'} > 0 ) { + + $part_pkg->set('setup_cost', $opt{'setup_cost'}); + } + if ( exists($opt{'quantity'}) and $opt{'quantity'} != $self->quantity and $opt{'quantity'} > 0 ) { $self->set('quantity', $opt{'quantity'}); } + if ( exists($opt{'start_date'}) and $opt{'start_date'} != $self->start_date ) { $self->set('start_date', $opt{'start_date'}); } - if ($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 ) { + if ( exists($opt{'separate_bill'}) + and $opt{'separate_bill'} ne $self->separate_bill ) { - $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'}) - ); + $self->set('separate_bill', $opt{'separate_bill'}); } + + } # 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 ( exists($opt{'taxclass'}) + and $part_pkg->taxclass ne $opt{'taxclass'}) { + + $part_pkg->set('taxclass', $opt{'taxclass'}); + } + + my $error; + if ( $part_pkg->modified or $pkg_opt_modified ) { + # can we safely modify the package def? + # 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 @@ -2386,12 +2853,10 @@ sub modify_charge { -use Storable 'thaw'; -use MIME::Base64; use Data::Dumper; sub process_bulk_cust_pkg { my $job = shift; - my $param = thaw(decode_base64(shift)); + my $param = shift; warn Dumper($param) if $DEBUG; my $old_part_pkg = qsearchs('part_pkg', @@ -2671,7 +3136,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 @@ -2688,22 +3153,44 @@ 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 $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql"; - $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql"; - $sth->fetchrow_arrayref->[0]; + my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where; + $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0]; } -=item part_pkg_currency_option OPTIONNAME +=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(@args) or die $sth->errstr. " executing $sql"; + $sth; +} + +=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 @@ -2752,7 +3239,7 @@ sub cust_svc_unsorted { sub cust_svc_unsorted_arrayref { my $self = shift; - return () unless $self->num_cust_svc(@_); + return [] unless $self->num_cust_svc(@_); my %opt = (); if ( @_ && $_[0] =~ /^\d+/ ) { @@ -2808,12 +3295,16 @@ sub h_cust_svc { if $DEBUG; my ($end, $start, $mode) = @_; + + local($FS::Record::qsearch_qualify_columns) = 0; + my @cust_svc = $self->_sort_cust_svc( [ qsearch( 'h_cust_svc', { 'pkgnum' => $self->pkgnum, }, FS::h_cust_svc->sql_h_search(@_), ) ] ); + if ( defined($mode) && $mode eq 'I' ) { my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc; return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc; @@ -2898,28 +3389,33 @@ Returns a list of FS::part_svc objects representing services included in this package but not yet provisioned. Each FS::part_svc object also has an extra field, I, which specifies the number of available services. +Accepts option I; if true, only returns part_svc for which the +associated pkg_svc has the provision_hold flag set. + =cut sub available_part_svc { my $self = shift; + my %opt = @_; my $pkg_quantity = $self->quantity || 1; grep { $_->num_avail > 0 } - map { - my $part_svc = $_->part_svc; - $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking - $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart); - - # more evil encapsulation breakage - if($part_svc->{'Hash'}{'num_avail'} > 0) { - my @exports = $part_svc->part_export_did; - $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports); - } - - $part_svc; - } - $self->part_pkg->pkg_svc; + map { + my $part_svc = $_->part_svc; + $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking + $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart); + + # more evil encapsulation breakage + if ($part_svc->{'Hash'}{'num_avail'} > 0) { + my @exports = $part_svc->part_export_did; + $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports); + } + + $part_svc; + } + grep { $opt{'provision_hold'} ? $_->provision_hold : 1 } + $self->part_pkg->pkg_svc; } =item part_svc [ OPTION => VALUE ... ] @@ -2930,17 +3426,35 @@ following extra fields: =over 4 -=item num_cust_svc (count) +=item num_cust_svc + +(count) -=item num_avail (quantity - count) +=item num_avail -=item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects +(quantity - count) + +=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 @@ -2969,16 +3483,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; @@ -3045,6 +3561,8 @@ Returns a short status string for this package, currently: =over 4 +=item on hold + =item not yet billed =item one-time charge @@ -3065,6 +3583,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|$)/; @@ -3091,8 +3610,9 @@ Class method that returns the list of possible status strings for packages =cut tie my %statuscolor, 'Tie::IxHash', + 'on hold' => 'FF00F5', #brighter purple! 'not yet billed' => '009999', #teal? cyan? - 'one-time charge' => '000000', + 'one-time charge' => '0000CC', #blue #'000000', 'active' => '00CC00', 'suspended' => 'FF9900', 'cancelled' => 'FF0000', @@ -3105,6 +3625,11 @@ sub statuses { keys %statuscolor; } +sub statuscolors { + #my $self = shift; + \%statuscolor; +} + =item statuscolor Returns a hex triplet color string for this package's status. @@ -3116,6 +3641,40 @@ sub statuscolor { $statuscolor{$self->status}; } +=item is_status_delay_cancel + +Returns true if part_pkg has option delay_cancel, +cust_pkg status is 'suspended' and expire is set +to cancel package within the next day (or however +many days are set in global config part_pkg-delay_cancel-days. + +Accepts option I which should be +the value of the config setting, to avoid looking it up again. + +This is not a real status, this only meant for hacking display +values, because otherwise treating the package as suspended is +really the whole point of the delay_cancel option. + +=cut + +sub is_status_delay_cancel { + my ($self,%opt) = @_; + if ( $self->main_pkgnum and $self->pkglinknum ) { + return $self->main_pkg->is_status_delay_cancel; + } + return 0 unless $self->part_pkg->option('delay_cancel',1); + return 0 unless $self->status eq 'suspended'; + return 0 unless $self->expire; + my $expdays = $opt{'part_pkg-delay_cancel-days'}; + unless ($expdays) { + my $conf = new FS::Conf; + $expdays = $conf->config('part_pkg-delay_cancel-days') || 1; + } + my $expsecs = 60*60*24*$expdays; + return 0 unless $self->expire < time + $expsecs; + return 1; +} + =item pkg_label Returns a label for this package. (Currently "pkgnum: pkg - comment" or @@ -3365,7 +3924,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 @@ -3506,7 +4074,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) { @@ -3734,7 +4302,7 @@ sub insert_reason { $reasonnum = $reason->reasonnum; } else { - return "Unparsable reason: ". $options{'reason'}; + return "Unparseable reason: ". $options{'reason'}; } my $cust_pkg_reason = @@ -3935,7 +4503,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; @@ -4135,6 +4703,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 @@ -4148,6 +4731,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 "; } @@ -4173,6 +4757,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' @@ -4180,519 +4765,6 @@ sub status_sql { 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. - -=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 - -sub search { - my ($class, $params) = @_; - my @where = (); - - ## - # parse agent - ## - - if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) { - push @where, - "cust_main.agentnum = $1"; - } - - ## - # 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 - ## - - 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'"; - } - } - - ### - # 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 ( 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 @@ -4854,6 +4926,9 @@ sub _X_show_zero { =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ] +Bulk cancel + order subroutine. Perhaps slightly deprecated, only used by the +bulk cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi) + CUSTNUM is a customer (see L) PKGPARTS is a list of pkgparts specifying the the billing item definitions (see @@ -4990,7 +5065,7 @@ sub order { $dbh->rollback if $oldAutoCommit; return "Unable to transfer all services from package ".$old_pkg->pkgnum; } - $error = $old_pkg->cancel( quiet=>1 ); + $error = $old_pkg->cancel( quiet=>1, 'no_delay_cancel'=>1 ); if ($error) { $dbh->rollback; return $error; @@ -5053,6 +5128,78 @@ sub bulk_change { ''; } +=item forward_emails + +Returns a hash of svcnums and corresponding email addresses +for svc_acct services that can be used as source or dest +for svc_forward services provisioned in this package. + +Accepts options I OR I for a svc_forward +service; if included, will ensure the current values of the +specified service are included in the list, even if for some +other reason they wouldn't be. If called as a class method +with a specified service, returns only these current values. + +Caution: does not actually check if svc_forward services are +available to be provisioned on this package. + +=cut + +sub forward_emails { + my $self = shift; + my %opt = @_; + + #load optional service, thoroughly validated + die "Use svcnum or svc_forward, not both" + if $opt{'svcnum'} && $opt{'svc_forward'}; + my $svc_forward = $opt{'svc_forward'}; + $svc_forward ||= qsearchs('svc_forward',{ 'svcnum' => $opt{'svcnum'} }) + if $opt{'svcnum'}; + die "Specified service is not a forward service" + if $svc_forward && (ref($svc_forward) ne 'FS::svc_forward'); + die "Specified service not found" + if ($opt{'svcnum'} || $opt{'svc_forward'}) && !$svc_forward; + + my %email; + + ## everything below was basically copied from httemplate/edit/svc_forward.cgi + ## with minimal refactoring, not sure why we can't just load all svc_accts for this custnum + + #add current values from specified service, if there was one + if ($svc_forward) { + foreach my $method (qw( srcsvc_acct dstsvc_acct )) { + my $svc_acct = $svc_forward->$method(); + $email{$svc_acct->svcnum} = $svc_acct->email if $svc_acct; + } + } + + if (ref($self) eq 'FS::cust_pkg') { + + #and including the rest for this customer + my($u_part_svc,@u_acct_svcparts); + foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) { + push @u_acct_svcparts,$u_part_svc->getfield('svcpart'); + } + + my $custnum = $self->getfield('custnum'); + foreach my $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) { + my $cust_pkgnum = $i_cust_pkg->getfield('pkgnum'); + #now find the corresponding record(s) in cust_svc (for this pkgnum!) + foreach my $acct_svcpart (@u_acct_svcparts) { + foreach my $i_cust_svc ( + qsearch( 'cust_svc', { 'pkgnum' => $cust_pkgnum, + 'svcpart' => $acct_svcpart } ) + ) { + my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $i_cust_svc->svcnum } ); + $email{$svc_acct->svcnum} = $svc_acct->email; + } + } + } + } + + return %email; +} + # Used by FS::Upgrade to migrate to a new database. sub _upgrade_data { # class method my ($class, %opts) = @_; @@ -5076,6 +5223,23 @@ sub _upgrade_data { # class method my $sth = dbh->prepare($sql); $sth->execute or die $sth->errstr; } + + # RT31194: supplemental package links that are deleted don't clean up + # linked records + my @pkglinknums = qsearch({ + 'select' => 'DISTINCT cust_pkg.pkglinknum', + 'table' => 'cust_pkg', + 'addl_from' => ' LEFT JOIN part_pkg_link USING (pkglinknum) ', + 'extra_sql' => ' WHERE cust_pkg.pkglinknum IS NOT NULL + AND part_pkg_link.pkglinknum IS NULL', + }); + foreach (@pkglinknums) { + my $pkglinknum = $_->pkglinknum; + warn "cleaning part_pkg_link #$pkglinknum\n"; + my $part_pkg_link = FS::part_pkg_link->new({pkglinknum => $pkglinknum}); + my $error = $part_pkg_link->remove_linked; + die $error if $error; + } } =back