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   #still can't fill in an action?  don't abort the upgrade
 220   local($ignore_empty_action) = 1;
 221
 222   $class->_upgrade_otaker(%opts);
 223
 224 }
 225
 226 sub _upgrade_missing_reason {
 227   my ($class, %opts) = @_;
 228
 229   #false laziness w/above
 230   my $action_replace =
 231     " AND ( history_action = 'replace_old' OR history_action = 'replace_new' )";
 232
 233   #seek expirations/adjourns without reason
 234   foreach my $field (qw( expire adjourn cancel susp )) {
 235     my $addl_from =
 236       "LEFT JOIN h_cust_pkg ON ".
 237       "(cust_pkg_reason.pkgnum = h_cust_pkg.pkgnum AND".
 238       " cust_pkg_reason.date = h_cust_pkg.$field AND".
 239       " history_action = 'replace_new')";
 240
 241     my $extra_sql = 'AND h_cust_pkg.pkgnum IS NULL';
 242
 243     my @unmigrated = qsearch({ table   => 'cust_pkg_reason',
 244                                hashref => { action => uc(substr($field,0,1)) },
 245                                addl_from => $addl_from,
 246                                select    => 'cust_pkg_reason.*',
 247                                extra_sql => $extra_sql,
 248                             });
 249     foreach ( @unmigrated ) {
 250
 251       my $hashref = { pkgnum => $_->pkgnum,
 252                       history_date   => $_->date,
 253                     };
 254
 255       my @history = qsearch({ table     => 'h_cust_pkg',
 256                               hashref   => $hashref,
 257                               extra_sql => $action_replace,
 258                               order_by  => 'ORDER BY history_action',
 259                            });
 260
 261       my $fuzz = 0;
 262       while (scalar(@history) < 2 && $fuzz < 3) {
 263         $hashref->{history_date}++;
 264         $fuzz++;
 265         push @history, qsearch({ table    => 'h_cust_pkg',
 266                                  hashref  => $hashref,
 267                                  extra_sql => $action_replace,
 268                                  order_by => 'ORDER BY history_action',
 269                               });
 270       }
 271
 272       next unless scalar(@history) == 2;
 273
 274       my @new = grep { $_->history_action eq 'replace_new' } @history;
 275       my @old = grep { $_->history_action eq 'replace_old' } @history;
 276
 277       next if (scalar(@new) == 2 || scalar(@old) == 2);
 278
 279       $_->date($new[0]->get($field))
 280         if ( $new[0]->get($field) &&
 281              ( !$old[0]->get($field) ||
 282                 $old[0]->get($field) != $new[0]->get($field)
 283              )
 284            );
 285
 286       my $error = $_->replace
 287         if $_->modified;
 288
 289       die $error if $error;
 290     }
 291   }
 292
 293   #seek cancels/suspends without reason, but with expire/adjourn reason
 294   foreach my $field (qw( cancel susp )) {
 295
 296     my %precursor_map = ( 'cancel' => 'expire', 'susp' => 'adjourn' );
 297     my $precursor = $precursor_map{$field};
 298     my $preaction = uc(substr($precursor,0,1));
 299     my $action    = uc(substr($field,0,1));
 300     my $addl_from =
 301       "LEFT JOIN cust_pkg_reason ON ".
 302       "(cust_pkg.pkgnum = cust_pkg_reason.pkgnum AND".
 303       " cust_pkg.$precursor = cust_pkg_reason.date AND".
 304       " cust_pkg_reason.action = '$preaction') ".
 305       "LEFT JOIN cust_pkg_reason AS target ON ".
 306       "(cust_pkg.pkgnum = target.pkgnum AND".
 307       " cust_pkg.$field = target.date AND".
 308       " target.action = '$action')"
 309     ;
 310
 311     my $extra_sql = "WHERE target.pkgnum IS NULL AND ".
 312                     "cust_pkg.$field IS NOT NULL AND ".
 313                     "cust_pkg.$field < cust_pkg.$precursor + 86400 AND ".
 314                     "cust_pkg_reason.action = '$preaction'";
 315
 316     my @unmigrated = qsearch({ table     => 'cust_pkg',
 317                                hashref   => { },
 318                                select    => 'cust_pkg.*',
 319                                addl_from => $addl_from,
 320                                extra_sql => $extra_sql,
 321                             });
 322     foreach ( @unmigrated ) {
 323       my $cpr = new FS::cust_pkg_reason { $_->last_cust_pkg_reason($precursor)->hash, 'num' => '' };
 324       $cpr->date($_->get($field));
 325       $cpr->action($action);
 326
 327       my $error = $cpr->insert;
 328       die $error if $error;
 329     }
 330   }
 331
 332 }
 333
 334 =back
 335
 336 =head1 BUGS
 337
 338 Here be termites.  Don't use on wooden computers.
 339
 340 =head1 SEE ALSO
 341
 342 L<FS::Record>, schema.html from the base documentation.
 343
 344 =cut
 345
 346 1;
 347