FS/FS/cust_pkg_reason.pm

   1 package FS::cust_pkg_reason;
   2 use base qw( FS::otaker_Mixin FS::Record );
   3
   4 use strict;
   5 use vars qw( $ignore_empty_action );
   6 use FS::Record qw( qsearch qsearchs );
   7 use FS::upgrade_journal;
   8
   9 $ignore_empty_action = 0;
  10
  11 =head1 NAME
  12
  13 FS::cust_pkg_reason - Object methods for cust_pkg_reason records
  14
  15 =head1 SYNOPSIS
  16
  17   use FS::cust_pkg_reason;
  18
  19   $record = new FS::cust_pkg_reason \%hash;
  20   $record = new FS::cust_pkg_reason { 'column' => 'value' };
  21
  22   $error = $record->insert;
  23
  24   $error = $new_record->replace($old_record);
  25
  26   $error = $record->delete;
  27
  28   $error = $record->check;
  29
  30 =head1 DESCRIPTION
  31
  32 An FS::cust_pkg_reason object represents a relationship between a cust_pkg
  33 and a reason, for example cancellation or suspension reasons.
  34 FS::cust_pkg_reason inherits from FS::Record.  The following fields are
  35 currently supported:
  36
  37 =over 4
  38
  39 =item num
  40
  41 primary key
  42
  43 =item pkgnum
  44
  45 =item reasonnum
  46
  47 =item usernum
  48
  49 =item date
  50
  51 =back
  52
  53 =head1 METHODS
  54
  55 =over 4
  56
  57 =item new HASHREF
  58
  59 Creates a new cust_pkg_reason.  To add the example to the database, see
  60 L<"insert">.
  61
  62 Note that this stores the hash reference, not a distinct copy of the hash it
  63 points to.  You can ask the object for a copy with the I<hash> method.
  64
  65 =cut
  66
  67 sub table { 'cust_pkg_reason'; }
  68
  69 =item insert
  70
  71 Adds this record to the database.  If there is an error, returns the error,
  72 otherwise returns false.
  73
  74 =cut
  75
  76 =item delete
  77
  78 Delete this record from the database.
  79
  80 =cut
  81
  82 =item replace OLD_RECORD
  83
  84 Replaces the OLD_RECORD with this one in the database.  If there is an error,
  85 returns the error, otherwise returns false.
  86
  87 =cut
  88
  89 =item check
  90
  91 Checks all fields to make sure this is a valid cust_pkg_reason.  If there is
  92 an error, returns the error, otherwise returns false.  Called by the insert
  93 and replace methods.
  94
  95 =cut
  96
  97 sub check {
  98   my $self = shift;
  99
 100   my @actions = ( 'A', 'C', 'E', 'S' );
 101   push @actions, '' if $ignore_empty_action;
 102
 103   my $error =
 104     $self->ut_numbern('num')
 105     || $self->ut_number('pkgnum')
 106     || $self->ut_number('reasonnum')
 107     || $self->ut_enum('action', \@actions)
 108     || $self->ut_alphan('otaker')
 109     || $self->ut_numbern('date')
 110   ;
 111   return $error if $error;
 112
 113   $self->SUPER::check;
 114 }
 115
 116 =item reason
 117
 118 Returns the reason (see L<FS::reason>) associated with this cust_pkg_reason.
 119
 120 =item reasontext
 121
 122 Returns the text of the reason (see L<FS::reason>) associated with this
 123 cust_pkg_reason.
 124
 125 =cut
 126
 127 sub reasontext {
 128   my $reason = shift->reason;
 129   $reason ? $reason->reason : '';
 130 }
 131
 132 # _upgrade_data
 133 #
 134 # Used by FS::Upgrade to migrate to a new database.
 135
 136 use FS::h_cust_pkg;
 137 use FS::h_cust_pkg_reason;
 138
 139 sub _upgrade_data { # class method
 140   my ($class, %opts) = @_;
 141
 142   my $action_replace =
 143     " AND ( history_action = 'replace_old' OR history_action = 'replace_new' )";
 144
 145   my $count = 0;
 146   my @unmigrated = qsearch('cust_pkg_reason', { 'action' => '' } );
 147   foreach ( @unmigrated ) {
 148
 149     my @history_cust_pkg_reason = qsearch( 'h_cust_pkg_reason', { $_->hash } );
 150
 151     next unless scalar(@history_cust_pkg_reason) == 1;
 152
 153     my $hashref = { pkgnum => $_->pkgnum,
 154                     history_date   => $history_cust_pkg_reason[0]->history_date,
 155                   };
 156
 157     my @history = qsearch({ table     => 'h_cust_pkg',
 158                             hashref   => $hashref,
 159                             extra_sql => $action_replace,
 160                             order_by  => 'ORDER BY history_action',
 161                          });
 162
 163     my $fuzz = 0;
 164     while (scalar(@history) < 2 && $fuzz < 3) {
 165       $hashref->{history_date}++;
 166       $fuzz++;
 167       push @history, qsearch({ table     => 'h_cust_pkg',
 168                                hashref   => $hashref,
 169                                extra_sql => $action_replace,
 170                                order_by  => 'ORDER BY history_action',
 171                             });
 172     }
 173
 174     next unless scalar(@history) == 2;
 175
 176     my @new = grep { $_->history_action eq 'replace_new' } @history;
 177     my @old = grep { $_->history_action eq 'replace_old' } @history;
 178
 179     next if (scalar(@new) == 2 || scalar(@old) == 2);
 180
 181     if ( !$old[0]->get('cancel') && $new[0]->get('cancel') ) {
 182       $_->action('C');
 183     }elsif( !$old[0]->susp && $new[0]->susp ){
 184       $_->action('S');
 185     }elsif( $new[0]->expire &&
 186             (!$old[0]->expire || !$old[0]->expire != $new[0]->expire )
 187           ){
 188       $_->action('E');
 189       $_->date($new[0]->expire);
 190     }elsif( $new[0]->adjourn &&
 191             (!$old[0]->adjourn || $old[0]->adjourn != $new[0]->adjourn )
 192           ){
 193       $_->action('A');
 194       $_->date($new[0]->adjourn);
 195     }
 196
 197     my $error = $_->replace
 198       if $_->modified;
 199
 200     die $error if $error;
 201
 202     $count++;
 203   }
 204
 205   #remove nullability if scalar(@migrated) - $count == 0 && ->column('action');
 206
 207   unless ( FS::upgrade_journal->is_done('cust_pkg_reason__missing_reason') ) {
 208     $class->_upgrade_missing_reason(%opts);
 209     FS::upgrade_journal->set_done('cust_pkg_reason__missing_reason');
 210   }
 211
 212   # Fix misplaced expire/suspend reasons due to package change (RT#71623).
 213   # These will look like:
 214   # - there is an expire reason linked to pkg1
 215   # - pkg1 has been canceled before the reason's date
 216   # - pkg2 was changed from pkg1, has an expire date equal to the reason's
 217   #   date, and has no expire reason (check this later)
 218
 219   my $error;
 220   foreach my $action ('expire', 'adjourn') {
 221     # Iterate this, because a package could be scheduled to expire, then
 222     # changed several times, and we need to walk the reason forward to the
 223     # last one.
 224     while(1) {
 225       my @reasons = qsearch(
 226         {
 227           select    => 'cust_pkg_reason.*',
 228           table     => 'cust_pkg_reason',
 229           addl_from => ' JOIN cust_pkg pkg1 USING (pkgnum)
 230                          JOIN cust_pkg pkg2 ON (pkg1.pkgnum = pkg2.change_pkgnum)',
 231           hashref   => { 'action' => uc(substr($action, 0, 1)) },
 232           extra_sql => " AND pkg1.cancel IS NOT NULL
 233                          AND cust_pkg_reason.date > pkg1.cancel
 234                          AND pkg2.$action = cust_pkg_reason.date"
 235         });
 236       last if !@reasons;
 237       warn "Checking ".scalar(@reasons)." possible misplaced $action reasons.\n";
 238       foreach my $cust_pkg_reason (@reasons) {
 239         my $new_pkg = qsearchs('cust_pkg', { change_pkgnum => $cust_pkg_reason->pkgnum });
 240         my $new_reason = $new_pkg->last_cust_pkg_reason($action);
 241         if ($new_reason and $new_reason->_date == $new_pkg->get($action)) {
 242           # the expiration reason has been recreated on the new package, so
 243           # just delete the old one
 244           warn "Cleaning $action reason from canceled pkg#" .
 245                $cust_pkg_reason->pkgnum . "\n";
 246           $error = $cust_pkg_reason->delete;
 247         } else {
 248           # then the old reason needs to be transferred
 249           warn "Moving $action reason from canceled pkg#" .
 250                $cust_pkg_reason->pkgnum .
 251                " to new pkg#" . $new_pkg->pkgnum ."\n";
 252           $cust_pkg_reason->set('pkgnum' => $new_pkg->pkgnum);
 253           $error = $cust_pkg_reason->replace;
 254         }
 255         die $error if $error;
 256       }
 257     }
 258   }
 259
 260   #still can't fill in an action?  don't abort the upgrade
 261   local($ignore_empty_action) = 1;
 262
 263   $class->_upgrade_otaker(%opts);
 264
 265 }
 266
 267 sub _upgrade_missing_reason {
 268   my ($class, %opts) = @_;
 269
 270   #false laziness w/above
 271   my $action_replace =
 272     " AND ( history_action = 'replace_old' OR history_action = 'replace_new' )";
 273
 274   #seek expirations/adjourns without reason
 275   foreach my $field (qw( expire adjourn cancel susp )) {
 276     my $addl_from =
 277       "LEFT JOIN h_cust_pkg ON ".
 278       "(cust_pkg_reason.pkgnum = h_cust_pkg.pkgnum AND".
 279       " cust_pkg_reason.date = h_cust_pkg.$field AND".
 280       " history_action = 'replace_new')";
 281
 282     my $extra_sql = 'AND h_cust_pkg.pkgnum IS NULL';
 283
 284     my @unmigrated = qsearch({ table   => 'cust_pkg_reason',
 285                                hashref => { action => uc(substr($field,0,1)) },
 286                                addl_from => $addl_from,
 287                                select    => 'cust_pkg_reason.*',
 288                                extra_sql => $extra_sql,
 289                             });
 290     foreach ( @unmigrated ) {
 291
 292       my $hashref = { pkgnum => $_->pkgnum,
 293                       history_date   => $_->date,
 294                     };
 295
 296       my @history = qsearch({ table     => 'h_cust_pkg',
 297                               hashref   => $hashref,
 298                               extra_sql => $action_replace,
 299                               order_by  => 'ORDER BY history_action',
 300                            });
 301
 302       my $fuzz = 0;
 303       while (scalar(@history) < 2 && $fuzz < 3) {
 304         $hashref->{history_date}++;
 305         $fuzz++;
 306         push @history, qsearch({ table    => 'h_cust_pkg',
 307                                  hashref  => $hashref,
 308                                  extra_sql => $action_replace,
 309                                  order_by => 'ORDER BY history_action',
 310                               });
 311       }
 312
 313       next unless scalar(@history) == 2;
 314
 315       my @new = grep { $_->history_action eq 'replace_new' } @history;
 316       my @old = grep { $_->history_action eq 'replace_old' } @history;
 317
 318       next if (scalar(@new) == 2 || scalar(@old) == 2);
 319
 320       $_->date($new[0]->get($field))
 321         if ( $new[0]->get($field) &&
 322              ( !$old[0]->get($field) ||
 323                 $old[0]->get($field) != $new[0]->get($field)
 324              )
 325            );
 326
 327       my $error = $_->replace
 328         if $_->modified;
 329
 330       die $error if $error;
 331     }
 332   }
 333
 334   #seek cancels/suspends without reason, but with expire/adjourn reason
 335   foreach my $field (qw( cancel susp )) {
 336
 337     my %precursor_map = ( 'cancel' => 'expire', 'susp' => 'adjourn' );
 338     my $precursor = $precursor_map{$field};
 339     my $preaction = uc(substr($precursor,0,1));
 340     my $action    = uc(substr($field,0,1));
 341     my $addl_from =
 342       "LEFT JOIN cust_pkg_reason ON ".
 343       "(cust_pkg.pkgnum = cust_pkg_reason.pkgnum AND".
 344       " cust_pkg.$precursor = cust_pkg_reason.date AND".
 345       " cust_pkg_reason.action = '$preaction') ".
 346       "LEFT JOIN cust_pkg_reason AS target ON ".
 347       "(cust_pkg.pkgnum = target.pkgnum AND".
 348       " cust_pkg.$field = target.date AND".
 349       " target.action = '$action')"
 350     ;
 351
 352     my $extra_sql = "WHERE target.pkgnum IS NULL AND ".
 353                     "cust_pkg.$field IS NOT NULL AND ".
 354                     "cust_pkg.$field < cust_pkg.$precursor + 86400 AND ".
 355                     "cust_pkg_reason.action = '$preaction'";
 356
 357     my @unmigrated = qsearch({ table     => 'cust_pkg',
 358                                hashref   => { },
 359                                select    => 'cust_pkg.*',
 360                                addl_from => $addl_from,
 361                                extra_sql => $extra_sql,
 362                             });
 363     foreach ( @unmigrated ) {
 364       my $cpr = new FS::cust_pkg_reason { $_->last_cust_pkg_reason($precursor)->hash, 'num' => '' };
 365       $cpr->date($_->get($field));
 366       $cpr->action($action);
 367
 368       my $error = $cpr->insert;
 369       die $error if $error;
 370     }
 371   }
 372
 373 }
 374
 375 =back
 376
 377 =head1 BUGS
 378
 379 =head1 SEE ALSO
 380
 381 L<FS::Record>, schema.html from the base documentation.
 382
 383 =cut
 384
 385 1;
 386