Fix config->as_hash

* lib/App/Glacier/Config.pm (as_hashref): New method.
(as_hash): Return a hash.

2 files changed, 30 insertions, 5 deletions

diff --git a/lib/App/Glacier/Command.pm b/lib/App/Glacier/Command.pm
index 62a236b..7178a75 100644
--- a/lib/App/Glacier/Command.pm
+++ b/lib/App/Glacier/Command.pm
@@ -134,25 +134,25 @@ sub new {
 	    $account = $self->{_config}->get(qw(glacier access))
 		unless defined $account;
 	    if ($creds->has_key($account)) {
 		$self->{_config}->set(qw(glacier access),
 				      $creds->access_key($account));
 		$self->{_config}->set(qw(glacier secret),
 				      $creds->secret_key($account));
 		$region = $creds->region($account) unless defined $region;
 	    }
 	}
     }
 
-    $self->{_glacier} = new App::Glacier::Bre(%{$self->config->as_hash('glacier')//{}});
+    $self->{_glacier} = new App::Glacier::Bre($self->config->as_hash('glacier'));
     if ($self->{_glacier}->lasterr) {
 	$self->abend(EX_CONFIG, $self->{_glacier}->last_error_message);
     }
     return $self;
 }
 
 # Produce a semi-flat clone of $orig, blessing it into $class.
 # The clone is semi-flat, because it shares the parsed configuration and
 # the glacier object with the $orig.
 sub clone {
     my ($class, $orig) = @_;
     my $self = $class->SUPER::clone($orig);
@@ -174,25 +174,25 @@ sub touchdir {
             }
             exit(EX_CANTCREAT);
         }
     }
 }
 
 sub jobdb {
     my $self = shift;
     unless ($self->{_jobdb}) {
         my $be = $self->cfget(qw(database job backend));
 	$self->{_jobdb} = new App::Glacier::Roster(
 	    $be,
-	    %{$self->config->as_hash(qw(database job)) // {}}
+	    $self->config->as_hash(qw(database job))
 	);
     }
     return $self->{_jobdb};
 }
 
 sub describe_vault {
     my ($self, $vault_name) = @_;
     my $res = $self->glacier->Describe_vault($vault_name);
     if ($self->glacier->lasterr) {
 	if ($self->glacier->lasterr('code') == 404) {
 	    return undef;
 	} else {
@@ -203,25 +203,26 @@ sub describe_vault {
     return timestamp_deserialize($res);
 }
 
 sub directory {
     my ($self, $vault_name) = @_;
     unless (exists($self->{_dir}{$vault_name})) {
 	my $be = $self->cfget(qw(database inv backend));
 	$self->{_dir}{$vault_name} =
 	    new App::Glacier::Directory(
 		$be,
 		$vault_name,
 		$self->glacier,
-		%{$self->config->as_hash(qw(database inv)) // {}});
+		$self->config->as_hash(qw(database inv))
+	    );
     }
     return $self->{_dir}{$vault_name};
 }
 
 sub config { shift->{_config} }
 
 sub glacier { shift->{_glacier} }
 
 sub cfget {
     my ($self, @path) = @_;
     return $self->config->get(@path);
 }
diff --git a/lib/App/Glacier/Config.pm b/lib/App/Glacier/Config.pm
index 33d54d2..63dd61c 100644
--- a/lib/App/Glacier/Config.pm
+++ b/lib/App/Glacier/Config.pm
@@ -728,43 +728,67 @@ sub get {
 	if (defined($ref) && exists($ref->{-value})) {
 	    $ref = $ref->{-value};
 	}
     }
     if (ref($ref) eq 'ARRAY') {
 	return @$ref
     } elsif (ref($ref) eq 'HASH') {
 	return %$ref;
     }
     return $ref;
 }
 
-sub as_hash {
+=head2 $cfg->as_hashref(@path)
+
+If I<@path> represents a section, convert that section to a perl hash,
+and return a reference to that hash.
+
+If I<@path> does not exist or refers to a value, return C<undef>.
+
+=cut
+
+sub as_hashref {
     my $self = shift;
     my $ref = $self->getref(@_);
     my $hroot = {};
     my @ar;
 
     push @ar, [ '', $ref, $hroot ];
     while (my $elt = shift @ar) {
 	if (is_section_ref($elt->[1])) {
 	    my $hr = $elt->[2]{$elt->[0]} = {};
 	    while (my ($kw, $val) = each %{$elt->[1]}) {
 		next if $kw =~ /^-/;
 		push @ar, [ $kw, $val, $hr ];
 	    }
 	} else {
 	    $elt->[2]{$elt->[0]} = $elt->[1]->{-value};
 	}
     }
-    return $hroot->{''};
+    my $r = $hroot->{''};
+    return ref($r) eq 'HASH' ? $r : undef;
+}
+
+=head2 $cfg->as_hashref(@path)
+
+If I<@path> represents a section, return that section converted to a
+perl hash.
+
+If I<@path> does not exist or refers to a value, the returned hash is
+empty.
+
+=cut
+
+sub as_hash {
+    return %{shift->as_hashref(@_) // {}}
 }
 
 =head2 $cfg->isset(@path)
 
 Returns true if the configuration variable addressed by B<@path> is
 set.    
     
 =cut
 
 sub isset {
     my $self = shift;
     return defined $self->getref(@_);