X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Freason.pm;h=6f4bf62d99d832832ff738bf062f97976ecf80a0;hb=92b6628c08e4478e48b6f250320a3e3e93262ec2;hp=5311ec5aa6892d3772ce8e6e4d5b85f1e4a4c76c;hpb=c9f77472c8fe6f06e381faecf4f53c8cb8036602;p=freeside.git diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm index 5311ec5aa..6f4bf62d9 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 reasons only (for now). +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,35 @@ 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; + if ( $self->reasontype->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_flag('unused_credit') + || $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 unused_credit feepart + fee_on_unsuspend fee_hold)) { + $self->set($_ => ''); + } + } + $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 +155,58 @@ sub reasontype { qsearchs( 'reason_type', { 'typenum' => shift->reason_type } ); } -# _upgrade_data -# -# Used by FS::Upgrade to migrate to a new database. -# -# - -sub _upgrade_data { # class method - my ($self, %opts) = @_; - my $dbh = dbh; - - warn "$me upgrading $self\n" if $DEBUG; - - my $column = dbdef->table($self->table)->column('reason'); - unless ($column->type eq 'text') { # assume history matches main table - - # 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 = (); +=back - $column = dbdef->table($self->table)->column('reason'); - my $columndef = $column->line($dbh); - $columndef =~ s/varchar\(\d+\)/text/i; +=head1 CLASS METHODS - if ( $dbh->{Driver}->{Name} eq 'Pg' ) { +=over 4 - 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"; +=item new_or_existing reason => REASON, type => TYPE, class => CLASS - } elsif ( $dbh->{Driver}->{Name} =~ /^mysql/i ){ +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). - #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"; +This will die if anything fails. - } else { - die "watchu talkin' 'bout, Willis? (unsupported database type)"; - } +=cut - foreach (@sql) { - my $sth = $dbh->prepare($_) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - } +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.