Test::Database::Util - Utility functions for Test::Database modules


Test-Database documentation Contained in the Test-Database distribution.

Index


Code Index:

NAME

Top

Test::Database::Util - Utility functions for Test::Database modules

SYNOPSIS

Top

    use Test::Database::Util;

    # exports a collection of underscore functions

DESCRIPTION

Top

Test::Database::Util exports a collection of functions used by several modules in the Test-Database distribution.

EXPORTED FUNCTIONS

Top

All functions provided by Test::Database::Util are exported in the calling package.

The following functions are provided:

_read_file( $file )

Return a list of hash references, read in the given $file file.

AUTHOR

Top

Philippe Bruhat (BooK), <book@cpan.org>

COPYRIGHT

Top

LICENSE

Top

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


Test-Database documentation Contained in the Test-Database distribution.

package Test::Database::Util;
use strict;
use warnings;
use Carp;

# export everything
sub import {
    my $caller = caller();
    no strict 'refs';
    *{"${caller}::$_"} = \&$_ for qw( _read_file );
}

# return a list of hashrefs representing each configuration section
sub _read_file {
    my ($file) = @_;
    my @config;

    open my $fh, '<', $file or croak "Can't open $file for reading: $!";
    my $re_header = qr/^(?:(?:driver_)?dsn|key)$/;
    my %args;
    my $records;
    while (<$fh>) {
        next if /^\s*(?:#|$)/;    # skip blank lines and comments
        chomp;

        /\s*(\w+)\s*=\s*(.*)\s*/ && do {
            my ( $key, $value ) = ( $1, $2 );
            if ( $key =~ $re_header ) {
                push @config, {%args} if keys %args;
                $records++;
                %args = ();
            }
            elsif ( !$records ) {
                croak "Record doesn't start with dsn or driver_dsn or key "
                    . "at $file, line $.:\n  <$_>";
            }
            $args{$key} = $value;
            next;
        };

        # unknown line
        croak "Can't parse line at $file, line $.:\n  <$_>";
    }
    push @config, {%args} if keys %args;
    close $fh;

    return @config;
}

'USING';

__END__