4 use vars qw( @ISA $DEBUG $me );
6 use DBIx::DBSchema::Table;
7 use DBIx::DBSchema::Column;
8 use FS::Record qw( qsearch qsearchs dbh dbdef );
11 @ISA = qw(FS::Record);
17 FS::reason - Object methods for reason records
23 $record = new FS::reason \%hash;
24 $record = new FS::reason { 'column' => 'value' };
26 $error = $record->insert;
28 $error = $new_record->replace($old_record);
30 $error = $record->delete;
32 $error = $record->check;
36 An FS::reason object represents a reason message. FS::reason inherits from
37 FS::Record. The following fields are currently supported:
41 =item reasonnum - primary key
43 =item reason_type - index into FS::reason_type
45 =item reason - text of the reason
47 =item disabled - 'Y' or ''
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.
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').
59 =item unused_credit - 'Y' or ''. For suspension or cancellation reasons.
60 If enabled, the customer will be credited for their remaining time on
63 =item feepart - for suspension reasons, the feepart of a fee to be
64 charged when a package is suspended for this reason.
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').
69 =item fee_on_unsuspend - If feepart is set, tells whether to charge the fee
70 on suspension ('') or unsuspension ('Y').
80 Creates a new reason. To add the example to the database, see L<"insert">.
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.
87 sub table { 'reason'; }
91 Adds this record to the database. If there is an error, returns the error,
92 otherwise returns false.
98 Delete this record from the database.
102 =item replace OLD_RECORD
104 Replaces the OLD_RECORD with this one in the database. If there is an error,
105 returns the error, otherwise returns false.
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
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')
126 return $error if $error;
128 my $class = $self->reasontype->class;
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')
138 return $error if $error;
140 foreach (qw(unsuspend_pkgpart unsuspend_hold feepart
141 fee_on_unsuspend fee_hold)) {
142 $self->set($_ => '');
146 if ( $class eq 'S' or $class eq 'C' ) {
147 $error = $self->ut_flag('unused_credit');
149 $self->set('unused_credit', '');
157 Returns the reason_type (see L<FS::reason_type>) associated with this reason.
162 qsearchs( 'reason_type', { 'typenum' => shift->reason_type } );
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:
178 my ($self,$reasons) = @_;
179 return "Bad input for merge" unless ref($reasons) eq 'ARRAY';
181 my $class = $self->reasontype->class;
183 local $SIG{HUP} = 'IGNORE';
184 local $SIG{INT} = 'IGNORE';
185 local $SIG{QUIT} = 'IGNORE';
186 local $SIG{TERM} = 'IGNORE';
187 local $SIG{TSTP} = 'IGNORE';
188 local $SIG{PIPE} = 'IGNORE';
190 my $oldAutoCommit = $FS::UID::AutoCommit;
191 local $FS::UID::AutoCommit = 0;
195 foreach my $reason (@$reasons) {
197 next if $reason->reasonnum eq $self->reasonnum;
198 $error = "Mismatched reason type class"
199 unless $reason->reasontype->class eq $class;
200 foreach my $table ( qw(
206 my @fields = ('reasonnum');
207 push(@fields, 'void_reasonnum') if $table eq 'cust_credit_void';
208 foreach my $field (@fields) {
210 foreach my $obj ( qsearch($table,{ $field => $reason->reasonnum }) ) {
212 $obj->set($field,$self->reasonnum);
213 $error = $obj->replace;
217 $error ||= $reason->delete;
221 $dbh->rollback if $oldAutoCommit;
225 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
237 =item new_or_existing reason => REASON, type => TYPE, class => CLASS
239 Fetches the reason matching these parameters if there is one. If not,
240 inserts one. Will also insert the reason type if necessary. CLASS must
241 be one of 'C' (cancel reasons), 'R' (credit reasons), 'S' (suspend reasons),
242 or 'F' (refund reasons).
244 This will die if anything fails.
248 sub new_or_existing {
254 if ( ref $opt{type} eq 'FS::reason_type' ) {
255 $reason_type = $opt{type};
256 } elsif ( $opt{type} =~ /^\d+$/ ) {
257 $reason_type = FS::reason_type->by_key($opt{type});
259 die "reason_type #$opt{type} not found\n";
262 my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'});
263 $reason_type = qsearchs('reason_type', \%hash)
264 || FS::reason_type->new(\%hash);
266 $error = $reason_type->insert unless $reason_type->typenum;
267 die "error inserting reason type: $error\n" if $error;
270 my %hash = ('reason_type' => $reason_type->typenum,
271 'reason' => $opt{'reason'});
272 my $reason = qsearchs('reason', \%hash)
273 || FS::reason->new(\%hash);
275 $error = $reason->insert unless $reason->reasonnum;
276 die "error inserting reason: $error\n" if $error;
285 L<FS::Record>, schema.html from the base documentation.