FS/FS/reason.pm

   1 package FS::reason;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG $me );
   5 use DBIx::DBSchema;
   6 use DBIx::DBSchema::Table;
   7 use DBIx::DBSchema::Column;
   8 use FS::Record qw( qsearch qsearchs dbh dbdef );
   9 use FS::reason_type;
  10
  11 @ISA = qw(FS::Record);
  12 $DEBUG = 0;
  13 $me = '[FS::reason]';
  14
  15 =head1 NAME
  16
  17 FS::reason - Object methods for reason records
  18
  19 =head1 SYNOPSIS
  20
  21   use FS::reason;
  22
  23   $record = new FS::reason \%hash;
  24   $record = new FS::reason { 'column' => 'value' };
  25
  26   $error = $record->insert;
  27
  28   $error = $new_record->replace($old_record);
  29
  30   $error = $record->delete;
  31
  32   $error = $record->check;
  33
  34 =head1 DESCRIPTION
  35
  36 An FS::reason object represents a reason message.  FS::reason inherits from
  37 FS::Record.  The following fields are currently supported:
  38
  39 =over 4
  40
  41 =item reasonnum - primary key
  42
  43 =item reason_type - index into FS::reason_type
  44
  45 =item reason - text of the reason
  46
  47 =item disabled - 'Y' or ''
  48
  49 =item unsuspend_pkgpart - for suspension reasons only, the pkgpart (see
  50 L<FS::part_pkg>) of a package to be ordered when the package is unsuspended.
  51 Typically this will be some kind of reactivation fee.  Attaching it to
  52 a suspension reason allows the reactivation fee to be charged for some
  53 suspensions but not others. DEPRECATED.
  54
  55 =item unsuspend_hold - 'Y' or ''.  If unsuspend_pkgpart is set, this tells
  56 whether to bill the unsuspend package immediately ('') or to wait until
  57 the customer's next invoice ('Y').
  58
  59 =item unused_credit - 'Y' or ''. For suspension reasons only (for now).
  60 If enabled, the customer will be credited for their remaining time on
  61 suspension.
  62
  63 =item feepart - for suspension reasons, the feepart of a fee to be
  64 charged when a package is suspended for this reason.
  65
  66 =item fee_hold - 'Y' or ''. If feepart is set, tells whether to bill the fee
  67 immediately ('') or wait until the customer's next invoice ('Y').
  68
  69 =item fee_on_unsuspend - If feepart is set, tells whether to charge the fee
  70 on suspension ('') or unsuspension ('Y').
  71
  72 =back
  73
  74 =head1 METHODS
  75
  76 =over 4
  77
  78 =item new HASHREF
  79
  80 Creates a new reason.  To add the example to the database, see L<"insert">.
  81
  82 Note that this stores the hash reference, not a distinct copy of the hash it
  83 points to.  You can ask the object for a copy with the I<hash> method.
  84
  85 =cut
  86
  87 sub table { 'reason'; }
  88
  89 =item insert
  90
  91 Adds this record to the database.  If there is an error, returns the error,
  92 otherwise returns false.
  93
  94 =cut
  95
  96 =item delete
  97
  98 Delete this record from the database.
  99
 100 =cut
 101
 102 =item replace OLD_RECORD
 103
 104 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 105 returns the error, otherwise returns false.
 106
 107 =cut
 108
 109 =item check
 110
 111 Checks all fields to make sure this is a valid reason.  If there is
 112 an error, returns the error, otherwise returns false.  Called by the insert
 113 and replace methods.
 114
 115 =cut
 116
 117 sub check {
 118   my $self = shift;
 119
 120   my $error =
 121     $self->ut_numbern('reasonnum')
 122     || $self->ut_number('reason_type')
 123     || $self->ut_foreign_key('reason_type', 'reason_type', 'typenum')
 124     || $self->ut_text('reason')
 125   ;
 126   return $error if $error;
 127
 128   if ( $self->reasontype->class eq 'S' ) {
 129     $error = $self->ut_numbern('unsuspend_pkgpart')
 130           || $self->ut_foreign_keyn('unsuspend_pkgpart', 'part_pkg', 'pkgpart')
 131           || $self->ut_flag('unsuspend_hold')
 132           || $self->ut_flag('unused_credit')
 133           || $self->ut_foreign_keyn('feepart', 'part_fee', 'feepart')
 134           || $self->ut_flag('fee_on_unsuspend')
 135           || $self->ut_flag('fee_hold')
 136     ;
 137     return $error if $error;
 138   } else {
 139     foreach (qw(unsuspend_pkgpart unsuspend_hold unused_credit feepart
 140                 fee_on_unsuspend fee_hold)) {
 141       $self->set($_ => '');
 142     }
 143   }
 144
 145   $self->SUPER::check;
 146 }
 147
 148 =item reasontype
 149
 150 Returns the reason_type (see L<FS::reason_type>) associated with this reason.
 151
 152 =cut
 153
 154 sub reasontype {
 155   qsearchs( 'reason_type', { 'typenum' => shift->reason_type } );
 156 }
 157
 158 =item merge
 159
 160 Accepts an arrayref of reason objects, to be merged into this reason.
 161 Reasons must all have the same reason_type class as this one.
 162 Matching reasonnums will be replaced in the following tables:
 163
 164   cust_bill_void
 165   cust_bill_pkg_void
 166   cust_credit
 167   cust_credit_void
 168   cust_pay_void
 169   cust_pkg_reason
 170   cust_refund
 171
 172 =cut
 173
 174 sub merge {
 175   my ($self,$reasons) = @_;
 176   return "Bad input for merge" unless ref($reasons) eq 'ARRAY';
 177
 178   my $class = $self->reasontype->class;
 179
 180   local $SIG{HUP} = 'IGNORE';
 181   local $SIG{INT} = 'IGNORE';
 182   local $SIG{QUIT} = 'IGNORE';
 183   local $SIG{TERM} = 'IGNORE';
 184   local $SIG{TSTP} = 'IGNORE';
 185   local $SIG{PIPE} = 'IGNORE';
 186
 187   my $oldAutoCommit = $FS::UID::AutoCommit;
 188   local $FS::UID::AutoCommit = 0;
 189   my $dbh = dbh;
 190
 191   my $error;
 192   foreach my $reason (@$reasons) {
 193     last if $error;
 194     next if $reason->reasonnum eq $self->reasonnum;
 195     $error = "Mismatched reason type class"
 196       unless $reason->reasontype->class eq $class;
 197     foreach my $table ( qw(
 198       cust_bill_void
 199       cust_bill_pkg_void
 200       cust_credit
 201       cust_credit_void
 202       cust_pay_void
 203       cust_pkg_reason
 204       cust_refund
 205     )) {
 206       last if $error;
 207       my @fields = ('reasonnum');
 208       push(@fields, 'void_reasonnum') if $table eq 'cust_credit_void';
 209       foreach my $field (@fields) {
 210         last if $error;
 211         foreach my $obj ( qsearch($table,{ $field => $reason->reasonnum }) ) {
 212           last if $error;
 213           $obj->set($field,$self->reasonnum);
 214           $error = $obj->replace;
 215         }
 216       }
 217     }
 218     $error ||= $reason->delete;
 219   }
 220
 221   if ( $error ) {
 222     $dbh->rollback if $oldAutoCommit;
 223     return $error;
 224   }
 225
 226   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 227
 228   '';
 229
 230 }
 231
 232 =back
 233
 234 =head1 CLASS METHODS
 235
 236 =over 4
 237
 238 =item new_or_existing reason => REASON, type => TYPE, class => CLASS
 239
 240 Fetches the reason matching these parameters if there is one.  If not,
 241 inserts one.  Will also insert the reason type if necessary.  CLASS must
 242 be one of 'C' (cancel reasons), 'R' (credit reasons), 'S' (suspend reasons),
 243 or 'F' (refund reasons).
 244
 245 This will die if anything fails.
 246
 247 =cut
 248
 249 sub new_or_existing {
 250   my $class = shift;
 251   my %opt = @_;
 252
 253   my $error = '';
 254   my $reason_type;
 255   if ( ref $opt{type} eq 'FS::reason_type' ) {
 256     $reason_type = $opt{type};
 257   } elsif ( $opt{type} =~ /^\d+$/ ) {
 258     $reason_type = FS::reason_type->by_key($opt{type});
 259     if (!$reason_type) {
 260       die "reason_type #$opt{type} not found\n";
 261     }
 262   } else {
 263     my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'});
 264     $reason_type = qsearchs('reason_type', \%hash)
 265                       || FS::reason_type->new(\%hash);
 266
 267     $error = $reason_type->insert unless $reason_type->typenum;
 268     die "error inserting reason type: $error\n" if $error;
 269   }
 270
 271   my %hash = ('reason_type' => $reason_type->typenum,
 272               'reason' => $opt{'reason'});
 273   my $reason = qsearchs('reason', \%hash)
 274                || FS::reason->new(\%hash);
 275
 276   $error = $reason->insert unless $reason->reasonnum;
 277   die "error inserting reason: $error\n" if $error;
 278
 279   $reason;
 280 }
 281
 282 =head1 BUGS
 283
 284 =head1 SEE ALSO
 285
 286 L<FS::Record>, schema.html from the base documentation.
 287
 288 =cut
 289
 290 1;
 291