FS/FS/cust_pkg_reason.pm

   1 package FS::cust_pkg_reason;
   2
   3 use strict;
   4 use vars qw( $ignore_empty_action );
   5 use base qw( FS::otaker_Mixin FS::Record );
   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 =cut
 121
 122 sub reason {
 123   my $self = shift;
 124   qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
 125 }
 126
 127 =item reasontext
 128
 129 Returns the text of the reason (see L<FS::reason>) associated with this
 130 cust_pkg_reason.
 131
 132 =cut
 133
 134 sub reasontext {
 135   my $reason = shift->reason;
 136   $reason ? $reason->reason : '';
 137 }
 138
 139 # _upgrade_data
 140 #
 141 # Used by FS::Upgrade to migrate to a new database.
 142
 143 use FS::h_cust_pkg;
 144 use FS::h_cust_pkg_reason;
 145
 146 sub _upgrade_data { # class method
 147   my ($class, %opts) = @_;
 148
 149   my $action_replace =
 150     " AND ( history_action = 'replace_old' OR history_action = 'replace_new' )";
 151
 152   my $count = 0;
 153   my @unmigrated = qsearch('cust_pkg_reason', { 'action' => '' } );
 154   foreach ( @unmigrated ) {
 155
 156     my @history_cust_pkg_reason = qsearch( 'h_cust_pkg_reason', { $_->hash } );
 157
 158     next unless scalar(@history_cust_pkg_reason) == 1;
 159
 160     my $hashref = { pkgnum => $_->pkgnum,
 161                     history_date   => $history_cust_pkg_reason[0]->history_date,
 162                   };
 163
 164     my @history = qsearch({ table     => 'h_cust_pkg',
 165                             hashref   => $hashref,
 166                             extra_sql => $action_replace,
 167                             order_by  => 'ORDER BY history_action',
 168                          });
 169
 170     my $fuzz = 0;
 171     while (scalar(@history) < 2 && $fuzz < 3) {
 172       $hashref->{history_date}++;
 173       $fuzz++;
 174       push @history, qsearch({ table     => 'h_cust_pkg',
 175                                hashref   => $hashref,
 176                                extra_sql => $action_replace,
 177                                order_by  => 'ORDER BY history_action',
 178                             });
 179     }
 180
 181     next unless scalar(@history) == 2;
 182
 183     my @new = grep { $_->history_action eq 'replace_new' } @history;
 184     my @old = grep { $_->history_action eq 'replace_old' } @history;
 185
 186     next if (scalar(@new) == 2 || scalar(@old) == 2);
 187
 188     if ( !$old[0]->get('cancel') && $new[0]->get('cancel') ) {
 189       $_->action('C');
 190     }elsif( !$old[0]->susp && $new[0]->susp ){
 191       $_->action('S');
 192     }elsif( $new[0]->expire &&
 193             (!$old[0]->expire || !$old[0]->expire != $new[0]->expire )
 194           ){
 195       $_->action('E');
 196       $_->date($new[0]->expire);
 197     }elsif( $new[0]->adjourn &&
 198             (!$old[0]->adjourn || $old[0]->adjourn != $new[0]->adjourn )
 199           ){
 200       $_->action('A');
 201       $_->date($new[0]->adjourn);
 202     }
 203
 204     my $error = $_->replace
 205       if $_->modified;
 206
 207     die $error if $error;
 208
 209     $count++;
 210   }
 211
 212   #remove nullability if scalar(@migrated) - $count == 0 && ->column('action');
 213
 214   unless ( FS::upgrade_journal->is_done('cust_pkg_reason__missing_reason') ) {
 215     $class->_upgrade_missing_reason(%opts);
 216     FS::upgrade_journal->set_done('cust_pkg_reason__missing_reason');
 217   }
 218
 219   # Fix misplaced expire/suspend reasons due to package change (RT#71623).
 220   # These will look like:
 221   # - there is an expire reason linked to pkg1
 222   # - pkg1 has been canceled before the reason's date
 223   # - pkg2 was changed from pkg1, has an expire date equal to the reason's
 224   #   date, and has no expire reason (check this later)
 225
 226   my $error;
 227   foreach my $action ('expire', 'adjourn') {
 228     # Iterate this, because a package could be scheduled to expire, then
 229     # changed several times, and we need to walk the reason forward to the
 230     # last one.
 231     while(1) {
 232       my @reasons = qsearch(
 233         {
 234           select    => 'cust_pkg_reason.*',
 235           table     => 'cust_pkg_reason',
 236           addl_from => ' JOIN cust_pkg pkg1 USING (pkgnum)
 237                          JOIN cust_pkg pkg2 ON (pkg1.pkgnum = pkg2.change_pkgnum)',
 238           hashref   => { 'action' => uc(substr($action, 0, 1)) },
 239           extra_sql => " AND pkg1.cancel IS NOT NULL
 240                          AND cust_pkg_reason.date > pkg1.cancel
 241                          AND pkg2.$action = cust_pkg_reason.date"
 242         });
 243       last if !@reasons;
 244       warn "Checking ".scalar(@reasons)." possible misplaced $action reasons.\n";
 245       foreach my $cust_pkg_reason (@reasons) {
 246         my $new_pkg = qsearchs('cust_pkg', { change_pkgnum => $cust_pkg_reason->pkgnum });
 247         my $new_reason = $new_pkg->last_cust_pkg_reason($action);
 248         if ($new_reason and $new_reason->_date == $new_pkg->get($action)) {
 249           # the expiration reason has been recreated on the new package, so
 250           # just delete the old one
 251           warn "Cleaning $action reason from canceled pkg#" .
 252                $cust_pkg_reason->pkgnum . "\n";
 253           $error = $cust_pkg_reason->delete;
 254         } else {
 255           # then the old reason needs to be transferred
 256           warn "Moving $action reason from canceled pkg#" .
 257                $cust_pkg_reason->pkgnum .
 258                " to new pkg#" . $new_pkg->pkgnum ."\n";
 259           $cust_pkg_reason->set('pkgnum' => $new_pkg->pkgnum);
 260           $error = $cust_pkg_reason->replace;
 261         }
 262         die $error if $error;
 263       }
 264     }
 265   }
 266
 267   #still can't fill in an action?  don't abort the upgrade
 268   local($ignore_empty_action) = 1;
 269
 270   $class->_upgrade_otaker(%opts);
 271
 272 }
 273
 274 sub _upgrade_missing_reason {
 275   my ($class, %opts) = @_;
 276
 277   #false laziness w/above
 278   my $action_replace =
 279     " AND ( history_action = 'replace_old' OR history_action = 'replace_new' )";
 280
 281   #seek expirations/adjourns without reason
 282   foreach my $field (qw( expire adjourn cancel susp )) {
 283     my $addl_from =
 284       "LEFT JOIN h_cust_pkg ON ".
 285       "(cust_pkg_reason.pkgnum = h_cust_pkg.pkgnum AND".
 286       " cust_pkg_reason.date = h_cust_pkg.$field AND".
 287       " history_action = 'replace_new')";
 288
 289     my $extra_sql = 'AND h_cust_pkg.pkgnum IS NULL';
 290
 291     my @unmigrated = qsearch({ table   => 'cust_pkg_reason',
 292                                hashref => { action => uc(substr($field,0,1)) },
 293                                addl_from => $addl_from,
 294                                select    => 'cust_pkg_reason.*',
 295                                extra_sql => $extra_sql,
 296                             });
 297     foreach ( @unmigrated ) {
 298
 299       my $hashref = { pkgnum => $_->pkgnum,
 300                       history_date   => $_->date,
 301                     };
 302
 303       my @history = qsearch({ table     => 'h_cust_pkg',
 304                               hashref   => $hashref,
 305                               extra_sql => $action_replace,
 306                               order_by  => 'ORDER BY history_action',
 307                            });
 308
 309       my $fuzz = 0;
 310       while (scalar(@history) < 2 && $fuzz < 3) {
 311         $hashref->{history_date}++;
 312         $fuzz++;
 313         push @history, qsearch({ table    => 'h_cust_pkg',
 314                                  hashref  => $hashref,
 315                                  extra_sql => $action_replace,
 316                                  order_by => 'ORDER BY history_action',
 317                               });
 318       }
 319
 320       next unless scalar(@history) == 2;
 321
 322       my @new = grep { $_->history_action eq 'replace_new' } @history;
 323       my @old = grep { $_->history_action eq 'replace_old' } @history;
 324
 325       next if (scalar(@new) == 2 || scalar(@old) == 2);
 326
 327       $_->date($new[0]->get($field))
 328         if ( $new[0]->get($field) &&
 329              ( !$old[0]->get($field) ||
 330                 $old[0]->get($field) != $new[0]->get($field)
 331              )
 332            );
 333
 334       my $error = $_->replace
 335         if $_->modified;
 336
 337       die $error if $error;
 338     }
 339   }
 340
 341   #seek cancels/suspends without reason, but with expire/adjourn reason
 342   foreach my $field (qw( cancel susp )) {
 343
 344     my %precursor_map = ( 'cancel' => 'expire', 'susp' => 'adjourn' );
 345     my $precursor = $precursor_map{$field};
 346     my $preaction = uc(substr($precursor,0,1));
 347     my $action    = uc(substr($field,0,1));
 348     my $addl_from =
 349       "LEFT JOIN cust_pkg_reason ON ".
 350       "(cust_pkg.pkgnum = cust_pkg_reason.pkgnum AND".
 351       " cust_pkg.$precursor = cust_pkg_reason.date AND".
 352       " cust_pkg_reason.action = '$preaction') ".
 353       "LEFT JOIN cust_pkg_reason AS target ON ".
 354       "(cust_pkg.pkgnum = target.pkgnum AND".
 355       " cust_pkg.$field = target.date AND".
 356       " target.action = '$action')"
 357     ;
 358
 359     my $extra_sql = "WHERE target.pkgnum IS NULL AND ".
 360                     "cust_pkg.$field IS NOT NULL AND ".
 361                     "cust_pkg.$field < cust_pkg.$precursor + 86400 AND ".
 362                     "cust_pkg_reason.action = '$preaction'";
 363
 364     my @unmigrated = qsearch({ table     => 'cust_pkg',
 365                                hashref   => { },
 366                                select    => 'cust_pkg.*',
 367                                addl_from => $addl_from,
 368                                extra_sql => $extra_sql,
 369                             });
 370     foreach ( @unmigrated ) {
 371       my $cpr = new FS::cust_pkg_reason { $_->last_cust_pkg_reason($precursor)->hash, 'num' => '' };
 372       $cpr->date($_->get($field));
 373       $cpr->action($action);
 374
 375       my $error = $cpr->insert;
 376       die $error if $error;
 377     }
 378   }
 379
 380 }
 381
 382 =back
 383
 384 =head1 BUGS
 385
 386 =head1 SEE ALSO
 387
 388 L<FS::Record>, schema.html from the base documentation.
 389
 390 =cut
 391
 392 1;
 393