X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Freason.pm;h=d87911e222e1bdaf4719849b6594ab5c8b2e3aea;hp=5311ec5aa6892d3772ce8e6e4d5b85f1e4a4c76c;hb=f822e27a1e00594332ffa487a1c284234c5580a6;hpb=5e05724a635a22776f1b973f5d7e77989da4e048 diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm index 5311ec5aa..d87911e22 100644 --- a/FS/FS/reason.pm +++ b/FS/FS/reason.pm @@ -46,6 +46,28 @@ FS::Record. The following fields are currently supported: =item disabled - 'Y' or '' +=item unsuspend_pkgpart - for suspension reasons only, the pkgpart (see +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. 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 @@ -97,16 +119,42 @@ sub check { my $error = $self->ut_numbern('reasonnum') + || $self->ut_number('reason_type') + || $self->ut_foreign_key('reason_type', 'reason_type', 'typenum') || $self->ut_text('reason') ; return $error if $error; + 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 { + 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; } =item reasontype -Returns the reason_type (see FS::reason_type) associated with this reason. +Returns the reason_type (see L) associated with this reason. =cut @@ -114,66 +162,132 @@ sub reasontype { qsearchs( 'reason_type', { 'typenum' => shift->reason_type } ); } -# _upgrade_data -# -# Used by FS::Upgrade to migrate to a new database. -# -# +=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'; -sub _upgrade_data { # class method - my ($self, %opts) = @_; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; my $dbh = dbh; - warn "$me upgrading $self\n" if $DEBUG; + 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; + } - my $column = dbdef->table($self->table)->column('reason'); - unless ($column->type eq 'text') { # assume history matches main table + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } - # ideally this would be supported in DBIx-DBSchema and friends - warn "$me Shifting reason column to type 'text'\n" if $DEBUG; - foreach my $table ( $self->table, 'h_'. $self->table ) { - my @sql = (); + $dbh->commit or die $dbh->errstr if $oldAutoCommit; - $column = dbdef->table($self->table)->column('reason'); - my $columndef = $column->line($dbh); - $columndef =~ s/varchar\(\d+\)/text/i; + ''; - if ( $dbh->{Driver}->{Name} eq 'Pg' ) { +} - my $notnull = $columndef =~ s/not null//i; - push @sql,"ALTER TABLE $table RENAME reason TO freeside_upgrade_reason"; - push @sql,"ALTER TABLE $table ADD $columndef"; - push @sql,"UPDATE $table SET reason = freeside_upgrade_reason"; - push @sql,"ALTER TABLE $table ALTER reason SET NOT NULL" - if $notnull; - push @sql,"ALTER TABLE $table DROP freeside_upgrade_reason"; +=back - } elsif ( $dbh->{Driver}->{Name} =~ /^mysql/i ){ +=head1 CLASS METHODS - #crap, this isn't working - #push @sql,"ALTER TABLE $table MODIFY reason ". $column->line($dbh); - warn "WARNING: reason table upgrade not yet supported for mysql, sorry"; +=over 4 - } else { - die "watchu talkin' 'bout, Willis? (unsupported database type)"; - } +=item new_or_existing reason => REASON, type => TYPE, class => CLASS - foreach (@sql) { - my $sth = $dbh->prepare($_) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - } +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), 'S' (suspend reasons), +or 'F' (refund reasons). + +This will die if anything fails. + +=cut + +sub new_or_existing { + my $class = shift; + my %opt = @_; + + my $error = ''; + 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; } - ''; + my %hash = ('reason_type' => $reason_type->typenum, + 'reason' => $opt{'reason'}); + my $reason = qsearchs('reason', \%hash) + || FS::reason->new(\%hash); + + $error = $reason->insert unless $reason->reasonnum; + die "error inserting reason: $error\n" if $error; + $reason; } -=back =head1 BUGS -Here be termintes. Don't use on wooden computers. - =head1 SEE ALSO L, schema.html from the base documentation.