[freeside-commits] freeside/FS/FS AccessRight.pm, 1.24, 1.25 Conf.pm, 1.213, 1.214 Schema.pm, 1.74, 1.75 Setup.pm, 1.11, 1.12 Upgrade.pm, 1.1, 1.2 cust_credit.pm, 1.26, 1.27 cust_main.pm, 1.325, 1.326 cust_pkg.pm, 1.85, 1.86 reason.pm, 1.3, 1.4 reason_type.pm, 1.1, 1.2 Conf_compat17.pm, 1.1, 1.2
Jeff Finucane,420,,
jeff at wavetail.420.am
Tue Dec 4 10:21:00 PST 2007
Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail:/tmp/cvs-serv23022/FS/FS
Modified Files:
AccessRight.pm Conf.pm Schema.pm Setup.pm cust_credit.pm
cust_main.pm cust_pkg.pm reason.pm reason_type.pm
Conf_compat17.pm
Added Files:
Upgrade.pm
Log Message:
change credit reasons from freetext to new reason/reason type system (#2777)
Index: Conf.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Conf.pm,v
retrieving revision 1.213
retrieving revision 1.214
diff -u -d -r1.213 -r1.214
--- Conf.pm 9 Nov 2007 19:20:10 -0000 1.213
+++ Conf.pm 4 Dec 2007 18:20:56 -0000 1.214
@@ -2102,6 +2102,63 @@
'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;
Index: cust_credit.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_credit.pm,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- cust_credit.pm 1 Aug 2007 22:24:36 -0000 1.26
+++ cust_credit.pm 4 Dec 2007 18:20:56 -0000 1.27
@@ -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 @@
};
+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 @@
=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'
@@ -91,7 +103,7 @@
=cut
sub insert {
- my $self = shift;
+ my ($self, %options) = @_;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
@@ -107,6 +119,20 @@
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 @@
|| $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 @@
}
+=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
Index: cust_main.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main.pm,v
retrieving revision 1.325
retrieving revision 1.326
diff -u -d -r1.325 -r1.326
--- cust_main.pm 30 Nov 2007 03:24:40 -0000 1.325
+++ cust_main.pm 4 Dec 2007 18:20:56 -0000 1.326
@@ -4589,13 +4589,13 @@
=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 ] ] ]
Index: cust_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pkg.pm,v
retrieving revision 1.85
retrieving revision 1.86
diff -u -d -r1.85 -r1.86
--- cust_pkg.pm 17 Oct 2007 16:07:59 -0000 1.85
+++ cust_pkg.pm 4 Dec 2007 18:20:57 -0000 1.86
@@ -229,9 +229,11 @@
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 @@
# 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".
Index: Conf_compat17.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Conf_compat17.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Conf_compat17.pm 12 Jul 2007 13:36:25 -0000 1.1
+++ Conf_compat17.pm 4 Dec 2007 18:20:57 -0000 1.2
@@ -2133,7 +2133,62 @@
'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 : '';
+ },
+ },
);
Index: reason_type.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/reason_type.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- reason_type.pm 19 Oct 2006 14:23:36 -0000 1.1
+++ reason_type.pm 4 Dec 2007 18:20:57 -0000 1.2
@@ -6,6 +6,18 @@
@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 @@
=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 @@
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 @@
} );
}
+# _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
Index: Setup.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Setup.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- Setup.pm 28 Oct 2007 12:51:29 -0000 1.11
+++ Setup.pm 4 Dec 2007 18:20:56 -0000 1.12
@@ -150,6 +150,9 @@
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 @@
{ 'groupname' => 'Superuser' },
],
+ #reason types
+ 'reason_type' => [],
+
#XXX need default new-style billing events
# #billing events
# 'part_bill_event' => [
Index: reason.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/reason.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- reason.pm 1 Aug 2007 19:19:15 -0000 1.3
+++ reason.pm 4 Dec 2007 18:20:57 -0000 1.4
@@ -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 @@
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
Index: Schema.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Schema.pm,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -d -r1.74 -r1.75
--- Schema.pm 29 Nov 2007 03:05:46 -0000 1.74
+++ Schema.pm 4 Dec 2007 18:20:56 -0000 1.75
@@ -512,6 +512,7 @@
'amount', @money_type, '', '',
'otaker', 'varchar', '', 32, '', '',
'reason', 'text', 'NULL', '', '', '',
+ 'reasonnum', 'int', 'NULL', '', '', '',
'closed', 'char', 'NULL', 1, '', '',
],
'primary_key' => 'crednum',
@@ -1891,7 +1892,7 @@
'columns' => [
'reasonnum', 'serial', '', '', '', '',
'reason_type', 'int', '', '', '', '',
- 'reason', 'varchar', '', $char_d, '', '',
+ 'reason', 'text', '', '', '', '',
'disabled', 'char', 'NULL', 1, '', '',
],
'primary_key' => 'reasonnum',
Index: AccessRight.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/AccessRight.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -d -r1.24 -r1.25
--- AccessRight.pm 24 Sep 2007 00:56:49 -0000 1.24
+++ AccessRight.pm 4 Dec 2007 18:20:56 -0000 1.25
@@ -169,6 +169,7 @@
{ 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
],
###
--- NEW FILE: Upgrade.pm ---
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;
More information about the freeside-commits
mailing list