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.
  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 =back
  64
  65 =head1 METHODS
  66
  67 =over 4
  68
  69 =item new HASHREF
  70
  71 Creates a new reason.  To add the example to the database, see L<"insert">.
  72
  73 Note that this stores the hash reference, not a distinct copy of the hash it
  74 points to.  You can ask the object for a copy with the I<hash> method.
  75
  76 =cut
  77
  78 sub table { 'reason'; }
  79
  80 =item insert
  81
  82 Adds this record to the database.  If there is an error, returns the error,
  83 otherwise returns false.
  84
  85 =cut
  86
  87 =item delete
  88
  89 Delete this record from the database.
  90
  91 =cut
  92
  93 =item replace OLD_RECORD
  94
  95 Replaces the OLD_RECORD with this one in the database.  If there is an error,
  96 returns the error, otherwise returns false.
  97
  98 =cut
  99
 100 =item check
 101
 102 Checks all fields to make sure this is a valid reason.  If there is
 103 an error, returns the error, otherwise returns false.  Called by the insert
 104 and replace methods.
 105
 106 =cut
 107
 108 sub check {
 109   my $self = shift;
 110
 111   my $error =
 112     $self->ut_numbern('reasonnum')
 113     || $self->ut_number('reason_type')
 114     || $self->ut_foreign_key('reason_type', 'reason_type', 'typenum')
 115     || $self->ut_text('reason')
 116   ;
 117   return $error if $error;
 118
 119   if ( $self->reasontype->class eq 'S' ) {
 120     $error = $self->ut_numbern('unsuspend_pkgpart')
 121           || $self->ut_foreign_keyn('unsuspend_pkgpart', 'part_pkg', 'pkgpart')
 122           || $self->ut_flag('unsuspend_hold')
 123           || $self->ut_flag('unused_credit')
 124     ;
 125     return $error if $error;
 126   } else {
 127     foreach (qw(unsuspend_pkgpart unsuspend_hold unused_credit)) {
 128       $self->set($_ => '');
 129     }
 130   }
 131
 132   $self->SUPER::check;
 133 }
 134
 135 =item reasontype
 136
 137 Returns the reason_type (see L<FS::reason_type>) associated with this reason.
 138
 139 =cut
 140
 141 sub reasontype {
 142   qsearchs( 'reason_type', { 'typenum' => shift->reason_type } );
 143 }
 144
 145 =back
 146
 147 =head1 CLASS METHODS
 148
 149 =over 4
 150
 151 =item new_or_existing reason => REASON, type => TYPE, class => CLASS
 152
 153 Fetches the reason matching these parameters if there is one.  If not,
 154 inserts one.  Will also insert the reason type if necessary.  CLASS must
 155 be one of 'C' (cancel reasons), 'R' (credit reasons), 'S' (suspend reasons),
 156 or 'F' (refund reasons).
 157
 158 This will die if anything fails.
 159
 160 =cut
 161
 162 sub new_or_existing {
 163   my $class = shift;
 164   my %opt = @_;
 165
 166   my $error = '';
 167   my $reason_type;
 168   if ( ref $opt{type} eq 'FS::reason_type' ) {
 169     $reason_type = $opt{type};
 170   } elsif ( $opt{type} =~ /^\d+$/ ) {
 171     $reason_type = FS::reason_type->by_key($opt{type});
 172     if (!$reason_type) {
 173       die "reason_type #$opt{type} not found\n";
 174     }
 175   } else {
 176     my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'});
 177     $reason_type = qsearchs('reason_type', \%hash)
 178                       || FS::reason_type->new(\%hash);
 179
 180     $error = $reason_type->insert unless $reason_type->typenum;
 181     die "error inserting reason type: $error\n" if $error;
 182   }
 183
 184   my %hash = ('reason_type' => $reason_type->typenum,
 185               'reason' => $opt{'reason'});
 186   my $reason = qsearchs('reason', \%hash)
 187                || FS::reason->new(\%hash);
 188
 189   $error = $reason->insert unless $reason->reasonnum;
 190   die "error inserting reason: $error\n" if $error;
 191
 192   $reason;
 193 }
 194
 195
 196 =head1 BUGS
 197
 198 =head1 SEE ALSO
 199
 200 L<FS::Record>, schema.html from the base documentation.
 201
 202 =cut
 203
 204 1;
 205