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