Hello

I had a similar issue and it was caused by a whitespace at the end of the string, as in :

Try to remove it.

Have a nice day.

That is among the great mysteries to me. The supporters_conf.pm block which builds this value, includes the following lines:

  $val =~ s/ *$//g;  # Strip trailing white space from value
  $config{'db'}{"$key"} = $val;
  $config{"$key"} = $val;
[download]

When I use $config{'db_name'} it works. When I use the $config{'db'}{'db_name'}, it gives me the HASH ref error. Seems like that string substitution ought to clean out that extraneous space. I'm not sure why its not.

-- Hugh

Try s/\s*$//; instead of your regex. It might not be a literal space - it might be any one of a number of whitespace characters.

Plus, the problem isn't with $val, it's with $key. Try printing out $key in each iteration with single-quotes around it.

---

My criteria for good software:

1. Does it work?
2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?

#!/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;
[download]

This works, but depends on hard coded database connection parameters:

# my $dbh = vol::connect();
[download]

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);
[download]

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;
[download]

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
[download]

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
[download]

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}));
}
[download]