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 or cancellation reasons.
  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   my $class = $self->reasontype->class;
 129
 130   if ( $class eq 'S' ) {
 131     $error = $self->ut_numbern('unsuspend_pkgpart')
 132           || $self->ut_foreign_keyn('unsuspend_pkgpart', 'part_pkg', 'pkgpart')
 133           || $self->ut_flag('unsuspend_hold')
 134           || $self->ut_foreign_keyn('feepart', 'part_fee', 'feepart')
 135           || $self->ut_flag('fee_on_unsuspend')
 136           || $self->ut_flag('fee_hold')
 137     ;
 138     return $error if $error;
 139   } else {
 140     foreach (qw(unsuspend_pkgpart unsuspend_hold feepart
 141                 fee_on_unsuspend fee_hold)) {
 142       $self->set($_ => '');
 143     }
 144   }
 145
 146   if ( $class eq 'S' or $class eq 'C' ) {
 147     $error = $self->ut_flag('unused_credit');
 148   } else {
 149     $self->set('unused_credit', '');
 150   }
 151
 152   $self->SUPER::check;
 153 }
 154
 155 =item reasontype
 156
 157 Returns the reason_type (see L<FS::reason_type>) associated with this reason.
 158
 159 =cut
 160
 161 sub reasontype {
 162   qsearchs( 'reason_type', { 'typenum' => shift->reason_type } );
 163 }
 164
 165 =item merge
 166
 167 Accepts an arrayref of reason objects, to be merged into this reason.
 168 Reasons must all have the same reason_type class as this one.
 169 Matching reasonnums will be replaced in the following tables:
 170
 171   cust_bill_void
 172   cust_bill_pkg_void
 173   cust_credit
 174   cust_credit_void
 175   cust_pay_void
 176   cust_pkg_reason
 177   cust_refund
 178
 179 =cut
 180
 181 sub merge {
 182   my ($self,$reasons) = @_;
 183   return "Bad input for merge" unless ref($reasons) eq 'ARRAY';
 184
 185   my $class = $self->reasontype->class;
 186
 187   local $SIG{HUP} = 'IGNORE';
 188   local $SIG{INT} = 'IGNORE';
 189   local $SIG{QUIT} = 'IGNORE';
 190   local $SIG{TERM} = 'IGNORE';
 191   local $SIG{TSTP} = 'IGNORE';
 192   local $SIG{PIPE} = 'IGNORE';
 193
 194   my $oldAutoCommit = $FS::UID::AutoCommit;
 195   local $FS::UID::AutoCommit = 0;
 196   my $dbh = dbh;
 197
 198   my $error;
 199   foreach my $reason (@$reasons) {
 200     last if $error;
 201     next if $reason->reasonnum eq $self->reasonnum;
 202     $error = "Mismatched reason type class"
 203       unless $reason->reasontype->class eq $class;
 204     foreach my $table ( qw(
 205       cust_bill_void
 206       cust_bill_pkg_void
 207       cust_credit
 208       cust_credit_void
 209       cust_pay_void
 210       cust_pkg_reason
 211       cust_refund
 212     )) {
 213       last if $error;
 214       my @fields = ('reasonnum');
 215       push(@fields, 'void_reasonnum') if $table eq 'cust_credit_void';
 216       foreach my $field (@fields) {
 217         last if $error;
 218         foreach my $obj ( qsearch($table,{ $field => $reason->reasonnum }) ) {
 219           last if $error;
 220           $obj->set($field,$self->reasonnum);
 221           $error = $obj->replace;
 222         }
 223       }
 224     }
 225     $error ||= $reason->delete;
 226   }
 227
 228   if ( $error ) {
 229     $dbh->rollback if $oldAutoCommit;
 230     return $error;
 231   }
 232
 233   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 234
 235   '';
 236
 237 }
 238
 239 =back
 240
 241 =head1 CLASS METHODS
 242
 243 =over 4
 244
 245 =item new_or_existing reason => REASON, type => TYPE, class => CLASS
 246
 247 Fetches the reason matching these parameters if there is one.  If not,
 248 inserts one.  Will also insert the reason type if necessary.  CLASS must
 249 be one of 'C' (cancel reasons), 'R' (credit reasons), 'S' (suspend reasons),
 250 or 'F' (refund reasons).
 251
 252 This will die if anything fails.
 253
 254 =cut
 255
 256 sub new_or_existing {
 257   my $class = shift;
 258   my %opt = @_;
 259
 260   my $error = '';
 261   my $reason_type;
 262   if ( ref $opt{type} eq 'FS::reason_type' ) {
 263     $reason_type = $opt{type};
 264   } elsif ( $opt{type} =~ /^\d+$/ ) {
 265     $reason_type = FS::reason_type->by_key($opt{type});
 266     if (!$reason_type) {
 267       die "reason_type #$opt{type} not found\n";
 268     }
 269   } else {
 270     my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'});
 271     $reason_type = qsearchs('reason_type', \%hash)
 272                       || FS::reason_type->new(\%hash);
 273
 274     $error = $reason_type->insert unless $reason_type->typenum;
 275     die "error inserting reason type: $error\n" if $error;
 276   }
 277
 278   my %hash = ('reason_type' => $reason_type->typenum,
 279               'reason' => $opt{'reason'});
 280   my $reason = qsearchs('reason', \%hash)
 281                || FS::reason->new(\%hash);
 282
 283   $error = $reason->insert unless $reason->reasonnum;
 284   die "error inserting reason: $error\n" if $error;
 285
 286   $reason;
 287 }
 288
 289 =head1 BUGS
 290
 291 The reason_type column should have been typenum, and then that cascaded into
 292 a bunch of other stupidity where that conflicts with the autogenerated methos
 293 and so we need our own manual and inconsistently named reasontype method.
 294
 295 =head1 SEE ALSO
 296
 297 L<FS::Record>, schema.html from the base documentation.
 298
 299 =cut
 300
 301 1;
 302