File Coverage

blib/lib/Config/Extend/MySQL.pm

Criterion	Covered	Total	%
statement	72	85	84.7
branch	26	38	68.4
condition	9	13	69.2
subroutine	14	18	77.7
pod	1	1	100.0
total	122	155	78.7

package Config::Extend::MySQL;
use 5.006;   # read the CAVEATS if you really want a version that works on 5.5
use strict;
use warnings;
use Carp;
use File::Basename          qw(dirname);
use File::Spec::Functions   qw(catfile rel2abs);
use File::Read;
use UNIVERSAL::require;


{
    no strict "vars";
    $VERSION = '0.05';
}

use constant USE_IO_STRING => $] <= 5.008;

my %skip;


=head1 NAME

Config::Extend::MySQL - Extend your favourite .INI parser module to read MySQL configuration file

=head1 VERSION

Version 0.05

=head1 SYNOPSIS

    use Config::Extend::MySQL;

    # read MySQL config using Config::IniFiles
    my $config = Config::Extend::MySQL->new({ from => $file, using => "Config::IniFiles" });

    # read MySQL config using Config::Tiny
    my $config = Config::Extend::MySQL->new({ from => $file, using => "Config::Tiny" });

    # use the resulting object as you usually do
    ...


=head1 DESCRIPTION

This module extends other C modules so they can read MySQL
configuration files. It works by slurping and preprocessing the files
before letting your favourite C module parse the result.

Currently supported modules are C, C
and C.

=head2 Rationale

This module was written out of a need of reading MySQL configuration
files from random machines. At first, the author thought they were just
classical C<.INI> files, but soon discovered that they include additional
features like C and C, and bare boolean options,
which without surprise make most common modules choke or die.

Hence this module which simply slurps all the files, recursing though the
C and C directives, inlining their content in
memory, and transforms the bare boolean options into explicitly assigned
options.

As to why this module extends other modules instead of being on its own,
it's because the author was too lazy to think of yet another API and
preferred to use the modules he already know. And given he use several
of them, depending on the context, it was just as easy to avoid being
too thighly coupled to a particular module.


=head1 METHODS

=head2 new()

Create and return an object

B

    my $config = Config::Extend::MySQL->new({ from => $file, using => $module });

B

=over

=item *

C - the path to the main MySQL configuration file

=item *

C - the module name to use as backend for parsing the configuration file

=back

B

    # read MySQL config using Config::IniFiles
    my $config = Config::Extend::MySQL->new({ from => $file, using => "Config::IniFiles" });
    # $config ISA Config::Extend::MySQL, ISA Config::IniFiles

    # read MySQL config using Config::Tiny
    my $config = Config::Extend::MySQL->new({ from => $file, using => "Config::Tiny" });
    # $config ISA Config::Extend::MySQL, ISA Config::Tiny

=cut

sub new {
    my ($class, $args) = @_;

    croak "error: Arguments must be given as a hash reference"
        unless ref $args eq "HASH";
    croak "error: Missing required argument 'from'"
        unless exists $args->{from};
    croak "error: Empty argument 'from'"
        unless defined $args->{from} and length $args->{from};

    # check that the file exists and contains something
    my $file = $args->{from};
    croak "fatal: No such file '$file'" unless -f $file;
    carp "warning: File '$file' is empty" and return if -s _ == 0;

    # read the file and resolve the MySQL-isms
    my $content = __read_config(file => $file);

    my $fh = undef;
    if (USE_IO_STRING) {
        require IO::String;
        $fh = IO::String->new(\$content);
    }
    else {
        open($fh, "<", \$content)
            or croak "fatal: Can't read in-memory buffer: $!";
    }

    # create the object using the given Config:: module
    my $backend = defined $args->{using} ? $args->{using} : "Config::Tiny";
    $backend->require or croak "fatal: Can't load module $args->{using}: $@";
    @Config::Extend::MySQL::ISA = ($backend);
    my $self = __new_from($backend, $fh, \$content)
        or croak "fatal: Backend module failed to parse '$file'";
    bless $self, $class;

    # store the names to skip when reading directories
    my @skip_names = qw(. .. CVS);
    @skip{@skip_names} = (1) x @skip_names;

    return $self
}


sub __new_from {
    my ($backend, $fh, $content_r) = @_;

    if ($backend eq "Config::IniFiles") {
        local $SIG{__WARN__} = sub {}; # avoid a warning from stat() on this $fh
        local *IO::String::FILENO = sub { -1 };
        return Config::IniFiles->new(-file => $fh)
    }
    elsif ($backend eq "Config::Format::Ini") {
        local $SIG{__WARN__} = sub {}; # avoid "slurp redefined" warning
        local *Config::Format::Ini::slurp = sub { return ${$_[0]} };
        return Config::Format::Ini::read_ini($content_r)
    }
    elsif ($backend eq "Config::Simple") {
        # can't get Config::Simple to play nicely because it want to
        # seek() and flock() the filehandle. seek() works on in-memory
        # filehandles, but flock() doesn't, and can't be faked/replaced

        #my $obj = Config::Simple->new(syntax => "ini");
        #$obj->{_DATA} = $obj->parse_ini_file($fh);
        #return $obj

        return Config::Simple->new($fh)
    }
    elsif ($backend eq "Config::Tiny" or $backend eq "Config::INI::Reader") {
        return $backend->read_string($$content_r)
    }
}


sub __read_config {
    my ($what, $path) = @_;
    my $content = "";
    my $opts = {}; #{ err_mode => "quiet" };

    if ($what eq "file") {
        my $base_dir = dirname($path);
        $content = read_file($opts, $path);

        # handle single param (without value)
        $content =~ s{^ \s* (\w+ (?:-\w+)* ) \s* $}{$1 = yes}xgm;

        # handle includes
        $content =~ s{^ \s* !include(dir)? \s+ (.+) \s* $}
                     { __read_config($1 || "file", rel2abs($2, $base_dir)) }xgme;
    }
    elsif ($what eq "dir") {
        opendir(my $dirh, $path) or return "";

        while (my $file = readdir($dirh)) {
            # skip invisible files and directories we shouldn't
            # recurse into, like ../ or CVS/
            next if $skip{$file} or index($file, ".") == 0;

            my $filepath = catfile($path, $file);

            if (-f $filepath) {
                $content .= __read_config(file => $filepath)
            }
            elsif (-d _) {
                $content .= __read_config(dir => $filepath)
            }
        }

        closedir($dirh);
    }

    return $content
}


=head1 DIAGNOSTICS

=over

=item C

B<(E)> As the message says, the arguments must be given to the
function or method as a hash reference.

=item C

B<(F)> The backend module was unable to parse the given file.
See L<"CAVEATS"> for some hints.

=item C

B<(F)> The backend module could not be loaded.

=item C

B<(F)> This should not happen.

=item C

B<(E)> The given argument was empty, but a value is required.

=item C

B<(W)> The file is empty.

=item C

B<(E)> You forgot to supply a mandatory argument.

=item C

B<(F)> The given path does not point to an existing file.

=back


=head1 CAVEATS

The different supported modules don't parse C<.INI> files exactly the
same ways, and have different behaviours:

=over

=item *

C doesn't want to create an object from an empty file.

=item *

C by default doesn't allow the pound sign (C<#>)
for beginning comments.

=item *

when assigning the same option twice, C replaces the old
value with the new one, C appends it with a newline.

=back

And probably many more.

Also note that in order to keep the code simple, this module wants
Perl 5.6 or newer. However, a patch to make it work on Perl 5.5.3 is
included in the distribution (F).


=head1 SEE ALSO

L

L

L


=head1 AUTHOR

SEbastien Aperghis-Tramoni, C<<  >>

=head1 BUGS

Please report any bugs or feature requests
to C, or through the web interface
at L.
I will be notified, and then you'll automatically be notified of
progress on your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Config::Extend::MySQL


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 COPYRIGHT & LICENSE

Copyright 2008 SEbastien Aperghis-Tramoni, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

1; # End of Config::Extend::MySQL