X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Freason.pm;h=d87911e222e1bdaf4719849b6594ab5c8b2e3aea;hp=e6b20db8fc0d0b46e99addfbbd96d77eaa1d2780;hb=f822e27a1e00594332ffa487a1c284234c5580a6;hpb=63973c641c4be00765fa27e55c57cc5b9aa4da19 diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm index e6b20db8f..d87911e22 100644 --- a/FS/FS/reason.pm +++ b/FS/FS/reason.pm @@ -50,12 +50,25 @@ FS::Record. The following fields are currently supported: L) of a package to be ordered when the package is unsuspended. Typically this will be some kind of reactivation fee. Attaching it to a suspension reason allows the reactivation fee to be charged for some -suspensions but not others. +suspensions but not others. DEPRECATED. =item unsuspend_hold - 'Y' or ''. If unsuspend_pkgpart is set, this tells whether to bill the unsuspend package immediately ('') or to wait until the customer's next invoice ('Y'). +=item unused_credit - 'Y' or ''. For suspension or cancellation reasons. +If enabled, the customer will be credited for their remaining time on +suspension. + +=item feepart - for suspension reasons, the feepart of a fee to be +charged when a package is suspended for this reason. + +=item fee_hold - 'Y' or ''. If feepart is set, tells whether to bill the fee +immediately ('') or wait until the customer's next invoice ('Y'). + +=item fee_on_unsuspend - If feepart is set, tells whether to charge the fee +on suspension ('') or unsuspension ('Y'). + =back =head1 METHODS @@ -109,19 +122,31 @@ sub check { || $self->ut_number('reason_type') || $self->ut_foreign_key('reason_type', 'reason_type', 'typenum') || $self->ut_text('reason') - || $self->ut_flag('disabled') ; return $error if $error; - if ( $self->reasontype->class eq 'S' ) { + my $class = $self->reasontype->class; + + if ( $class eq 'S' ) { $error = $self->ut_numbern('unsuspend_pkgpart') || $self->ut_foreign_keyn('unsuspend_pkgpart', 'part_pkg', 'pkgpart') || $self->ut_flag('unsuspend_hold') + || $self->ut_foreign_keyn('feepart', 'part_fee', 'feepart') + || $self->ut_flag('fee_on_unsuspend') + || $self->ut_flag('fee_hold') ; return $error if $error; } else { - $self->set('unsuspend_pkgpart' => ''); - $self->set('unsuspend_hold' => ''); + foreach (qw(unsuspend_pkgpart unsuspend_hold feepart + fee_on_unsuspend fee_hold)) { + $self->set($_ => ''); + } + } + + if ( $class eq 'S' or $class eq 'C' ) { + $error = $self->ut_flag('unused_credit'); + } else { + $self->set('unused_credit', ''); } $self->SUPER::check; @@ -137,6 +162,80 @@ sub reasontype { qsearchs( 'reason_type', { 'typenum' => shift->reason_type } ); } +=item merge + +Accepts an arrayref of reason objects, to be merged into this reason. +Reasons must all have the same reason_type class as this one. +Matching reasonnums will be replaced in the following tables: + + cust_bill_void + cust_bill_pkg_void + cust_credit + cust_credit_void + cust_pay_void + cust_pkg_reason + cust_refund + +=cut + +sub merge { + my ($self,$reasons) = @_; + return "Bad input for merge" unless ref($reasons) eq 'ARRAY'; + + my $class = $self->reasontype->class; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error; + foreach my $reason (@$reasons) { + last if $error; + next if $reason->reasonnum eq $self->reasonnum; + $error = "Mismatched reason type class" + unless $reason->reasontype->class eq $class; + foreach my $table ( qw( + cust_bill_void + cust_bill_pkg_void + cust_credit + cust_credit_void + cust_pay_void + cust_pkg_reason + cust_refund + )) { + last if $error; + my @fields = ('reasonnum'); + push(@fields, 'void_reasonnum') if $table eq 'cust_credit_void'; + foreach my $field (@fields) { + last if $error; + foreach my $obj ( qsearch($table,{ $field => $reason->reasonnum }) ) { + last if $error; + $obj->set($field,$self->reasonnum); + $error = $obj->replace; + } + } + } + $error ||= $reason->delete; + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + =back =head1 CLASS METHODS @@ -147,7 +246,8 @@ sub reasontype { Fetches the reason matching these parameters if there is one. If not, inserts one. Will also insert the reason type if necessary. CLASS must -be one of 'C' (cancel reasons), 'R' (credit reasons), or 'S' (suspend reasons). +be one of 'C' (cancel reasons), 'R' (credit reasons), 'S' (suspend reasons), +or 'F' (refund reasons). This will die if anything fails. @@ -158,14 +258,25 @@ sub new_or_existing { my %opt = @_; my $error = ''; - my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'}); - my $reason_type = qsearchs('reason_type', \%hash) - || FS::reason_type->new(\%hash); + my $reason_type; + if ( ref $opt{type} eq 'FS::reason_type' ) { + $reason_type = $opt{type}; + } elsif ( $opt{type} =~ /^\d+$/ ) { + $reason_type = FS::reason_type->by_key($opt{type}); + if (!$reason_type) { + die "reason_type #$opt{type} not found\n"; + } + } else { + my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'}); + $reason_type = qsearchs('reason_type', \%hash) + || FS::reason_type->new(\%hash); - $error = $reason_type->insert unless $reason_type->typenum; - die "error inserting reason type: $error\n" if $error; + $error = $reason_type->insert unless $reason_type->typenum; + die "error inserting reason type: $error\n" if $error; + } - %hash = ('reason_type' => $reason_type->typenum, 'reason' => $opt{'reason'}); + my %hash = ('reason_type' => $reason_type->typenum, + 'reason' => $opt{'reason'}); my $reason = qsearchs('reason', \%hash) || FS::reason->new(\%hash); @@ -175,11 +286,8 @@ sub new_or_existing { $reason; } - =head1 BUGS -Here by termintes. Don't use on wooden computers. - =head1 SEE ALSO L, schema.html from the base documentation.