From: jeff Date: Tue, 4 Dec 2007 18:20:58 +0000 (+0000) Subject: change credit reasons from freetext to new reason/reason type system (#2777) X-Git-Tag: TRIXBOX_2_6~201 X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=e8a09e945986a32f9b7d0a5d546142ada91654ca change credit reasons from freetext to new reason/reason type system (#2777) --- diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 5ab6809a4..8ebfc4019 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -169,6 +169,7 @@ tie my %rights, 'Tie::IxHash', { rightname=>'Unapply credit', desc=>'Enable "unapplication" of unclosed credits.' }, #aka unapplycredits { rightname=>'Delete credit', desc=>'Enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments.' }, #aka. deletecredits Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted. 'Delete refund', #NEW + 'Add on-the-fly credit reason', #NEW ], ### diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index fef47e845..6e4545aee 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -992,8 +992,11 @@ sub _do_bop_realtime { && ( $cust_main->payby !~ /^(BILL|DCRD|DCHK)$/ ? 1 : $status eq 'suspended' ) ) { #this makes sense. credit is "un-doing" the invoice + my $conf = new FS::Conf; $cust_main->credit( sprintf("%.2f", $cust_main->balance - $old_balance ), - 'self-service decline' ); + 'self-service decline', + 'reason_type' => $conf->config('signup_credit_type'), + ); $cust_main->apply_credits( 'order' => 'newest' ); return { 'error' => '_decline', 'bill_error' => $bill_error }; diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm index 00b4d445e..d33dd799c 100644 --- a/FS/FS/ClientAPI/Signup.pm +++ b/FS/FS/ClientAPI/Signup.pm @@ -451,7 +451,9 @@ sub new_customer { if ( $cust_main->balance > 0 ) { #this makes sense. credit is "un-doing" the invoice - $cust_main->credit( $cust_main->balance, 'signup server decline' ); + $cust_main->credit( $cust_main->balance, 'signup server decline', + 'reason_type' => $conf->config('signup_credit_type'), + ); $cust_main->apply_credits; #should check list for errors... diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 0ad12c135..0f1fcbbee 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -2102,6 +2102,63 @@ worry that config_items is freeside-specific and icky. 'type' => 'checkbox', }, + { + 'key' => 'cancel_credit_type', + 'section' => 'billing', + 'description' => 'The group to use for new, automatically generated credit reasons resulting from cancellation.', + 'type' => 'select-sub', + 'options_sub' => sub { require FS::Record; + require FS::reason_type; + map { $_->typenum => $_->type } + FS::Record::qsearch('reason_type', { class=>'R' } ); + }, + 'option_sub' => sub { require FS::Record; + require FS::reason_type; + my $reason_type = FS::Record::qsearchs( + 'reason_type', { 'typenum' => shift } + ); + $reason_type ? $reason_type->type : ''; + }, + }, + + { + 'key' => 'referral_credit_type', + 'section' => 'billing', + 'description' => 'The group to use for new, automatically generated credit reasons resulting from referrals.', + 'type' => 'select-sub', + 'options_sub' => sub { require FS::Record; + require FS::reason_type; + map { $_->typenum => $_->type } + FS::Record::qsearch('reason_type', { class=>'R' } ); + }, + 'option_sub' => sub { require FS::Record; + require FS::reason_type; + my $reason_type = FS::Record::qsearchs( + 'reason_type', { 'typenum' => shift } + ); + $reason_type ? $reason_type->type : ''; + }, + }, + + { + 'key' => 'signup_credit_type', + 'section' => 'billing', + 'description' => 'The group to use for new, automatically generated credit reasons resulting from signup and self-service declines.', + 'type' => 'select-sub', + 'options_sub' => sub { require FS::Record; + require FS::reason_type; + map { $_->typenum => $_->type } + FS::Record::qsearch('reason_type', { class=>'R' } ); + }, + 'option_sub' => sub { require FS::Record; + require FS::reason_type; + my $reason_type = FS::Record::qsearchs( + 'reason_type', { 'typenum' => shift } + ); + $reason_type ? $reason_type->type : ''; + }, + }, + ); 1; diff --git a/FS/FS/Conf_compat17.pm b/FS/FS/Conf_compat17.pm index 1c33b5b7c..bcd78e8c7 100644 --- a/FS/FS/Conf_compat17.pm +++ b/FS/FS/Conf_compat17.pm @@ -2133,7 +2133,62 @@ httemplate/docs/config.html 'type' => 'checkbox', }, - + { + 'key' => 'cancel_credit_type', + 'section' => 'billing', + 'description' => 'The group to use for new, automatically generated credit reasons resulting from cancellation.', + 'type' => 'select-sub', + 'options_sub' => sub { require FS::Record; + require FS::reason_type; + map { $_->typenum => $_->type } + FS::Record::qsearch('reason_type', { class=>'R' } ); + }, + 'option_sub' => sub { require FS::Record; + require FS::reason_type; + my $reason_type = FS::Record::qsearchs( + 'reason_type', { 'typenum' => shift } + ); + $reason_type ? $reason_type->type : ''; + }, + }, + + { + 'key' => 'referral_credit_type', + 'section' => 'billing', + 'description' => 'The group to use for new, automatically generated credit reasons resulting from referrals.', + 'type' => 'select-sub', + 'options_sub' => sub { require FS::Record; + require FS::reason_type; + map { $_->typenum => $_->type } + FS::Record::qsearch('reason_type', { class=>'R' } ); + }, + 'option_sub' => sub { require FS::Record; + require FS::reason_type; + my $reason_type = FS::Record::qsearchs( + 'reason_type', { 'typenum' => shift } + ); + $reason_type ? $reason_type->type : ''; + }, + }, + + { + 'key' => 'signup_credit_type', + 'section' => 'billing', + 'description' => 'The group to use for new, automatically generated credit reasons resulting from signup and self-service declines.', + 'type' => 'select-sub', + 'options_sub' => sub { require FS::Record; + require FS::reason_type; + map { $_->typenum => $_->type } + FS::Record::qsearch('reason_type', { class=>'R' } ); + }, + 'option_sub' => sub { require FS::Record; + require FS::reason_type; + my $reason_type = FS::Record::qsearchs( + 'reason_type', { 'typenum' => shift } + ); + $reason_type ? $reason_type->type : ''; + }, + }, ); diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 3d07af6f5..60f917afd 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -512,6 +512,7 @@ sub tables_hashref { 'amount', @money_type, '', '', 'otaker', 'varchar', '', 32, '', '', 'reason', 'text', 'NULL', '', '', '', + 'reasonnum', 'int', 'NULL', '', '', '', 'closed', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'crednum', @@ -1891,7 +1892,7 @@ sub tables_hashref { 'columns' => [ 'reasonnum', 'serial', '', '', '', '', 'reason_type', 'int', '', '', '', '', - 'reason', 'varchar', '', $char_d, '', '', + 'reason', 'text', '', '', '', '', 'disabled', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'reasonnum', diff --git a/FS/FS/Setup.pm b/FS/FS/Setup.pm index 6807ef76e..d8099c6a9 100644 --- a/FS/FS/Setup.pm +++ b/FS/FS/Setup.pm @@ -150,6 +150,9 @@ sub populate_initial_data { eval "use $class;"; die $@ if $@; + $class->_populate_initial_data(%opt) + if $class->can('_populate_inital_data'); + my @records = @{ $data->{$table} }; foreach my $record ( @records ) { @@ -175,6 +178,9 @@ sub initial_data { { 'groupname' => 'Superuser' }, ], + #reason types + 'reason_type' => [], + #XXX need default new-style billing events # #billing events # 'part_bill_event' => [ diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm new file mode 100644 index 000000000..55972dd4c --- /dev/null +++ b/FS/FS/Upgrade.pm @@ -0,0 +1,105 @@ +package FS::Upgrade; + +use strict; +use vars qw( @ISA @EXPORT_OK ); +use Exporter; +use Tie::IxHash; +use FS::UID qw( dbh driver_name ); +use FS::Record; + +use FS::svc_domain; +$FS::svc_domain::whois_hack = 1; + +@ISA = qw( Exporter ); +@EXPORT_OK = qw( upgrade ); + +=head1 NAME + +FS::Upgrade - Database upgrade routines + +=head1 SYNOPSIS + + use FS::Upgrade; + +=head1 DESCRIPTION + +Currently this module simply provides a place to store common subroutines for +database upgrades. + +=head1 SUBROUTINES + +=over 4 + +=item + +=cut + +sub upgrade { + my %opt = @_; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + $FS::UID::AutoCommit = 0; + + my $data = upgrade_data(%opt); + + foreach my $table ( keys %$data ) { + + my $class = "FS::$table"; + eval "use $class;"; + die $@ if $@; + + $class->_upgrade_data(%opt) + if $class->can('_upgrade_data'); + +# my @records = @{ $data->{$table} }; +# +# foreach my $record ( @records ) { +# my $args = delete($record->{'_upgrade_args'}) || []; +# my $object = $class->new( $record ); +# my $error = $object->insert( @$args ); +# die "error inserting record into $table: $error\n" +# if $error; +# } + + } + + if ( $oldAutoCommit ) { + dbh->commit or die dbh->errstr; + } + +} + + +sub upgrade_data { + my %opt = @_; + + tie my %hash, 'Tie::IxHash', + + #reason type and reasons + 'reason_type' => [], + 'reason' => [], + + #customer credits + 'cust_credit' => [], + + + ; + + \%hash; + +} + + +=back + +=head1 BUGS + +Sure. + +=head1 SEE ALSO + +=cut + +1; + diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index e07461d58..4c94e1578 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -1,17 +1,22 @@ package FS::cust_credit; use strict; -use vars qw( @ISA $conf $unsuspendauto ); +use vars qw( @ISA $conf $unsuspendauto $me $DEBUG ); use Date::Format; use FS::UID qw( dbh getotaker ); use FS::Misc qw(send_email); -use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearch qsearchs dbdef ); use FS::cust_main_Mixin; use FS::cust_main; use FS::cust_refund; use FS::cust_credit_bill; +use FS::part_pkg; +use FS::reason_type; +use FS::reason; @ISA = qw( FS::cust_main_Mixin FS::Record ); +$me = '[ FS::cust_credit ]'; +$DEBUG = 0; #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::cust_credit'} = sub { @@ -21,6 +26,11 @@ $FS::UID::callback{'FS::cust_credit'} = sub { }; +our %reasontype_map = ( 'referral_credit_type' => 'Referral Credit', + 'cancel_credit_type' => 'Cancellation Credit', + 'signup_credit_type' => 'Self-Service Credit', + ); + =head1 NAME FS::cust_credit - Object methods for cust_credit records @@ -59,7 +69,9 @@ L and L for conversion functions. =item otaker - order taker (assigned automatically, see L) -=item reason - text +=item reason - text ( deprecated ) + +=item reasonum - int reason (see L) =item closed - books closed flag, empty or `Y' @@ -91,7 +103,7 @@ returns the error, otherwise returns false. =cut sub insert { - my $self = shift; + my ($self, %options) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -107,6 +119,20 @@ sub insert { my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); my $old_balance = $cust_main->balance; + unless ($self->reasonnum) { + my $result = $self->reason( $self->getfield('reason'), + exists($options{ 'reason_type' }) + ? ('reason_type' => $options{ 'reason_type' }) + : (), + ); + unless($result) { + $dbh->rollback if $oldAutoCommit; + return "failed to set reason for $me: ". $dbh->errstr; + } + } + + $self->setfield('reason', ''); + my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -242,6 +268,7 @@ sub check { || $self->ut_numbern('_date') || $self->ut_money('amount') || $self->ut_textn('reason') + || $self->ut_foreign_key('reasonnum', 'reason', 'reasonnum') || $self->ut_enum('closed', [ '', 'Y' ]) ; return $error if $error; @@ -331,6 +358,166 @@ sub cust_main { } +=item reason + +Returns the text of the associated reason (see L) for this credit. + +=cut + +sub reason { + my ($self, $value, %options) = @_; + my $dbh = dbh; + my $reason; + my $typenum = $options{'reason_type'}; + + my $oldAutoCommit = $FS::UID::AutoCommit; # this should already be in + local $FS::UID::AutoCommit = 0; # a transaction if it matters + + if ( defined( $value ) ) { + my $hashref = { 'reason' => $value }; + $hashref->{'reason_type'} = $typenum if $typenum; + my $addl_from = "LEFT JOIN reason_type ON ( reason_type = typenum ) "; + my $extra_sql = " AND reason_type.class='R'"; + + $reason = qsearchs( { 'table' => 'reason', + 'hashref' => $hashref, + 'addl_from' => $addl_from, + 'extra_sql' => $extra_sql, + } ); + + if (!$reason && $typenum) { + $reason = new FS::reason( { 'reason_type' => $typenum, + 'reason' => $value, + } ); + $reason->insert and $reason = undef; + } + + $self->reasonnum($reason ? $reason->reasonnum : '') ; + warn "$me reason used in set mode with non-existant reason -- clearing" + unless $reason; + } + $reason = qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } ); + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + $reason ? $reason->reason : ''; +} + +# _upgrade_data +# +# Used by FS::Upgrade to migrate to a new database. +# +# + +sub _upgrade_data { # class method + my ($self, %opts) = @_; + + warn "$me upgrading $self\n" if $DEBUG; + + if (defined dbdef->table($self->table)->column('reason')) { + + warn "$me Checking for unmigrated reasons\n" if $DEBUG; + + my @cust_credits = qsearch({ 'table' => $self->table, + 'hashref' => {}, + 'extrasql' => 'WHERE reason IS NOT NULL', + }); + + if (scalar(grep { $_->getfield('reason') =~ /\S/ } @cust_credits)) { + warn "$me Found unmigrated reasons\n" if $DEBUG; + my $hashref = { 'class' => 'R', 'type' => 'Legacy' }; + my $reason_type = qsearchs( 'reason_type', $hashref ); + unless ($reason_type) { + $reason_type = new FS::reason_type( $hashref ); + my $error = $reason_type->insert(); + die "$self had error inserting FS::reason_type into database: $error\n" + if $error; + } + + $hashref = { 'reason_type' => $reason_type->typenum, + 'reason' => '(none)' + }; + my $noreason = qsearchs( 'reason', $hashref ); + unless ($noreason) { + $noreason = new FS::reason( $hashref ); + my $error = $noreason->insert(); + die "can't insert legacy reason '(none)' into database: $error\n" + if $error; + } + + foreach my $cust_credit ( @cust_credits ) { + my $reason = $cust_credit->getfield('reason'); + warn "Contemplating reason $reason\n" if $DEBUG > 1; + if ($reason =~ /\S/) { + $cust_credit->reason($reason, 'reason_type' => $reason_type->typenum) + or die "can't insert legacy reason $reason into database\n"; + }else{ + $cust_credit->reasonnum($noreason->reasonnum); + } + + $cust_credit->setfield('reason', ''); + my $error = $cust_credit->replace; + + die "error inserting $self into database: $error\n" + if $error; + } + } + + warn "$me Ensuring existance of auto reasons\n" if $DEBUG; + + foreach ( keys %reasontype_map ) { + unless ($conf->config($_)) { # hmmmm +# warn "$me Found $_ reason type lacking\n" if $DEBUG; +# my $hashref = { 'class' => 'R', 'type' => $reasontype_map{$_} }; + my $hashref = { 'class' => 'R', 'type' => 'Legacy' }; + my $reason_type = qsearchs( 'reason_type', $hashref ); + unless ($reason_type) { + $reason_type = new FS::reason_type( $hashref ); + my $error = $reason_type->insert(); + die "$self had error inserting FS::reason_type into database: $error\n" + if $error; + } + # or clause for 1.7.x + $conf->set($_, $reason_type->typenum) or die "failed setting config"; + } + } + + warn "$me Ensuring commission packages have a reason type\n" if $DEBUG; + + my $hashref = { 'class' => 'R', 'type' => 'Legacy' }; + my $reason_type = qsearchs( 'reason_type', $hashref ); + unless ($reason_type) { + $reason_type = new FS::reason_type( $hashref ); + my $error = $reason_type->insert(); + die "$self had error inserting FS::reason_type into database: $error\n" + if $error; + } + + my @plans = qw( flat_comission flat_comission_cust flat_comission_pkg ); + foreach my $plan ( @plans ) { + foreach my $pkg ( qsearch('part_pkg', { 'plan' => $plan } ) ) { + unless ($pkg->option('reason_type', 1) ) { + my $plandata = $pkg->plandata. + "reason_type=". $reason_type->typenum. "\n"; + $pkg->plandata($plandata); + my $error = + $pkg->replace( undef, + 'pkg_svc' => { map { $_->svcpart => $_->quantity } + $pkg->pkg_svc + }, + 'primary_svc' => $pkg->svcpart, + ); + die "failed setting reason_type option: $error" + if $error; + } + } + } + } + + ''; + +} + =back =head1 CLASS METHODS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 9300f2c12..9d317b643 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -4589,13 +4589,13 @@ otherwise returns false. =cut sub credit { - my( $self, $amount, $reason ) = @_; + my( $self, $amount, $reason, %options ) = @_; my $cust_credit = new FS::cust_credit { 'custnum' => $self->custnum, 'amount' => $amount, 'reason' => $reason, }; - $cust_credit->insert; + $cust_credit->insert(%options); } =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ] diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index e09b8ab62..71ae0ad13 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -229,9 +229,11 @@ sub insert { my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq ); my $error = - $referring_cust_main->credit( $amount, - 'Referral credit for '. $cust_main->name - ); + $referring_cust_main-> + credit( $amount, + 'Referral credit for '.$cust_main->name, + 'reason_type' => $conf->config('referral_credit_type') + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "Error crediting customer ". $cust_main->referral_custnum. @@ -523,10 +525,12 @@ sub cancel { # Add a credit for remaining service my $remaining_value = $self->calc_remain(time=>$cancel_time); if ( $remaining_value > 0 && !$options{'no_credit'} ) { + my $conf = new FS::Conf; my $error = $self->cust_main->credit( - $remaining_value, - 'Credit for unused time on '. $self->part_pkg->pkg, - ); + $remaining_value, + 'Credit for unused time on '. $self->part_pkg->pkg, + 'reason_type' => $conf->config('cancel_credit_type'), + ); if ($error) { $dbh->rollback if $oldAutoCommit; return "Error crediting customer \$$remaining_value for unused time on". diff --git a/FS/FS/part_pkg/flat_comission.pm b/FS/FS/part_pkg/flat_comission.pm index bc02f9658..4592bedef 100644 --- a/FS/FS/part_pkg/flat_comission.pm +++ b/FS/FS/part_pkg/flat_comission.pm @@ -26,8 +26,15 @@ use FS::part_pkg::flat; 'comission_depth' => { 'name' => 'Number of layers', 'default' => 1, }, + 'reason_type' => { 'name' => 'Reason type for commission credits', + 'type' => 'select', + 'select_table' => 'reason_type', + 'select_hash' => { 'class' => 'R' }, + 'select_key' => 'typenum', + 'select_label' => 'type', + }, }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount' ], + 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount', 'reason_type' ], #'setup' => 'what.setup_fee.value', #'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'', 'weight' => 62, @@ -45,7 +52,10 @@ sub calc_recur { if ( $commission > 0 ) { - my $error = $cust_pkg->cust_main->credit( $commission, "commission" ); + my $error = + $cust_pkg->cust_main->credit( $commission, "commission", + 'reason_type'=>$self->option('reason_type'), + ); die $error if $error; } diff --git a/FS/FS/part_pkg/flat_comission_cust.pm b/FS/FS/part_pkg/flat_comission_cust.pm index 4abe66ad2..82e5111e8 100644 --- a/FS/FS/part_pkg/flat_comission_cust.pm +++ b/FS/FS/part_pkg/flat_comission_cust.pm @@ -26,8 +26,15 @@ use FS::part_pkg::flat; 'comission_depth' => { 'name' => 'Number of layers', 'default' => 1, }, + 'reason_type' => { 'name' => 'Reason type for commission credits', + 'type' => 'select_table', + 'select_table' => 'reason_type', + 'select_hash' => { 'class' => 'R' }, + 'select_key' => 'typenum', + 'select_label' => 'type', + }, }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount' ], + 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount', 'reason_type' ], #'setup' => 'what.setup_fee.value', #'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_main_ncancelled(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'', 'weight' => '60', @@ -45,7 +52,9 @@ sub calc_recur { if ( $amount && $num_active ) { my $error = - $cust_pkg->cust_main->credit( $amount*$num_active, "commission" ); + $cust_pkg->cust_main->credit( $amount*$num_active, "commission", + 'reason_type'=>$self->option('reason_type'), + ); die $error if $error; } diff --git a/FS/FS/part_pkg/flat_comission_pkg.pm b/FS/FS/part_pkg/flat_comission_pkg.pm index 0f4d02a58..07c3d1b9a 100644 --- a/FS/FS/part_pkg/flat_comission_pkg.pm +++ b/FS/FS/part_pkg/flat_comission_pkg.pm @@ -33,8 +33,15 @@ use FS::part_pkg::flat; 'select_key' => 'pkgpart', 'select_label' => 'pkg', }, + 'reason_type' => { 'name' => 'Reason type for commission credits', + 'type' => 'select', + 'select_table' => 'reason_type', + 'select_hash' => { 'class' => 'R' } , + 'select_key' => 'typenum', + 'select_label' => 'type', + }, }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount', 'comission_pkgpart' ], + 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount', 'comission_pkgpart', 'reason_type' ], #'setup' => 'what.setup_fee.value', #'recur' => '""; var pkgparts = ""; for ( var c=0; c < document.flat_comission_pkg.comission_pkgpart.options.length; c++ ) { if (document.flat_comission_pkg.comission_pkgpart.options[c].selected) { pkgparts = pkgparts + document.flat_comission_pkg.comission_pkgpart.options[c].value + \', \'; } } what.recur.value = \'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar( grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } ( \' + pkgparts + \' ) } $cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'', #'disabled' => 1, diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm index 08e76deef..3c925d412 100644 --- a/FS/FS/reason.pm +++ b/FS/FS/reason.pm @@ -1,11 +1,16 @@ package FS::reason; use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); +use vars qw( @ISA $DEBUG $me ); +use DBIx::DBSchema; +use DBIx::DBSchema::Table; +use DBIx::DBSchema::Column; +use FS::Record qw( qsearch qsearchs dbh dbdef ); use FS::reason_type; @ISA = qw(FS::Record); +$DEBUG = 0; +$me = '[FS::reason]'; =head1 NAME @@ -109,6 +114,53 @@ 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 = (); + + $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"; + }elsif( $dbh->{Driver}->{Name} =~ /^mysql/i ){ + push @sql,"ALTER TABLE $table MODIFY reason ". $column->line($dbh); + }else{ + die "watchu talkin' 'bout, Willis? (unsupported database type)"; + } + + foreach (@sql) { + my $sth = $dbh->prepare($_) or die $dbh->errstr; + $sth->execute or die $dbh->errstr; + } + } + } + + ''; + +} =back =head1 BUGS diff --git a/FS/FS/reason_type.pm b/FS/FS/reason_type.pm index 89278d08a..193d47e53 100644 --- a/FS/FS/reason_type.pm +++ b/FS/FS/reason_type.pm @@ -6,6 +6,18 @@ use FS::Record qw( qsearch qsearchs ); @ISA = qw(FS::Record); +our %class_name = ( + 'C' => 'cancel', + 'R' => 'credit', + 'S' => 'suspend', +); + +our %class_purpose = ( + 'C' => 'explain why we cancel a package', + 'R' => 'explain why we credit a customer', + 'S' => 'explain why we suspend a package', +); + =head1 NAME FS::reason_type - Object methods for reason_type records @@ -34,7 +46,7 @@ inherits from FS::Record. The following fields are currently supported: =item typenum - primary key -=item class - currently 'C' or 'S' for cancel or suspend +=item class - currently 'C', 'R', or 'S' for cancel, credit, or suspend =item type - name of the type of reason @@ -89,7 +101,7 @@ sub check { my $error = $self->ut_numbern('typenum') - || $self->ut_enum('class', [ 'C', 'S' ] ) + || $self->ut_enum('class', [ keys %class_name ] ) || $self->ut_text('type') ; return $error if $error; @@ -119,6 +131,70 @@ sub enabled_reasons { } ); } +# _populate_initial_data +# +# Used by FS::Setup to initialize a new database. +# +# + +sub _populate_initial_data { # class method + my ($self, %opts) = @_; + + my $conf = new FS::Conf; + + foreach ( keys %class_name ) { + my $object = $self->new( {'class' => $_, + 'type' => ucfirst($class_name{$_}). ' Reason', + } ); + my $error = $object->insert(); + die "error inserting $self into database: $error\n" + if $error; + } + + my $object = qsearchs('reason_type', { 'class' => 'R' }); + die "can't find credit reason type just inserted!\n" + unless $object; + + foreach ( keys %FS::cust_credit::reasontype_map ) { +# my $object = $self->new( {'class' => 'R', +# 'type' => $FS::cust_credit::reasontype_map{$_}, +# } ); +# my $error = $object->insert(); +# die "error inserting $self into database: $error\n" +# if $error; +# # or clause for 1.7.x + $conf->set($_, $object->typenum) + or die "failed setting config"; + } + + ''; + +} + +# _upgrade_data +# +# Used by FS::Upgrade to migrate to a new database. +# +# + +sub _upgrade_data { # class method + my ($self, %opts) = @_; + + foreach ( keys %class_name ) { + unless (scalar(qsearch('reason_type', { 'class' => $_ }))) { + my $object = $self->new( {'class' => $_, + 'type' => ucfirst($class_name{$_}), + } ); + my $error = $object->insert(); + die "error inserting $self into database: $error\n" + if $error; + } + } + + ''; + +} + =back =head1 BUGS diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade index 02a615a68..fa9f90099 100755 --- a/FS/bin/freeside-upgrade +++ b/FS/bin/freeside-upgrade @@ -11,6 +11,7 @@ use FS::Schema qw( dbdef dbdef_dist reload_dbdef ); use FS::Misc::prune qw(prune_applications); use FS::Conf; use FS::Record qw(qsearch); +use FS::Upgrade qw(upgrade); die "Not running uid freeside!" unless checkeuid(); @@ -92,6 +93,9 @@ if ( $dbh->{Driver}->{Name} =~ /^mysql/i ) { } } +upgrade() + unless $DRY_RUN; + $dbh->commit or die $dbh->errstr; dbdef_create($dbh, $dbdef_file); diff --git a/httemplate/browse/reason.html b/httemplate/browse/reason.html index 94141eea3..49b452cf8 100644 --- a/httemplate/browse/reason.html +++ b/httemplate/browse/reason.html @@ -38,14 +38,10 @@ die "access denied" $cgi->param('class') =~ /^(\w)$/ or die "illegal class"; my $class = $1; -my %classmap = ( 'C' => 'cancel', - 'S' => 'suspend', - ); +my $classname = $FS::reason_type::class_name{$class};; +my $classpurpose = $FS::reason_type::class_purpose{$class};; -my $classname = $classmap{$class}; - -my $html_init = ucfirst($classname) . -" reasons explain why we $classname a package.

". +my $html_init = ucfirst($classname). " reasons $classpurpose.

". qq!!. "Add a $classname reason

"; diff --git a/httemplate/browse/reason_type.html b/httemplate/browse/reason_type.html index 09f451c9f..6b444bad1 100644 --- a/httemplate/browse/reason_type.html +++ b/httemplate/browse/reason_type.html @@ -33,11 +33,7 @@ die "access denied" $cgi->param('class') =~ /^(\w)$/ or die "illegal class"; my $class=$1; -my %classmap = ( 'C' => 'cancel', - 'S' => 'suspend', - ); - -my $classname = $classmap{$class}; +my $classname = $FS::reason_type::class_name{$class}; my $html_init = ucfirst($classname) . " reason types allow groups of $classname reasons for reporting purposes." . diff --git a/httemplate/edit/cust_credit.cgi b/httemplate/edit/cust_credit.cgi index 13d062c74..b6924f4d9 100755 --- a/httemplate/edit/cust_credit.cgi +++ b/httemplate/edit/cust_credit.cgi @@ -5,7 +5,7 @@

% } -
+ @@ -30,10 +30,7 @@ Credit %#print qq! Also post refund!; % - - Reason - - +<% include('/elements/tr-select-reason.html', 'reasonnum', 'R', '', '', '', 'document.credit_popup.submit',) %> Auto-apply
to invoices diff --git a/httemplate/edit/process/cust_credit.cgi b/httemplate/edit/process/cust_credit.cgi index 19faca47a..9dcad7f68 100755 --- a/httemplate/edit/process/cust_credit.cgi +++ b/httemplate/edit/process/cust_credit.cgi @@ -3,16 +3,39 @@ %$cgi->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!"; %my $custnum = $1; % -%my $new = new FS::cust_credit ( { -% map { -% $_, scalar($cgi->param($_)); -% } fields('cust_credit') -%} ); -% -%my $error = $new->insert; +%$cgi->param('reasonnum') =~ /^(-?\d+)$/ or die "Illegal reasonnum"; +%my $reasonnum = $1; +% +%my $oldAutoCommit = $FS::UID::AutoCommit; +%local $FS::UID::AutoCommit = 0; +%my $dbh = dbh; +% +%my $error = ''; +%if ($reasonnum == -1) { +% +% $error = 'Enter a new reason (or select an existing one)' +% unless $cgi->param('newreasonnum') !~ /^\s*$/; +% my $reason = new FS::reason({ 'reason_type' => $cgi->param('newreasonnumT'), +% 'reason' => $cgi->param('newreasonnum'), +% }); +% $error ||= $reason->insert; +% $cgi->param('reasonnum', $reason->reasonnum) +% unless $error; +%} +% +%unless ($error) { +% my $new = new FS::cust_credit ( { +% map { +% $_, scalar($cgi->param($_)); +% } fields('cust_credit') +% } ); +% $error = $new->insert; +%} % %if ( $error ) { +% $cgi->param('reasonnum', $reasonnum); % $cgi->param('error', $error); +% $dbh->rollback if $oldAutoCommit; % % <% $cgi->redirect(popurl(2). "cust_credit.cgi?". $cgi->query_string ) %> @@ -27,6 +50,7 @@ % } % #print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum"); % +% $dbh->commit or die $dbh->errstr if $oldAutoCommit; % <% header('Credit sucessful') %>