FS/FS/cust_pkg_reason.pm

   1 package FS::cust_pkg_reason;
   2
   3 use strict;
   4 use base qw( FS::otaker_Mixin FS::Record );
   5 use FS::Record qw( qsearch qsearchs );
   6
   7 =head1 NAME
   8
   9 FS::cust_pkg_reason - Object methods for cust_pkg_reason records
  10
  11 =head1 SYNOPSIS
  12
  13   use FS::cust_pkg_reason;
  14
  15   $record = new FS::cust_pkg_reason \%hash;
  16   $record = new FS::cust_pkg_reason { 'column' => 'value' };
  17
  18   $error = $record->insert;
  19
  20   $error = $new_record->replace($old_record);
  21
  22   $error = $record->delete;
  23
  24   $error = $record->check;
  25
  26 =head1 DESCRIPTION
  27
  28 An FS::cust_pkg_reason object represents a relationship between a cust_pkg
  29 and a reason, for example cancellation or suspension reasons.
  30 FS::cust_pkg_reason inherits from FS::Record.  The following fields are
  31 currently supported:
  32
  33 =over 4
  34
  35 =item num
  36
  37 primary key
  38
  39 =item pkgnum
  40
  41 =item reasonnum
  42
  43 =item usernum
  44
  45 =item date
  46
  47 =back
  48
  49 =head1 METHODS
  50
  51 =over 4
  52
  53 =item new HASHREF
  54
  55 Creates a new cust_pkg_reason.  To add the example to the database, see
  56 L<"insert">.
  57
  58 Note that this stores the hash reference, not a distinct copy of the hash it
  59 points to.  You can ask the object for a copy with the I<hash> method.
  60
  61 =cut
  62
  63 sub table { 'cust_pkg_reason'; }
  64
  65 =item insert
  66
  67 Adds this record to the database.  If there is an error, returns the error,
  68 otherwise returns false.
  69
  70 =cut
  71
  72 =item delete
  73
  74 Delete this record from the database.
  75
  76 =cut
  77
  78 =item replace OLD_RECORD
  79
  80 Replaces the OLD_RECORD with this one in the database.  If there is an error,
  81 returns the error, otherwise returns false.
  82
  83 =cut
  84
  85 =item check
  86
  87 Checks all fields to make sure this is a valid cust_pkg_reason.  If there is
  88 an error, returns the error, otherwise returns false.  Called by the insert
  89 and replace methods.
  90
  91 =cut
  92
  93 sub check {
  94   my $self = shift;
  95
  96   my $error =
  97     $self->ut_numbern('num')
  98     || $self->ut_number('pkgnum')
  99     || $self->ut_number('reasonnum')
 100     || $self->ut_enum('action', [ 'A', 'C', 'E', 'S' ])
 101     || $self->ut_alphan('otaker')
 102     || $self->ut_numbern('date')
 103   ;
 104   return $error if $error;
 105
 106   $self->SUPER::check;
 107 }
 108
 109 =item reason
 110
 111 Returns the reason (see L<FS::reason>) associated with this cust_pkg_reason.
 112
 113 =cut
 114
 115 sub reason {
 116   my $self = shift;
 117   qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
 118 }
 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 use FS::Schema qw(dbdef);
 139
 140 sub _upgrade_data { # class method
 141   my ($class, %opts) = @_;
 142
 143   return '' unless dbdef->table('cust_pkg_reason')->column('action');
 144
 145   my $action_replace =
 146     " AND ( history_action = 'replace_old' OR history_action = 'replace_new' )";
 147
 148   my $count = 0;
 149   my @unmigrated = qsearch('cust_pkg_reason', { 'action' => '' } );
 150   foreach ( @unmigrated ) {
 151
 152     my @history_cust_pkg_reason = qsearch( 'h_cust_pkg_reason', { $_->hash } );
 153
 154     next unless scalar(@history_cust_pkg_reason) == 1;
 155
 156     my $hashref = { pkgnum => $_->pkgnum,
 157                     history_date   => $history_cust_pkg_reason[0]->history_date,
 158                   };
 159
 160     my @history = qsearch({ table     => 'h_cust_pkg',
 161                             hashref   => $hashref,
 162                             extra_sql => $action_replace,
 163                             order_by  => 'ORDER BY history_action',
 164                          });
 165
 166     my $fuzz = 0;
 167     while (scalar(@history) < 2 && $fuzz < 3) {
 168       $hashref->{history_date}++;
 169       $fuzz++;
 170       push @history, qsearch({ table     => 'h_cust_pkg',
 171                                hashref   => $hashref,
 172                                extra_sql => $action_replace,
 173                                order_by  => 'ORDER BY history_action',
 174                             });
 175     }
 176
 177     next unless scalar(@history) == 2;
 178
 179     my @new = grep { $_->history_action eq 'replace_new' } @history;
 180     my @old = grep { $_->history_action eq 'replace_old' } @history;
 181
 182     next if (scalar(@new) == 2 || scalar(@old) == 2);
 183
 184     if ( !$old[0]->get('cancel') && $new[0]->get('cancel') ) {
 185       $_->action('C');
 186     }elsif( !$old[0]->susp && $new[0]->susp ){
 187       $_->action('S');
 188     }elsif( $new[0]->expire &&
 189             (!$old[0]->expire || !$old[0]->expire != $new[0]->expire )
 190           ){
 191       $_->action('E');
 192       $_->date($new[0]->expire);
 193     }elsif( $new[0]->adjourn &&
 194             (!$old[0]->adjourn || $old[0]->adjourn != $new[0]->adjourn )
 195           ){
 196       $_->action('A');
 197       $_->date($new[0]->adjourn);
 198     }
 199
 200     my $error = $_->replace
 201       if $_->modified;
 202
 203     die $error if $error;
 204
 205     $count++;
 206   }
 207
 208   #remove nullability if scalar(@migrated) - $count == 0 && ->column('action');
 209
 210   #seek expirations/adjourns without reason
 211   foreach my $field qw( expire adjourn cancel susp ) {
 212     my $addl_from =
 213       "LEFT JOIN h_cust_pkg ON ".
 214       "(cust_pkg_reason.pkgnum = h_cust_pkg.pkgnum AND".
 215       " cust_pkg_reason.date = h_cust_pkg.$field AND".
 216       " history_action = 'replace_new')";
 217
 218     my $extra_sql = 'AND h_cust_pkg.pkgnum IS NULL';
 219
 220     my @unmigrated = qsearch({ table   => 'cust_pkg_reason',
 221                                hashref => { action => uc(substr($field,0,1)) },
 222                                addl_from => $addl_from,
 223                                select    => 'cust_pkg_reason.*',
 224                                extra_sql => $extra_sql,
 225                             });
 226     foreach ( @unmigrated ) {
 227
 228       my $hashref = { pkgnum => $_->pkgnum,
 229                       history_date   => $_->date,
 230                     };
 231
 232       my @history = qsearch({ table     => 'h_cust_pkg',
 233                               hashref   => $hashref,
 234                               extra_sql => $action_replace,
 235                               order_by  => 'ORDER BY history_action',
 236                            });
 237
 238       my $fuzz = 0;
 239       while (scalar(@history) < 2 && $fuzz < 3) {
 240         $hashref->{history_date}++;
 241         $fuzz++;
 242         push @history, qsearch({ table    => 'h_cust_pkg',
 243                                  hashref  => $hashref,
 244                                  extra_sql => $action_replace,
 245                                  order_by => 'ORDER BY history_action',
 246                               });
 247       }
 248
 249       next unless scalar(@history) == 2;
 250
 251       my @new = grep { $_->history_action eq 'replace_new' } @history;
 252       my @old = grep { $_->history_action eq 'replace_old' } @history;
 253
 254       next if (scalar(@new) == 2 || scalar(@old) == 2);
 255
 256       $_->date($new[0]->get($field))
 257         if ( $new[0]->get($field) &&
 258              ( !$old[0]->get($field) ||
 259                 $old[0]->get($field) != $new[0]->get($field)
 260              )
 261            );
 262
 263       my $error = $_->replace
 264         if $_->modified;
 265
 266       die $error if $error;
 267     }
 268   }
 269
 270   #seek cancels/suspends without reason, but with expire/adjourn reason
 271   foreach my $field qw( cancel susp ) {
 272
 273     my %precursor_map = ( 'cancel' => 'expire', 'susp' => 'adjourn' );
 274     my $precursor = $precursor_map{$field};
 275     my $preaction = uc(substr($precursor,0,1));
 276     my $action    = uc(substr($field,0,1));
 277     my $addl_from =
 278       "LEFT JOIN cust_pkg_reason ON ".
 279       "(cust_pkg.pkgnum = cust_pkg_reason.pkgnum AND".
 280       " cust_pkg.$precursor = cust_pkg_reason.date AND".
 281       " cust_pkg_reason.action = '$preaction') ".
 282       "LEFT JOIN cust_pkg_reason AS target ON ".
 283       "(cust_pkg.pkgnum = target.pkgnum AND".
 284       " cust_pkg.$field = target.date AND".
 285       " target.action = '$action')"
 286     ;
 287
 288     my $extra_sql = "WHERE target.pkgnum IS NULL AND ".
 289                     "cust_pkg.$field IS NOT NULL AND ".
 290                     "cust_pkg.$field < cust_pkg.$precursor + 86400 AND ".
 291                     "cust_pkg_reason.action = '$preaction'";
 292
 293     my @unmigrated = qsearch({ table     => 'cust_pkg',
 294                                hashref   => { },
 295                                select    => 'cust_pkg.*',
 296                                addl_from => $addl_from,
 297                                extra_sql => $extra_sql,
 298                             });
 299     foreach ( @unmigrated ) {
 300       my $cpr = new FS::cust_pkg_reason { $_->last_cust_pkg_reason($precursor)->hash, 'num' => '' };
 301       $cpr->date($_->get($field));
 302       $cpr->action($action);
 303
 304       my $error = $cpr->insert;
 305       die $error if $error;
 306     }
 307   }
 308
 309   $class->_upgrade_otaker(%opts);
 310 }
 311
 312 =back
 313
 314 =head1 BUGS
 315
 316 Here be termites.  Don't use on wooden computers.
 317
 318 =head1 SEE ALSO
 319
 320 L<FS::Record>, schema.html from the base documentation.
 321
 322 =cut
 323
 324 1;
 325