File Coverage

blib/lib/Config/Vars.pm

Criterion	Covered	Total	%
statement	27	32	84.3
branch	10	20	50.0
condition	9	15	60.0
subroutine	6	6	100.0
pod	0	1	0.0
total	52	74	70.2

=head1 NAME

Config::Vars - A module for keeping configuration variables in a central perl file.

=head1 VERSION

This documentation describes version 0.01 of Config::Vars.pm, May 23, 2003.

=cut

use strict;
package Config::Vars;
use vars qw/$VERSION @CARP_NOT/;
$VERSION = 0.01;

use Carp;
use Filter::Simple;
@CARP_NOT = qw(Filter::Simple);

# Can we use Readonly?
use vars '$RO_ok';
my $nowarn;       # if true, don't kvetch about Readonly not being available
my $export;       # Exporter array name
eval { require 'Readonly.pm' };
$RO_ok = 1 unless $@;

# These get set by import() at the begining of each module; reset by xform.
my $usevars;
my $isa;


sub import
{
    my $pkg = shift;
    my @errs;

    # Module-by-module init
    $nowarn = 0;
    $export = 'EXPORT_OK';

    foreach my $opt (@_)
    {
        if ($opt eq 'nowarn')
        {
            $nowarn = 1;
        }
        elsif ($opt eq 'exportall')
        {
            $export = 'EXPORT';
        }
        else
        {
            push @errs, $opt;
        }
    }
    my $s = @errs > 1? 's' : '';
    croak "Unknown Config::Vars option$s (@errs)" if @errs;

    $usevars = "\@$export \@ISA ";
    $isa     = "\n" . q(push @ISA, 'Exporter' unless grep $_ eq 'Exporter', @ISA;);
}


# Filter the code
# Change
#        var $foo = 'bar';
# into
#        use vars qw($foo);
#        push @EXPORT_OK, qw($foo);       # or, push @EXPORT, qw($foo);
#        $foo = 'bar';
FILTER_ONLY
    code => sub {
#        print STDERR "BEFORE: [$_]\n";
        s/^ \s*                # optional leading whitespace
            (var|ro)           # 'var' or 'ro' keyword
            \s+                # mandatory whitespace
            ([^=;\s]+)         # a variable name
            \s*                # optional whitespace
            (\S)               # = or semicolon
         /xform($1,$2,$3)/gemx;
#        print STDERR "AFTER: [$_]\n";
    };


sub xform
{
    my ($cmd, $var, $eqs) = @_;
    croak qq{Can't process "$cmd $var $eqs" line} if $cmd ne 'var' && $cmd ne 'ro';
    unless ($var =~ /^[\$\@\%][_[:alpha:]]\w+/)
    {
        croak qq{May not declare individual hash or array elements with $cmd}
            if $var =~ /\[[^\]]\]/ || $var =~ /\{[^\}]+\}/;
        croak qq{May not declare globs with $cmd ("$var")} if substr($var,0,1) eq '*';
        croak qq{Invalid variable name "$var"};
    }
    croak qq{Can't process "$cmd $var" line} if $eqs ne '='   && $eqs ne ';';

    my $res = <
use vars qw($usevars$var);$isa
push \@$export, qw($var);
USE_AND_EXPORT

    if ($cmd eq 'ro'  &&  $RO_ok)
    {
        $res .= "Readonly::Readonly \\$var";
        $res .= ' => ' if $eqs eq '=';
    }
    else
    {
        carp "Readonly not available, making $var read/write" if $cmd eq 'ro'  &&  !$nowarn;
        $res .= $var;
        $res .= ' = '  if $eqs eq '=';
    }
    $res .= $eqs  if $eqs eq ';';
    $usevars = $isa = '';
    return $res;
}


1;    # Modules must return true, for silly historical reasons.
__END__