diff options
Diffstat (limited to 'FS/FS/Conf.pm')
| -rw-r--r-- | FS/FS/Conf.pm | 324 |
1 files changed, 243 insertions, 81 deletions
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index fdefd56c0..66fd9b30e 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -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 @@ Returns the configuration value or values (depending on context) for key. =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 { } 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 @@ Returns the exact scalar value for key. =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 @@ is undefined. =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 @@ KEY_SUFFIX, if it exists, otherwise for KEY =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 @@ Creates the specified configuration key if it does not exist. =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 @@ Sets the specified configuration key to the given value. =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 @@ can be retrieved with config_binary. =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 @@ Deletes the specified configuration key. =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 @@ sub delete { } } +=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 @@ httemplate/docs/config.html "Solo", ); +@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 $_ } ( { |