File Coverage

blib/lib/Config/Fast.pm

Criterion	Covered	Total	%
statement	53	64	82.8
branch	13	22	59.0
condition	8	20	40.0
subroutine	8	8	100.0
pod	0	1	0.0
total	82	115	71.3

package Config::Fast;

=head1 NAME

Config::Fast - extremely fast configuration file parser

=head1 SYNOPSIS

    # default config format is a space-separated file
    company    "Supercool, Inc."
    support    [e-mail]


    # and then in Perl
    use Config::Fast;

    %cf = fastconfig;

    print "Thanks for visiting $cf{company}!\n";
    print "Please contact $cf{support} for support.\n";

=cut

use Carp;
use strict;

use Exporter;
use base 'Exporter';
our @EXPORT   = qw(fastconfig);
our $VERSION  = do { my @r=(q$Revision: 1.7 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
our %READCONF = ();

#
# Global settings - can override with $Config::Fast::PARAM = 'value';
#
our $DELIM    = '\s+';          # default delimiter
our $KEEPCASE = 0;              # preserve MixedCase variables?
our $ENVCAPS  = 1;              # setenv ALLCAPS variables?
our $ARRAYS   = 0;              # set var[0] as array elements?
our @DEFINE   = ();             # predefines of key=val
our %CONVERT  = (               # convert these values appropriately
    'true|on|yes'  => 1,
    'false|off|no' => 0,
);

# Aliases for prettiness
*Arrays   = \$ARRAYS;
*Define   = \@DEFINE;
*Delim    = \$DELIM;
*Convert  = \%CONVERT;
*EnvCaps  = \$ENVCAPS;
*KeepCase = \$KEEPCASE;

#
# Internal variables; are overridable, but undocumented
#
our $MTIME    = '_mtime';
our $ALLCAPS  = '_allcaps';
our $SOURCE   = '_source';

sub fastconfig (;$$) {
    my $file  = shift;
    my $delim = shift || $DELIM;

    # auto file detection
    unless ($file) {
        require File::Basename;
        my $dir  = File::Basename::dirname($ENV{SCRIPT_NAME} || $0);  # mod_perl usage
        my $prog = File::Basename::basename($ENV{SCRIPT_NAME} || $0);
        require File::Spec;
        $file = File::Spec->catfile($dir, '..', 'etc', "$prog.conf")
    }

    # Allow $file, \$file, or \@file
    my @file;
    my $mtime = 0;
    if (my $ref = ref $file) {
        if ($ref eq 'SCALAR') {
            @file = $$file;
            $READCONF{$file}{$SOURCE} = 'scalar';
        } elsif ($ref eq 'ARRAY') {
            @file = @$file;
            $READCONF{$file}{$SOURCE} = 'array';
        } else {
            croak "fastconfig: Invalid data type '$ref' for file arg";
        }
    } else {
        # Flat file; open if newer than cache
        croak "fastconfig: Invalid configuration file '$file'"
            unless -f $file && -r _;
        $mtime = -M _;
        if (! $READCONF{$file}{$MTIME} || $mtime < $READCONF{$file}{$MTIME}) {
            open CF, "<$file" or croak "fastconfig: Can't open $file: $!";
            @file = ;
            close CF;
            $READCONF{$file}{$SOURCE} = 'file';
        }
    }

    if (@file) {
        $READCONF{$file}{$ALLCAPS} ||= [];

        # Generate unique package name to isolate vars
        my $srcpkg = join '::', __PACKAGE__, 'Parser' . time() . $$;

        eval "{ package $srcpkg; " . <<'EndOfParser';

        #
        # We now parse variables by eval'ing them inline. This gets us
        # the same quoting conventions Perl uses implicitly.
        #
        no strict;
        use Carp;

        # Predefine anything in @DEFINE by unshifting onto @file (kludge)
        my @lines = @Config::Fast::DEFINE;

        for (@file) {
            next if /^\s*$/ || /^\s*#/; chomp;
            push @lines, [split /$delim/, $_, 2];
        }

        for (@lines) {
            my($key, $val) = @$_;

            # See if our var is ALLCAPS to setenv it
            my $env = $key =~ /^[A-Z0-9_]+(\[\d+\])?$/ ? $key : undef;

            $val =~ s/^\s*(["']?)(.*)\1\s*$/$2/g;
            my $q = $1 || '"';                          # save quote
            unless ($q eq "'") {
                $val =~ s/([^a-zA-Z0-9_\$\\'"])/\\$1/g  # escape nasty (sneaky?) chars
            }
            $val = qq{$q$val$q};                        # add quotes back in

            # Now check for "on/off" or "true/false"
            for my $pat (keys %Config::Fast::CONVERT) {
                $val = $Config::Fast::CONVERT{$pat} if $val =~ /^($pat)$/i;
            }

            # Convert MixedCaseGook to $mixedcasegook?
            my $pkey = $Config::Fast::KEEPCASE ? $key : lc($key);

            # Can only allow substitutions on RegularKeys, not weird+val:stuff
            my $tkey = $key =~ /^[a-zA-Z]\w*$/ ? $key : 'junk';
            my $ekey;
            if ($Config::Fast::ARRAYS && $pkey =~ s/\[(\d+)\]$//) {
                $ekey = q($Config::Fast::READCONF{$file}{$pkey}[$1] = ${$tkey}[$1] = );
            } else {
                $ekey = q($Config::Fast::READCONF{$file}{$pkey} = $$tkey = );
            }
            eval $ekey . '$tmp = ' . $val;
            warn "fastconfig: Parse error:\$$key = $val: $@" if $@;

            # Push it as an env var if so requested
            if ($Config::Fast::ENVCAPS && $env) {
                push @{$Config::Fast::READCONF{$file}{$Config::Fast::ALLCAPS}},
                     [ $env => $tmp ];
            }
        }
        $Config::Fast::READCONF{$file}{$Config::Fast::MTIME} = $mtime;
    }   # eval block
EndOfParser

} else {
    $READCONF{$file}{$SOURCE} = 'cache';
    }

    # ALLCAPS vars go into env, do this each time so that
    # calls to fastconfig() always reset the environment.
    for (@{$READCONF{$file}{$ALLCAPS}}) {
        $ENV{$_->[0]} = $_->[1];
    }

    if (wantarray) {
        return %{$READCONF{$file}};
    } else {
        # import vars into main namespace
        no strict 'refs';
        while (my($k,$v) = each %{$READCONF{$file}}) {
            next if $k =~ /^_/ || $k =~ /\W/;
            eval {
                *{"main::$k"} = \$v;
            };
            croak "fastconfig: Could not import variable '$k': $@" if $@;
        }
        return 1;
    }
}

1;

__END__