File Coverage

blib/lib/MySQL/Config.pm

Criterion	Covered	Total	%
statement	71	75	94.6
branch	28	36	77.7
condition	7	11	63.6
subroutine	8	8	100.0
pod	2	2	100.0
total	116	132	87.8

package MySQL::Config;

# ----------------------------------------------------------------------
# MySQL::Config -
# Copyright (C) 2003 darren chamberlain
# ----------------------------------------------------------------------

use strict;
use base qw(Exporter);
use vars qw($VERSION $GLOBAL_CNF @EXPORT @EXPORT_OK);

use Carp qw(carp);
use File::Spec;

$VERSION    = '1.04';
$GLOBAL_CNF = "/etc/%s.cnf" unless defined $GLOBAL_CNF;
@EXPORT     = qw(load_defaults);
@EXPORT_OK  = qw(parse_defaults);

# ======================================================================
#                        --- Public Functions ---
# ======================================================================

sub load_defaults {
    my ($conf_file, $groups, $argc, $argv) = @_;
    my ($user_cnf, $ini, $field);
    $ini = [ ];

    # ------------------------------------------------------------------
    # Sanity checking:
    #   * $conf_file should be a string, defaults to "my"
    #   * $groups should be a ref to an array
    #   * $argc should be a ref to a scalar
    #   * $argv should be a ref to an array
    # ------------------------------------------------------------------
    $conf_file = "my" unless defined $conf_file && ! ref($conf_file);
    $groups = [ $groups ]
        unless ref $groups eq 'ARRAY';

    if (defined $argc) {
        $argc = \$argc
            unless ref $argc eq 'SCALAR';
    }
    else {
        $argc = \(my $i = 0);
    }

    $argv = \@ARGV unless defined $argv;
    $argv = [ $argv ]
        unless ref $argv eq 'ARRAY';

    $user_cnf = File::Spec->catfile($ENV{HOME}, ".$conf_file.cnf");

    # ------------------------------------------------------------------
    # Parse the global config and user's config
    # ------------------------------------------------------------------
    _parse($ini, sprintf $GLOBAL_CNF, $conf_file);
    _parse($ini, $user_cnf);

    # ------------------------------------------------------------------
    # Pull out the appropriate pieces, based on @$groups
    # ------------------------------------------------------------------
    @$groups = map { $_->[0] } @$ini unless @$groups;
    $groups = join '|', map { quotemeta($_) } @$groups;

    push @$argv, map { $$argc++; sprintf "--%s=%s", $_->[1], $_->[2] }
                 grep { $_->[0] =~ /^$groups$/ } @$ini;

    1;
}

sub parse_defaults {
    my ($conf_file, $groups) = @_;
    my ($count, $argv, %ini);
    $argv = [ ];

    load_defaults($conf_file, $groups, \$count, $argv);

    for (@$argv) {
        next unless /^--(.*?)=(.*)$/;
        my $name = $1;
        my $value = $2;

        if ($value =~ /=/) {
            $ini{ $name } = { }
                unless exists($ini{ $name }) &&
                    ref($ini{ $name }) eq 'HASH';
            my ($subname, $subvalue) = split /\s*=\s*/, $value, 2;
            $ini{ $name }->{ $subname } = $subvalue;
        }
        else {
            $ini{ $name } = $value;
        }
    }

    return wantarray ? %ini : \%ini;
}

# ======================================================================
#                        --- Private Functions ---
# ======================================================================

# ----------------------------------------------------------------------
# _parse($file)
#
# Parses an ini-style file into an array of [ group, name, value ]
# array refs.
# ----------------------------------------------------------------------
sub _parse {
    my $ini = shift;
    my $file = shift;
    my $current;
    local ($_, *INI);

    return { } unless -f $file && -r _;

    $ini ||= [ ];
    unless (open INI, $file) {
        carp "Couldn't open $file: $!";
        return { };
    }
    while () {
        s/[;#].*$//;
        s/^\s*//;
        s/\s*$//;

        next unless length;

        /^\s*\[(.*)\]\s*$/
            and $current = $1, next;

        $_ = join '=', $_, 1
            unless /=/;

        my ($n, $v) = split /\s*=\s*/, $_, 2;
        if ($v =~ /\s/) {
            $v =~ s/"/\\"/g;
            $v = qq("$v")
        }

        push @$ini, [ $current, $n, $v ];
    }

    unless (close INI) {
        carp "Couldn't close $file: $!";
    }

    return $ini;
}

1;

__END__