[freeside-commits] freeside/FS/FS Conf.pm, 1.198, 1.199 Conf_compat17.pm, NONE, 1.1 Misc.pm, 1.22, 1.23 Record.pm, 1.140, 1.141 UID.pm, 1.34, 1.35 cust_bill.pm, 1.172, 1.173 cust_main.pm, 1.291, 1.292 svc_acct.pm, 1.232, 1.233
Jeff Finucane,420,,
jeff at wavetail.420.am
Thu Jul 12 06:36:28 PDT 2007
Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail:/tmp/cvs-serv14318/FS/FS
Modified Files:
Conf.pm Misc.pm Record.pm UID.pm cust_bill.pm cust_main.pm
svc_acct.pm
Added Files:
Conf_compat17.pm
Log Message:
refactor freeside-init-config to module code, compare results of old/new code, have freeside-upgrade complain and revert to old code/config on failure (#1477)
Index: Conf.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Conf.pm,v
retrieving revision 1.198
retrieving revision 1.199
diff -u -d -r1.198 -r1.199
--- Conf.pm 21 Jun 2007 04:03:14 -0000 1.198
+++ Conf.pm 12 Jul 2007 13:36:25 -0000 1.199
@@ -1,16 +1,18 @@
package FS::Conf;
-use vars qw($base_dir @config_items @card_types $DEBUG );
+use vars qw($base_dir @config_items @base_items @card_types $DEBUG);
+use IO::File;
+use File::Basename;
use MIME::Base64;
use FS::ConfItem;
use FS::ConfDefaults;
+use FS::Conf_compat17;
use FS::conf;
use FS::Record qw(qsearch qsearchs);
-use FS::UID qw(dbh);
+use FS::UID qw(dbh datasrc use_confcompat);
$base_dir = '%%%FREESIDE_CONF%%%';
-
$DEBUG = 0;
=head1 NAME
@@ -78,6 +80,14 @@
=cut
+sub _usecompat {
+ my ($self, $method) = (shift, shift);
+ warn "NO CONFIGURATION RECORDS FOUND -- USING COMPATIBILITY MODE"
+ if use_confcompat;
+ my $compat = new FS::Conf_compat17 ("$base_dir/conf." . datasrc);
+ $compat->$method(@_);
+}
+
sub _config {
my($self,$name,$agent)=@_;
my $hashref = { 'name' => $name };
@@ -94,11 +104,16 @@
}
sub config {
- my($self,$name,$agent)=@_;
+ my $self = shift;
+ return $self->_usecompat('config', @_) if use_confcompat;
+
+ my($name,$agent)=@_;
my $cv = $self->_config($name, $agent) or return;
if ( wantarray ) {
- split "\n", $cv->value;
+ my $v = $cv->value;
+ chomp $v;
+ (split "\n", $v, -1);
} else {
(split("\n", $cv->value))[0];
}
@@ -111,7 +126,10 @@
=cut
sub config_binary {
- my($self,$name,$agent)=@_;
+ my $self = shift;
+ return $self->_usecompat('config_binary', @_) if use_confcompat;
+
+ my($name,$agent)=@_;
my $cv = $self->_config($name, $agent) or return;
decode_base64($cv->value);
}
@@ -124,7 +142,10 @@
=cut
sub exists {
- my($self,$name,$agent)=@_;
+ my $self = shift;
+ return $self->_usecompat('exists', @_) if use_confcompat;
+
+ my($name,$agent)=@_;
defined($self->_config($name, $agent));
}
@@ -136,7 +157,10 @@
=cut
sub config_orbase {
- my( $self, $name, $suffix ) = @_;
+ my $self = shift;
+ return $self->_usecompat('config_orbase', @_) if use_confcompat;
+
+ my( $name, $suffix ) = @_;
if ( $self->exists("${name}_$suffix") ) {
$self->config("${name}_$suffix");
} else {
@@ -151,7 +175,10 @@
=cut
sub touch {
- my($self, $name, $agent) = @_;
+ my $self = shift;
+ return $self->_usecompat('touch', @_) if use_confcompat;
+
+ my($name, $agent) = @_;
$self->set($name, '', $agent);
}
@@ -162,11 +189,14 @@
=cut
sub set {
- my($self, $name, $value, $agent) = @_;
+ my $self = shift;
+ return $self->_usecompat('set', @_) if use_confcompat;
+
+ my($name, $value, $agent) = @_;
$value =~ /^(.*)$/s;
$value = $1;
- warn "[FS::Conf] SET $file\n" if $DEBUG;
+ warn "[FS::Conf] SET $name\n" if $DEBUG;
my $old = FS::Record::qsearchs('conf', {name => $name, agent => $agent});
my $new = new FS::conf { $old ? $old->hash
@@ -194,7 +224,10 @@
=cut
sub set_binary {
- my($self,$name, $value, $agent)=@_;
+ my $self = shift;
+ return if use_confcompat;
+
+ my($name, $value, $agent)=@_;
$self->set($name, encode_base64($value), $agent);
}
@@ -205,7 +238,10 @@
=cut
sub delete {
- my($self, $name, $agent) = @_;
+ my $self = shift;
+ return $self->_usecompat('delete', @_) if use_confcompat;
+
+ my($name, $agent) = @_;
if ( my $cv = FS::Record::qsearchs('conf', {name => $name, agent => $agent}) ) {
warn "[FS::Conf] DELETE $file\n";
@@ -225,81 +261,192 @@
}
}
+=item import_config_item CONFITEM DIR
+
+ Imports the item specified by the CONFITEM (see L<FS::ConfItem>) into
+the database as a conf record (see L<FS::conf>). Imports from the file
+in the directory DIR.
+
+=cut
+
+sub import_config_item {
+ my ($self,$item,$dir) = @_;
+ my $key = $item->key;
+ if ( -e "$dir/$key" && ! use_confcompat ) {
+ warn "Inserting $key\n" if $DEBUG;
+ local $/;
+ my $value = readline(new IO::File "$dir/$key");
+ if ($item->type eq 'binary') {
+ $self->set_binary($key, $value);
+ }else{
+ $self->set($key, $value);
+ }
+ }else {
+ warn "Not inserting $key\n" if $DEBUG;
+ }
+}
+
+=item verify_config_item CONFITEM DIR
+
+ Compares the item specified by the CONFITEM (see L<FS::ConfItem>) in
+the database to the legacy file value in DIR.
+
+=cut
+
+sub verify_config_item {
+ return '' if use_confcompat;
+ my ($self,$item,$dir) = @_;
+ my $key = $item->key;
+ my $type = $item->type;
+
+ my $compat = new FS::Conf_compat17 $dir;
+ my $error = '';
+
+ $error .= "$key fails existential comparison; "
+ if $self->exists($key) xor $compat->exists($key);
+
+ unless ($type eq 'binary') {
+ {
+ no warnings;
+ $error .= "$key fails scalar comparison; "
+ unless scalar($self->config($key)) eq scalar($compat->config($key));
+ }
+
+ my (@new) = $self->config($key);
+ my (@old) = $compat->config($key);
+ unless ( scalar(@new) == scalar(@old)) {
+ $error .= "$key fails list comparison; ";
+ }else{
+ my $r=1;
+ foreach (@old) { $r=0 if ($_ cmp shift(@new)); }
+ $error .= "$key fails list comparison; "
+ unless $r;
+ }
+ }
+
+ if ($type eq 'binary') {
+ $error .= "$key fails binary comparison; "
+ unless scalar($self->config_binary($key)) eq scalar($compat->config_binary($key));
+ }
+
+ if ($error =~ /existential comparison/ && $item->section eq 'deprecated') {
+ my $proto;
+ for ( @config_items ) { $proto = $_; last if $proto->key eq $key; }
+ unless ($proto->key eq $key) {
+ warn "removed config item $error\n" if $DEBUG;
+ $error = '';
+ }
+ }
+
+ $error;
+}
+
+#item _orbase_items OPTIONS
+#
+#Returns all of the possible extensible config items as FS::ConfItem objects.
+#See #L<FS::ConfItem>. OPTIONS consists of name value pairs. Possible
+#options include
+#
+# dir - the directory to search for configuration option files instead
+# of using the conf records in the database
+#
+#cut
+
+#quelle kludge
+sub _orbase_items {
+ my ($self, %opt) = @_;
+
+ my $listmaker = sub { my $v = shift;
+ $v =~ s/_/!_/g;
+ if ( $v =~ /\.(png|eps)$/ ) {
+ $v =~ s/\./!_%./;
+ }else{
+ $v .= '!_%';
+ }
+ map { $_->name }
+ FS::Record::qsearch( 'conf',
+ {},
+ '',
+ "WHERE name LIKE '$v' ESCAPE '!'"
+ );
+ };
+
+ if (exists($opt{dir}) && $opt{dir}) {
+ $listmaker = sub { my $v = shift;
+ if ( $v =~ /\.(png|eps)$/ ) {
+ $v =~ s/\./_*./;
+ }else{
+ $v .= '_*';
+ }
+ map { basename $_ } glob($opt{dir}. "/$v" );
+ };
+ }
+
+ ( map {
+ my $proto;
+ my $base = $_;
+ for ( @config_items ) { $proto = $_; last if $proto->key eq $base; }
+ die "don't know about $base items" unless $proto->key eq $base;
+
+ map { new FS::ConfItem {
+ 'key' => $_,
+ 'section' => $proto->section,
+ 'description' => 'Alternate ' . $proto->description . ' See the <a href="../docs/billing.html">billing documentation</a> for details.',
+ 'type' => $proto->type,
+ };
+ } &$listmaker($base);
+ } @base_items,
+ );
+}
+
=item config_items
-Returns all of the possible configuration items as FS::ConfItem objects. See
-L<FS::ConfItem>.
+Returns all of the possible global/default configuration items as
+FS::ConfItem objects. See L<FS::ConfItem>.
=cut
sub config_items {
my $self = shift;
- #quelle kludge
- @config_items,
- ( map {
- new FS::ConfItem {
- 'key' => $_->name,
- 'section' => 'billing',
- 'description' => 'Alternate template file for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
- 'type' => 'textarea',
- }
- } FS::Record::qsearch('conf', {}, '', "WHERE name LIKE 'invoice!_template!_%' ESCAPE '!'")
- ),
- ( map {
- new FS::ConfItem {
- 'key' => '$_->name',
- 'section' => 'billing', #?
- 'description' => 'An image to include in some types of invoices',
- 'type' => 'binary',
- }
- } FS::Record::qsearch('conf', {}, '', "WHERE name LIKE 'logo!_%.png' ESCAPE '!'")
- ),
- ( map {
- new FS::ConfItem {
- 'key' => $_->name,
- 'section' => 'billing',
- 'description' => 'Alternate HTML template for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
- 'type' => 'textarea',
- }
- } FS::Record::qsearch('conf', {}, '', "WHERE name LIKE 'invoice!_html!_%' ESCAPE '!'")
- ),
- ( map {
- ($latexname = $_->name ) =~ s/latex/html/;
- new FS::ConfItem {
- 'key' => $_->name,
- 'section' => 'billing',
- 'description' => "Alternate Notes section for HTML invoices. Defaults to the same data in $latexname if not specified.",
- 'type' => 'textarea',
- }
- } FS::Record::qsearch('conf', {}, '', "WHERE name LIKE 'invoice!_htmlnotes!_%' ESCAPE '!'")
- ),
- ( map {
- new FS::ConfItem {
- 'key' => $_->name,
- 'section' => 'billing',
- 'description' => 'Alternate LaTeX template for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
- 'type' => 'textarea',
- }
- } FS::Record::qsearch('conf', {}, '', "WHERE name LIKE 'invoice!_latex!_%' ESCAPE '!'")
- ),
- ( map {
- new FS::ConfItem {
- 'key' => '$_->name',
- 'section' => 'billing', #?
- 'description' => 'An image to include in some types of invoices',
- 'type' => 'binary',
- }
- } FS::Record::qsearch('conf', {}, '', "WHERE name LIKE 'logo!_%.eps' ESCAPE '!'")
- ),
- ( map {
- new FS::ConfItem {
- 'key' => $_->name,
- 'section' => 'billing',
- 'description' => 'Alternate Notes section for LaTeX typeset PostScript invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
- 'type' => 'textarea',
- }
- } FS::Record::qsearch('conf', {}, '', "WHERE name LIKE 'invoice!_latexnotes!_%' ESCAPE '!'")
- );
+ return $self->_usecompat('config_items', @_) if use_confcompat;
+
+ ( @config_items, $self->_orbase_items(@_) );
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item init-config DIR
+
+Imports the non-deprecated configuration items from DIR (1.7 compatible)
+to conf records in the database.
+
+=cut
+
+sub init_config {
+ my $dir = shift;
+
+ {
+ local $FS::UID::use_confcompat = 0;
+ my $conf = new FS::Conf;
+ foreach my $item ( $conf->config_items(dir => $dir) ) {
+ $conf->import_config_item($item, $dir);
+ my $error = $conf->verify_config_item($item, $dir);
+ return $error if $error;
+ }
+
+ my $compat = new FS::Conf_compat17 $dir;
+ foreach my $item ( $compat->config_items ) {
+ my $error = $conf->verify_config_item($item, $dir);
+ return $error if $error;
+ }
+ }
+
+ $FS::UID::use_confcompat = 0;
+ ''; #success
}
=back
@@ -331,6 +478,21 @@
"Solo",
);
+ at base_items = qw (
+ invoice_template
+ invoice_latex
+ invoice_latexreturnaddress
+ invoice_latexfooter
+ invoice_latexsmallfooter
+ invoice_latexnotes
+ invoice_html
+ invoice_htmlreturnaddress
+ invoice_htmlfooter
+ invoice_htmlnotes
+ logo.png
+ logo.eps
+ );
+
@config_items = map { new FS::ConfItem $_ } (
{
Index: cust_main.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main.pm,v
retrieving revision 1.291
retrieving revision 1.292
diff -u -d -r1.291 -r1.292
--- cust_main.pm 11 Jul 2007 08:35:34 -0000 1.291
+++ cust_main.pm 12 Jul 2007 13:36:26 -0000 1.292
@@ -4566,7 +4566,7 @@
@fuzzyfields = ( 'last', 'first', 'company' );
sub check_and_rebuild_fuzzyfiles {
- my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
}
@@ -4578,7 +4578,7 @@
use Fcntl qw(:flock);
- my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
mkdir $dir, 0700 unless -d $dir;
foreach my $fuzzy ( @fuzzyfields ) {
@@ -4616,7 +4616,7 @@
sub all_X {
my( $self, $field ) = @_;
- my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
open(CACHE,"<$dir/cust_main.$field")
or die "can't open $dir/cust_main.$field: $!";
my @array = map { chomp; $_; } <CACHE>;
@@ -4635,7 +4635,7 @@
use Fcntl qw(:flock);
- my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
foreach my $field (qw( first last company )) {
my $value = shift;
Index: UID.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/UID.pm,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -d -r1.34 -r1.35
--- UID.pm 19 Apr 2007 03:15:27 -0000 1.34
+++ UID.pm 12 Jul 2007 13:36:26 -0000 1.35
@@ -4,7 +4,7 @@
use vars qw(
@ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
$conf_dir $secrets $datasrc $db_user $db_pass %callback @callback
- $driver_name $AutoCommit $callback_hack
+ $driver_name $AutoCommit $callback_hack $use_confcompat
);
use subs qw(
getsecrets cgisetotaker
@@ -17,13 +17,15 @@
@ISA = qw(Exporter);
@EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
- getotaker dbh datasrc getsecrets driver_name myconnect );
+ getotaker dbh datasrc getsecrets driver_name myconnect
+ use_confcompat);
$freeside_uid = scalar(getpwnam('freeside'));
-$conf_dir = "%%%FREESIDE_CONF%%%/";
+$conf_dir = "%%%FREESIDE_CONF%%%";
$AutoCommit = 1; #ours, not DBI
+$use_confcompat = 1;
$callback_hack = 0;
=head1 NAME
@@ -105,6 +107,18 @@
FS::CurrentUser->load_user($user);
+ if ($dbh && ! $callback_hack) {
+ my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
+ $sth->execute or die $sth->errstr;
+ my $confcount = $sth->fetchrow_arrayref->[0];
+
+ if ($confcount) {
+ $use_confcompat = 0;
+ }else{
+ warn "NO CONFIGURATION RECORDS FOUND" unless $confcount;
+ }
+ }
+
unless($callback_hack) {
foreach ( keys %callback ) {
&{$callback{$_}};
@@ -299,6 +313,16 @@
($datasrc, $db_user, $db_pass);
}
+=item use_confcompat
+
+Returns true whenever we should use 1.7 configuration compatibility.
+
+=cut
+
+sub use_confcompat {
+ $use_confcompat;
+}
+
=back
=head1 CALLBACKS
Index: svc_acct.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_acct.pm,v
retrieving revision 1.232
retrieving revision 1.233
diff -u -d -r1.232 -r1.233
--- svc_acct.pm 5 Jun 2007 15:08:40 -0000 1.232
+++ svc_acct.pm 12 Jul 2007 13:36:26 -0000 1.233
@@ -2310,7 +2310,7 @@
=cut
sub check_and_rebuild_fuzzyfiles {
- my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
-e "$dir/svc_acct.username"
or &rebuild_fuzzyfiles;
}
@@ -2323,7 +2323,7 @@
use Fcntl qw(:flock);
- my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
#username
@@ -2349,7 +2349,7 @@
=cut
sub all_username {
- my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
open(USERNAMECACHE,"<$dir/svc_acct.username")
or die "can't open $dir/svc_acct.username: $!";
my @array = map { chomp; $_; } <USERNAMECACHE>;
@@ -2368,7 +2368,7 @@
use Fcntl qw(:flock);
- my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
open(USERNAME,">>$dir/svc_acct.username")
or die "can't open $dir/svc_acct.username: $!";
--- NEW FILE: Conf_compat17.pm ---
package FS::Conf_compat17;
use vars qw($default_dir $base_dir @config_items @card_types $DEBUG );
use IO::File;
use File::Basename;
use FS::ConfItem;
use FS::ConfDefaults;
$base_dir = '%%%FREESIDE_CONF%%%';
$default_dir = '%%%FREESIDE_CONF%%%';
$DEBUG = 0;
=head1 NAME
FS::Conf - Freeside configuration values
=head1 SYNOPSIS
[...2102 lines suppressed...]
{
'key' => 'disable_void_after',
'section' => 'billing',
'description' => 'Number of seconds after which freeside won\'t attempt to VOID a payment first when performing a refund.',
'type' => 'text',
},
{
'key' => 'disable_line_item_date_ranges',
'section' => 'billing',
'description' => 'Prevent freeside from automatically generating date ranges on invoice line items.',
'type' => 'checkbox',
},
);
1;
Index: cust_bill.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill.pm,v
retrieving revision 1.172
retrieving revision 1.173
diff -u -d -r1.172 -r1.173
--- cust_bill.pm 21 Jun 2007 04:03:14 -0000 1.172
+++ cust_bill.pm 12 Jul 2007 13:36:26 -0000 1.173
@@ -1997,7 +1997,7 @@
die "guru meditation #54";
}
- my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
my $lh = new File::Temp( TEMPLATE => 'invoice.'. $self->invnum. '.XXXXXXXX',
DIR => $dir,
SUFFIX => '.eps',
@@ -2070,7 +2070,7 @@
my ($file, $lfile) = $self->print_latex(@_);
- my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
chdir($dir);
#system('pdflatex', "$file.tex");
Index: Record.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Record.pm,v
retrieving revision 1.140
retrieving revision 1.141
diff -u -d -r1.140 -r1.141
--- Record.pm 5 Jul 2007 22:05:27 -0000 1.140
+++ Record.pm 12 Jul 2007 13:36:26 -0000 1.141
@@ -757,6 +757,7 @@
# Encrypt before the database
+ my $conf = new FS::Conf;
if ($conf->exists('encryption') && defined(eval '@FS::'. $table . '::encrypted_fields')) {
foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
$self->{'saved'} = $self->getfield($field);
@@ -1254,6 +1255,7 @@
# If we're encrypting then don't ever store the payinfo or CVV2 in the history....
# You can see if it changed by the paymask...
+ my $conf = new FS::Conf;
if ($conf->exists('encryption') ) {
@fields = grep $_ ne 'payinfo' && $_ ne 'cvv2', @fields;
}
Index: Misc.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Misc.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- Misc.pm 21 Jun 2007 04:03:14 -0000 1.22
+++ Misc.pm 12 Jul 2007 13:36:25 -0000 1.23
@@ -308,7 +308,7 @@
unless exists($options{'dialstring'});
if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
- my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
my $fh = new File::Temp(
TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
DIR => $dir,
@@ -484,7 +484,7 @@
sub generate_ps {
my $file = shift;
- my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
chdir($dir);
my $sfile = shell_quote $file;
More information about the freeside-commits
mailing list