File Coverage

blib/lib/MetaStore/Config.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package MetaStore::Config;

=head1 NAME

MetaStore::Config - Configuration file class.

=head1 SYNOPSIS

    use MetaStore::Config;
    my $conf = new MetaStore::Config:: ( $opt{config} );
    my $value = $conf->general->{db_name};


=head1 DESCRIPTION

Configuration file class

=head3 Format of  INI-FILE

Data is organized in sections. Each key/value pair is delimited with an
equal (=) sign. Sections are declared on their own lines enclosed in
'[' and ']':

  [BLOCK1]
  KEY1 ?=VALUE1
  KEY2 +=VALUE2


  [BLOCK2]
  KEY1=VALUE1
  KEY2=VALUE2

  #%INCLUDE file.inc%

B  - set value unless it defined before
B<+=>  - add value
B<=>   - set value to key
B<#%INCLUDE file.inc%> - include config ini file

=cut

use strict;
use warnings;
use WebDAO::Base;
use base 'WebDAO::Base';
use Text::ParseWords 'parse_line';
use IO::File;
our $VERSION = '0.3';

__PACKAGE__->mk_attr( __conf=>undef, _path=>undef);


#method for convert 'file_name', \*FH, \$string,  to hash

sub convert_ini2hash {
    my $data = shift;

    #if we got filename
    unless ( ref $data ) {
        my $fh  = new IO::File:: "< $data";
        my $res = &convert_ini2hash($fh);
        close $fh;
        return $res;
    }

    #We got file descriptor ?
    if ( ref $data
        and ( UNIVERSAL::isa( $data, 'IO::Handle' ) or ( ref $data ) eq 'GLOB' )
        or UNIVERSAL::isa( $data, 'Tie::Handle' ) )
    {

        #read all data from file descripto to scalar
        my $str;
        {
            local $/;
            $str = <$data>;
        }
        return &convert_ini2hash( \$str );
    }
    my %result   = ();
    my $line_num = 0;
    my $section  = 'default';

    #if in param ref to scalar
    foreach ( split /(?:\015{1,2}\012|\015|\012)/, $$data ) {
        my $line = $_;
        $line_num++;

        # skipping comments and empty lines:

        $line =~ /^\s*(\n|\#|;)/ and next;
        $line =~ /\S/ or next;

        chomp $line;

        $line =~ s/^\s+//g;
        $line =~ s/\s+$//g;

        # parsing the block name:
        $line =~ /^\s*\[\s*([^\]]+)\s*\]$/ and $section = lc($1), next;

        # parsing key/value pairs
        # process ?= and += features
        if ( $line =~ /^\s*([^=]*\w)\s*([\?\+]?=)\s*(.*)\s*$/ ) {
            my $key   = lc($1);
            my @value = parse_line( '\s*,\s*', 0, $3 );
            my $op    = $2;

            #add current key
            if ( $op =~ /\+=/ ) {
                push @{ $result{$section}->{$key} }, @value;
                next;
            }

            # skip if already defined key
            elsif ( $op =~ /\?=/ ) {
                next if defined $result{$section}->{$key};
            }

            # set current value to result hash
            $result{$section}->{$key} = \@value;
            next;
        }

        # if we came this far, the syntax couldn't be validated:
        warn "syntax error on line $line_num: '$line'";
        return {};
    }

    #strip values
    while ( my ( $sect_name, $sect_hash ) = each %result ) {
        while ( my ( $key, $val ) = each %$sect_hash ) {
            if ( scalar(@$val) < 2 ) {
                $result{$sect_name}->{$key} = shift @$val;
            }
        }
    }
    return \%result;
}

sub get_full_path_for {
    my $root_file = shift;

    #    my $file_to   = shift;
    my @req_path = @_;
    my $req_path = join "/", @req_path;
    return $req_path if $req_path =~ /^\//;
    my @ini_path = split( "/", $root_file );

    #strip file name
    pop @ini_path;
    my $path = join "/" => @ini_path, $req_path;

    return $path;
}

sub process_includes {
    my $file = shift;
    my $fh   = ( new IO::File:: "< $file" ) || die "$file: $!";
    my $str  = '';
    while ( defined( my $line = <$fh> ) ) {

        $str .=
            $line =~ /#%INCLUDE\s*(.*)\s*%/
          ? &process_includes( &get_full_path_for( $file, $1 ) )
          : $line;
    }
    close $fh;
    return $str;
}

sub new {
    my $class = shift;
    my $self  = {};
    my $stat;
    bless( $self, $class );
    return ( $stat = $self->_init(@_) ) ? $self : $stat;
}

sub _init {
    my $self      = shift;
    my $file_path = shift;

    #process inludes in in data
    my $inc = &process_includes($file_path);
    $self->__conf( &convert_ini2hash(\$inc) );
    $self->_path($file_path);
    return 1;
}

sub get_full_path {
    my $self     = shift;
    my @req_path = @_;
    my $req_path = join "/", @req_path;
    return $req_path if $req_path =~ /^\//;
    my @ini_path = split( "/", $self->_path );
    pop @ini_path;
    my $path = join "/" => @ini_path, $req_path;
    return $path;
}

sub AUTOLOAD {
    my $self = shift;
    return if $MetaStore::Config::AUTOLOAD =~ /::DESTROY$/;
    ( my $auto_sub ) = $MetaStore::Config::AUTOLOAD =~ /.*::(.*)/;
    return $self->__conf->{$auto_sub};
}
1;
__END__