From 67cef14ba963b2dab906d5e67095c8d1d3de43b5 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 6 Nov 2014 16:37:24 -0800 Subject: [PATCH] clean up existing packages when changing supplemental package defs, #31194 --- FS/FS/cust_pkg.pm | 27 ++++++++++- FS/FS/part_pkg_link.pm | 128 +++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 151 insertions(+), 4 deletions(-) diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 16cecdfdb..e8e202e3d 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -795,7 +795,9 @@ sub cancel { my $error; # pass all suspend/cancel actions to the main package - if ( $self->main_pkgnum and !$options{'from_main'} ) { + # (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); } @@ -896,6 +898,12 @@ sub cancel { } $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} = ''; + } + my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace( $self, options => { $self->options } ); if ( $self->change_to_pkgnum ) { @@ -4710,6 +4718,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 diff --git a/FS/FS/part_pkg_link.pm b/FS/FS/part_pkg_link.pm index 9ce8e6a76..aee0131d2 100644 --- a/FS/FS/part_pkg_link.pm +++ b/FS/FS/part_pkg_link.pm @@ -2,8 +2,11 @@ package FS::part_pkg_link; use strict; use vars qw( @ISA ); -use FS::Record qw( qsearchs ); +use FS::Record qw( qsearchs qsearch dbh ); use FS::part_pkg; +use FS::cust_pkg; +use FS::reason; +use FS::reason_type; @ISA = qw(FS::Record); @@ -81,17 +84,136 @@ sub table { 'part_pkg_link'; } Adds this record to the database. If there is an error, returns the error, otherwise returns false. +If this is a supplemental package link, inserting it will order the +supplemental packages for any main packages that already exist. + =cut -# the insert method can be inherited from FS::Record +sub insert { + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $self = shift; + my $error = $self->SUPER::insert(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; + } + + if ( $self->link_type eq 'supp' ) { + # queue this? + my @main_pkgs = qsearch('cust_pkg', { + pkgpart => $self->src_pkgpart, + cancel => '', + }); + foreach my $main_pkg (@main_pkgs) { + # duplicates code in FS::cust_pkg::uncancel, sort of + my $supp_pkg = FS::cust_pkg->new({ + 'pkgpart' => $self->dst_pkgpart, + 'pkglinknum' => $self->pkglinknum, + 'main_pkgnum' => $main_pkg->pkgnum, + 'order_date' => time, + map { $_ => $main_pkg->get($_) } + qw( custnum locationnum pkgbatch + start_date setup expire adjourn contract_end bill susp + refnum discountnum waive_setup quantity + recur_show_zero setup_show_zero ) + }); + $error = $supp_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "$error (ordering new supplemental package to pkg#".$main_pkg->pkgnum.")" if $error; + } + } + + return $error if $error; + } + + return; +} =item delete Delete this record from the database. +If this is a supplemental package link, deleting it will set pkglinknum = null +for any related packages, and set those packages to expire on their next bill +date. + =cut -# the delete method can be inherited from FS::Record +my $cancel_reason_text = 'Supplemental package removed'; +my $cancel_reason_type = 'Cancel Reason'; + +sub delete { + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $self = shift; + + if ( $self->link_type eq 'supp' ) { + my $error = $self->remove_linked; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $error = $self->SUPER::delete(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $dbh->commit; + return; +} + +sub remove_linked { + my $self = shift; + my $pkglinknum = $self->pkglinknum; + my $error; + + # find linked packages + my @pkgs = qsearch('cust_pkg', { pkglinknum => $pkglinknum }); + warn "expiring ".scalar(@pkgs). + " linked packages from part_pkg_link #$pkglinknum\n"; + + my $reason = qsearchs('reason', { reason => $cancel_reason_text }); + if (!$reason) { + # upgrade/FS::Setup created this one automatically + my $reason_type = qsearchs('reason_type', + { type => $cancel_reason_type } + ) or die "default cancel reason type does not exist"; + + $reason = FS::reason->new({ + reason_type => $reason_type->typenum, + reason => $cancel_reason_text, + disabled => 'Y', + }); + $error = $reason->insert; + if ( $error ) { + return "$error (creating package cancel reason)"; + } + } + + foreach my $pkg (@pkgs) { + $pkg->set('pkglinknum' => ''); + if ( $pkg->get('cancel') ) { + # then just replace it to unlink the package from this object + $error = $pkg->replace; + } else { + $error = $pkg->cancel( + 'date' => $pkg->get('bill'), # cancel on next bill, or else now + 'reason' => $reason->reasonnum, + ); + } + if ( $error ) { + return "$error (scheduling package #".$pkg->pkgnum." for expiration)"; + } + } +} =item replace OLD_RECORD -- 2.11.0