Ticket 31993 different trans codes for business and personal
[freeside.git] / 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), or 'S' (suspend reasons).
156
157 This will die if anything fails.
158
159 =cut
160
161 sub new_or_existing {
162   my $class = shift;
163   my %opt = @_;
164
165   my $error = '';
166   my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'});
167   my $reason_type = qsearchs('reason_type', \%hash)
168                     || FS::reason_type->new(\%hash);
169
170   $error = $reason_type->insert unless $reason_type->typenum;
171   die "error inserting reason type: $error\n" if $error;
172
173   %hash = ('reason_type' => $reason_type->typenum, 'reason' => $opt{'reason'});
174   my $reason = qsearchs('reason', \%hash)
175                || FS::reason->new(\%hash);
176
177   $error = $reason->insert unless $reason->reasonnum;
178   die "error inserting reason: $error\n" if $error;
179
180   $reason;
181 }
182
183
184 =head1 BUGS
185
186 =head1 SEE ALSO
187
188 L<FS::Record>, schema.html from the base documentation.
189
190 =cut
191
192 1;
193