{ 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
],
###
&& ( $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 };
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...
'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;
'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 : '';
+ },
+ },
);
'amount', @money_type, '', '',
'otaker', 'varchar', '', 32, '', '',
'reason', 'text', 'NULL', '', '', '',
+ 'reasonnum', 'int', 'NULL', '', '', '',
'closed', 'char', 'NULL', 1, '', '',
],
'primary_key' => 'crednum',
'columns' => [
'reasonnum', 'serial', '', '', '', '',
'reason_type', 'int', '', '', '', '',
- 'reason', 'varchar', '', $char_d, '', '',
+ 'reason', 'text', '', '', '', '',
'disabled', 'char', 'NULL', 1, '', '',
],
'primary_key' => 'reasonnum',
eval "use $class;";
die $@ if $@;
+ $class->_populate_initial_data(%opt)
+ if $class->can('_populate_inital_data');
+
my @records = @{ $data->{$table} };
foreach my $record ( @records ) {
{ 'groupname' => 'Superuser' },
],
+ #reason types
+ 'reason_type' => [],
+
#XXX need default new-style billing events
# #billing events
# 'part_bill_event' => [
--- /dev/null
+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;
+
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 {
};
+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
=item otaker - order taker (assigned automatically, see L<FS::UID>)
-=item reason - text
+=item reason - text ( deprecated )
+
+=item reasonum - int reason (see L<FS::reason>)
=item closed - books closed flag, empty or `Y'
=cut
sub insert {
- my $self = shift;
+ my ($self, %options) = @_;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
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;
|| $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;
}
+=item reason
+
+Returns the text of the associated reason (see L<FS::reason>) 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
=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 ] ] ]
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.
# 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".
'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,
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;
}
'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',
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;
}
'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,
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
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
@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
=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
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;
} );
}
+# _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
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();
}
}
+upgrade()
+ unless $DRY_RUN;
+
$dbh->commit or die $dbh->errstr;
dbdef_create($dbh, $dbdef_file);
$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.<BR><BR>".
+my $html_init = ucfirst($classname). " reasons $classpurpose.<BR><BR>".
qq!<A HREF="${p}edit/reason.html?class=$class">!.
"<I>Add a $classname reason</I></A><BR><BR>";
$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." .
<BR><BR>
% }
-<FORM ACTION="<% $p1 %>process/cust_credit.cgi" METHOD=POST>
+<FORM NAME="credit_popup" ACTION="<% $p1 %>process/cust_credit.cgi" METHOD=POST>
<INPUT TYPE="hidden" NAME="crednum" VALUE="">
<INPUT TYPE="hidden" NAME="custnum" VALUE="<% $custnum %>">
<INPUT TYPE="hidden" NAME="paybatch" VALUE="">
%#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="$refund">Also post refund!;
%
- <TR>
- <TD ALIGN="right">Reason</TD>
- <TD BGCOLOR="#ffffff"><INPUT TYPE="text" NAME="reason" VALUE="<% $reason %>" SIZE=32></TD>
- </TR>
+<% include('/elements/tr-select-reason.html', 'reasonnum', 'R', '', '', '', 'document.credit_popup.submit',) %>
<TR>
<TD ALIGN="right">Auto-apply<BR>to invoices</TD>
%$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 ) %>
% }
% #print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
%
+% $dbh->commit or die $dbh->errstr if $oldAutoCommit;
%
<% header('Credit sucessful') %>
<SCRIPT TYPE="text/javascript">
% $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 (@types) = qsearch( 'reason_type', { 'class' => $class } );
%
%$cgi->param('class') =~ /^(\w)$/;
%my $class = $1;
%
-%my %classmap = ( 'C' => 'Cancel',
-% 'S' => 'Suspend',
-% );
-%
-%my $classname = $classmap{$class};
+%my $classname = $FS::reason_type::class_name{$class};
%
<% include( 'elements/edit.html',
'name' => $classname . ' Reason Type',
$config_billing{'View/Edit prepaid cards'} = [ $fsurl.'search/prepay_credit.html', 'View outstanding cards, generate new cards' ];
$config_billing{'View/Edit call rates and regions'} = [ $fsurl.'browse/rate.cgi', 'Manage rate plans, regions and prefixes for VoIP and call billing' ];
$config_billing{'View/Edit locales and tax rates'} = [ $fsurl.'browse/cust_main_county.cgi', 'Change tax rates, or break down a country into states, or a state into counties and assign different tax rates to each' ];
+ $config_billing{'View/Edit credit reason types'} = [ $fsurl.'browse/reason_type.html?class=R', 'Credit reason types define groups of reasons, for reporting and convenience purposes.' ];
}
tie my %config_dialup, 'Tie::IxHash',
</TD>
</TR>
+% my @types = qsearch( 'reason_type', { 'class' => $class } );
+% if (scalar(@types) < 1) { # we should never reach this
+<TR>
+ <TD ALIGN="right">
+ <P>No reason types. Go add some. </P>
+ </TD>
+</TR>
+% }elsif (scalar(@types) == 1) {
+<TR>
+ <TD ALIGN="right">
+ <P id="new<% $name %>TLabel" style="display:<% $display %>">Reason Type</P>
+ </TD>
+ <TD>
+ <P id="new<% $name %>T" disabled="<% $disabled %>" style="display:<% $display %>"><% $types[0]->type %>
+ <INPUT type="hidden" name="new<% $name %>T" value="<% $types[0]->typenum %>">
+ </TD>
+</TR>
+
+% }else{
+
<TR>
<TD ALIGN="right">
<P id="new<% $id %>TLabel" style="display:<% $display %>">Reason Type</P>
</TD>
<TD>
<SELECT id="new<% $id %>T" name="new<% $name %>T" "<% $disabled %>" style="display:<% $display %>">
-% for my $type (qsearch( 'reason_type', { 'class' => $class } )){
+% for my $type (@types)){
<OPTION VALUE="<% $type->typenum %>" <% ($init_type == $type->typenum) ? 'SELECTED' : '' %>><% $type->type %></OPTION>
% }
</SELECT>
</TD>
</TR>
+% }
<TR>
<TD ALIGN="right">
} elsif ($class eq 'S') {
$access_right = 'Suspend customer package';
$add_access_right = 'Add on-the-fly suspend reason';
+} elsif ($class eq 'S') {
+ $access_right = 'Post credit';
+ $add_access_right = 'Add on-the-fly credit reason';
} else {
die "illegal class: $class";
}
}
-my $extra_sql = "WHERE class = '$class' ORDER BY reason_type";
+my $extra_sql = "WHERE class = '$class' and (disabled = '' OR disabled is NULL) ".
+ "ORDER BY reason_type";
my $curuser = $FS::CurrentUser::CurrentUser;
</%init>
projects / freeside.git / commitdiff