477 report: detect errors and fix them more easily, #32499, from #24047

[freeside.git] / FS / FS / cust_pkg.pm

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 9a953ff..01ee36f 100644 (file)
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -801,7 +801,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);
   }
 
@@ -909,6 +911,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 ) {
@@ -1226,7 +1234,7 @@ Available options are:
 
 =over 4
 
-=item reason - can be set to a cancellation reason (see L<FS:reason>), 
+=item reason - can be set to a cancellation reason (see L<FS:reason>),
 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<FS::reason_type>
@@ -1323,6 +1331,16 @@ sub suspend {
     }
   }
 
+  # 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;
   if ( $date ) {
     $hash{'adjourn'} = $date;
@@ -1347,9 +1365,15 @@ sub suspend {
     return $error;
   }
 
-  unless ( $date ) {
+  unless ( $date ) { # then we are suspending now
+
     # credit remaining time if appropriate
-    if ( $self->part_pkg->option('unused_credit_suspend', 1) ) {
+    # (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;
@@ -3912,7 +3936,7 @@ sub insert_reason {
     $reasonnum = $reason->reasonnum;
 
   } else {
-    return "Unparsable reason: ". $options{'reason'};
+    return "Unparseable reason: ". $options{'reason'};
   }
 
   my $cust_pkg_reason =
@@ -4642,6 +4666,21 @@ sub search {
   }
 
   ###
+  # parse refnum (advertising source)
+  ###
+
+  if ( exists($params->{'refnum'}) ) {
+    my @refnum;
+    if (ref $params->{'refnum'}) {
+      @refnum = @{ $params->{'refnum'} };
+    } else {
+      @refnum = ( $params->{'refnum'} );
+    }
+    my $in = join(',', grep /^\d+$/, @refnum);
+    push @where, "refnum IN($in)" if length $in;
+  }
+
+  ###
   # parse package report options
   ###
 
@@ -4931,9 +4970,8 @@ sub search {
         'agentnum'  => $agentnum,
         'detail'    => 1
       );
-      my $row = $report->[$rownum]
+      my $pkgnums = $report->{detail}->[$rownum]
         or die "row $rownum is past the end of the report";
-      my $pkgnums = $row->[-1] || '0';
         # '0' so that if there are no pkgnums (empty string) it will create
         # a valid query that returns nothing
       warn "PKGNUMS:\n$pkgnums\n\n"; # XXX debug
@@ -5400,6 +5438,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