OK. Here is all the relevant code. I cut out most commented out lines and the dispatch logic and subroutines which follow the error I'm getting on the HASH ref issue.
#!/usr/bin/perl -w
use strict;
use CGI::Pretty qw(:all *table param);
use CGI::Carp qw(fatalsToBrowser);
use HTML::Parser;
use Data::Dumper;
use Time::Local;
# Load custom configuration from supporters.conf
use supporters_conf qw(%config);
use lib @{$supporters_conf::config{'lib'}};
use vol;
use MailingList;
use htmlgui;
use timer;
This works, but depends on hard coded database connection parameters:
# my $dbh = vol::connect();
These work. And represent what is currently on the server.
my($host) = $config{'db_host_name'};
my($db) = $config{'db_name'};
my($user) = $config{'db_user'};
my($pw) = $config{'db_pw'};
my $dbh = vol::connect_new($host,$db,$user,$pw);
This does not work, but throws up the HASH ref errors. But if I can somehow get it to work, then propogate what I learn to the $config{conf} and $config{copy} portions of the configuration hash, I shuld be able to greatly simplify my subsequent subroutine calls.
# my($host) = $config{'db'}{'db_host_name'};
# my($db) = $config{'db'}{'db_name'};
# my($user) = $config{'db'}{'db_user'};
# my($pw) = $config{'db'}{'db_pw'};
# my ($host,$db,$user,$pw) = ($config{qw(db_host_name db_name db_user
+db_pw)});
# my $dbh = vol::connect_new(@{$config{'db'}{qw(db_host_name db_name d
+b_user db_pw)}});
# etc., etc., etc.
1;
This is the supporters_conf package which parses the configuration files.
package supporters_conf;
use strict;
use warnings;
use CGI qw(:all); # included only for url()
# this should be able to be narrowed
BEGIN {
use Exporter ();
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
# set the version for version checking
$VERSION = sprintf "%d.%03d", q$Revision: 1.9 $ =~ /(\d+)/g;
@ISA = qw(Exporter);
@EXPORT = qw();
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
# your exported package globals go here,
# as well as any optionally exported functions
@EXPORT_OK = qw(%config);
}
our @EXPORT_OK;
# exported package globals go here
our %config;
# initialize package globals, first exported ones
%config = ();
END { } # module clean-up code here (global destructor)
## YOUR CODE GOES HERE
my @required_vars = qw( lib post_max disable_uploads headers_once db t
+emplate use_db donor_mail list_mail sub_method admin_
cc admin_from mm_svr_admin mm_svr_admin_eml mm_svr_admin_phn field_
+coordinator field_coordinator_eml mm_svr_host);
# Load our configuration.
my $path = $0;
$path =~ s/\/[^\/]+$//;
# strip off filename component of filespec (and last slash)
my $url = url();
my $conf = parse_config_directory($url);
my $copy = $conf;
$copy =~ s/.conf$/.copy/;
my $db = $conf;
$db =~ s/\.conf$/.db/;
open(DB,"$db")
or open(DB,"$path/supporters.db")
or open(DB, "supporters.db")
or die "Can't open $conf or $path/supporters.db or supporters.db";
while (<DB>) {
chomp;
next if /^\s*\#/; # Allow comments
next if /^\s*$/; # Allow blank lines
unless (/=/) { # All other lines must lo
+ok like: KEY = VAL
die "invalid variable assignment in supporters.db: $_";
}
my ($key, $val) = split(/\s*=\s*/,$_,2); # Key and value are separ
+ated by equals and maybe space
$key =~ s/^\s*//; # Strip any leading space
+ from the key
# $val =~ s/(\$(\w+))/$config{$2}/g; # Very simple (read: bri
+ttle) variable interpolation
$val =~ s/ *$//g; # Strip trailing white spac
+e from value
$config{'db'}{"$key"} = $val;
$config{"$key"} = $val;
}
close DB;
open(CONFIG,"$conf")
or open(CONFIG,"$path/supporters.conf")
or open(CONFIG, "supporters.conf")
or die "Can't open $conf or $path/supporters.conf or supporters.con
+f";
while (<CONFIG>) {
chomp;
next if /^\s*\#/; # Allow comments
next if /^\s*$/; # Allow blank lines
unless (/=/) { # All other lines must lo
+ok like: KEY = VAL
die "invalid variable assignment in supporters.conf: $_";
}
my ($key, $val) = split(/\s*=\s*/,$_,2); # Key and value are separ
+ated by equals and maybe space
$key =~ s/^\s*//; # Strip any leading space
+ from the key
$val =~ s/(\$(\w+))/$config{$2}/g; # Very simple (read: brit
+tle) variable interpolation
$config{$key} = $val;
$config{'config'}{$key} = $val;
}
close CONFIG;
foreach my $var (@required_vars) {
if (!exists($config{$var})) {
die "Required configuration variable '$var' not found in supporter
+s.conf";
}
}
# Replace the 'lib' string with an array of libs
$config{'lib'} = [split(/:/, $config{'lib'})];
open(COPY,"$copy")
or open(COPY,"$path/supporters.copy")
or open(COPY, "supporters.copy")
or die "Can't open $copy or $path/supporters.copy or supporters.cop
+y";
my $pending = '0';
my ($copykey,$copyvalue,$junk);
while (<COPY>) {
chomp;
next if /^\s*\#/; # skip comments
next if (/^\s*$/ && $pending == '0');
# skip blank lines
if (m/<<END$/) { # identify key names
($copykey,$junk) = split(/\s+=\s+/),$_;
$pending = '1';
next;
} elsif (m/^END$/) { # identify the end of a value
$copykey =~ s/^\s*//; # Strip any leading space from the key
$copykey =~ s/\$//;
$copyvalue =~ s/(\$(\w+))/$config{$2}/g;
# Very simple (read: brittle) variable interpolation
$config{$copykey} = $copyvalue;
$config{'copy'}{$copykey} = $copyvalue;
print STDERR $copykey,"\n";
print STDERR $config{'$copykey'},"\n";
$copyvalue = '';
$pending = '0';
next;
} else {
$copyvalue .= $_." ";
next;
}
}
close COPY;
1;
sub parse_config_directory {
my($conf)=@_;
my $scriptpath = $0;
my $scriptname = $0;
$scriptname =~ s/^(.*)\///;
$scriptpath =~ s/$scriptname//;
$conf =~ s/https:\/\///;
$conf =~ s/http:\/\///;
$conf =~ s/\//./g;
$conf =~ s/\.$scriptname//;
$conf =
$scriptpath."conf.d/".$conf."/supporters.conf";
return $conf;
} # END parse_url
And here is the supporters.db file. The supporters.copy and the supporters.conf files use a similiar format, except that the .copy file permits multiline strings.
# supporters.db
# Database Configuration file for supporters.cgi
#+-----------------------------------------------------
#| Database Server Settings
#+-----------------------------------------------------
db_host_name = localhost
db_name = databasename
db_user = user
db_pw = secret
And finally, a couple of relevant subroutines from the vol.pm module:
package vol;
use strict;
use DBI;
use CGI qw(:all *table param);
use CGI::Carp qw(fatalsToBrowser);
use HTML::Parser;
use Mail::Mailer;
use Time::DaysInMonth;
# use CGI::Session;
$CGI::POST_MAX=1024 * 100; # max 100K posts
$CGI::DISABLE_UPLOADS = 1; # no uploads
$CGI::HEADERS_ONCE = 1;
my $host_name = "localhost";
my $db_name = "databasename";
my $dsn = "DBI:mysql:host=$host_name;database=$db_name";
# Connect to MySQL Server, using hardcoded userID and password
sub connect {
return (DBI->connect($dsn,"user","secret",
{PrintError => 0, RaiseError => 1}));
}
sub connect_new {
my($host,$db,$user,$pw) = @_;
# my $host = "$config{'db'}{'db_host_name'}";
# my $db = "$config{'db'}{'db_name'}";
# my $user = "$config{'db'}{'db_user'}";
# my $pw = "$config{'db'}{'db_pw'}";
my $dsn = "DBI:mysql:host=$host;database=$db";
return (DBI->connect($dsn,$user,$pw,
{PrintError => 0, RaiseError => 1}));
}
