File Coverage

blib/lib/Config/Secure.pm

Criterion	Covered	Total	%
statement	18	91	19.7
branch	2	36	5.5
condition	0	3	0.0
subroutine	7	13	53.8
pod	0	3	0.0
total	27	146	18.4

package Config::Secure;

use 5.00503;
use strict;

require Exporter;
use AutoLoader qw(AUTOLOAD);
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $OPENED);
@ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Config::Secure ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
%EXPORT_TAGS = ( 'all' => [ qw(

) ] );

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} }, qw(get_fh get_conf write_conf));

@EXPORT = qw(

);
$VERSION = '0.0.1';


# Preloaded methods go here.
use Fcntl;

#F_SETFD w/ fcntl() and $^F

BEGIN {
    $0 = $ENV{PSC_CONFIG_CMD} if $ENV{PSC_CONFIG_CMD};
    $OPENED = 0;
}

# This routine opens the file, then memoizes itself
sub get_fh {
    local $^W = 0;
    my($fh,$type);

    if($ENV{PSC_CONFIG_FH} >= 0) {
	$type = int $ENV{PSC_CONFIG_WRITE};
	my $rw = ($type ? '+' : '');
	open $fh, "${rw}<&=$ENV{PSC_CONFIG_FH}"
	    or die "Could not open conf filehandle: $!";
	$OPENED = 1;
    } else {
	*get_fh = sub {};
        warn "No conf file available: $!";
	return;
    }

    fcntl($fh, F_GETFL, $_);
    *get_fh = sub {
	return($fh,$type);
    };
    get_fh();
}

# read conf and make it a data structure
sub get_conf {
    my ($fh,$type) = get_fh();
    my (%conf,%loader_comments);
    unless($fh) {
	warn("get_conf failed... no filehandle");
	return;
    }
    local $_;
    while(<$fh>) {
	my($k,$v);
	next if /^\s+\#/;
	chomp;
	if(/^\#\s*(?:([^:]+):)?/) {
	    push @{$loader_comments{$1}}, $_;
	} elsif((($k,$v) = split /:\s*/, $_, 2) == 2) {
	    if($conf{$k}) {
		if(ref $conf{$k}) {
		    push @{$conf{$k}}, $v;
		} else {
		    $conf{$k} = [$conf{$k}, $v];
		}
	    } else {
		$conf{$k} = $v;
	    }
	}
    }
    # save the comments for the nice people
    *_comments = sub {
	\%loader_comments;
    };

    return wantarray ? %conf : \%conf;
}

# write conf data back to file, if it is writeable
sub write_conf {
    my ($fh,$type) = get_fh();
    unless($type) {
	warn("Conf file not writeable\n");
	return;
    }
    my %conf;
    if(@_ == 1) {
	if(ref $_[0] eq 'HASH') {
	    %conf = %{$_[0]};
	} else {
	    warn "Need to pass write_conf a hash or hash ref";
	    return;
	}
    } else {
	if(@_ % 2) {
	    warn "Odd number of arguments to write_hash. Need to pass write_conf a hash or hash ref";
	    return;
	}
	%conf = @_;
    }

    seek($fh, 0, 0);
    my $c = &_comments;
    # write general comments at top
    for my $comment (@{$c->{''}}) {
	print $fh "$comment\n";
    }
    print $fh "\n";
    for my $k (sort keys %conf) {
	$c->{$k}[0] ||= "# $k: ";
	# write comments for indivisual keys
	for my $comment (@{$c->{$k}}) {
	    print $fh "$comment\n";
	}
	if(ref $conf{$k}) {
	    for my $a (@{$conf{$k}}) {
		print $fh "$k: $a\n";
	    }
	} else {
	    print $fh "$k: $conf{$k}\n";
	}
	print $fh "\n";
    }
    truncate $fh, tell $fh;
    1;
}

# close your file handles!
END {
    if($OPENED) {
	my $fh = (get_fh())[0];
	close $fh if $fh;
    }
}

1;


# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__