| MetaStore documentation | Contained in the MetaStore distribution. |
MetaStore::Config - Configuration file class.
use MetaStore::Config;
my $conf = new MetaStore::Config:: ( $opt{config} );
my $value = $conf->general->{db_name};
Configuration file class
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%
?= - set value unless it defined before += - add value = - set value to key #%INCLUDE file.inc% - include config ini file
MetaStore, README
Zahatski Aliaksandr, <zag@cpan.org>
Copyright (C) 2006-2008 by Zahatski Aliaksandr
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available.
| MetaStore documentation | Contained in the MetaStore distribution. |
package MetaStore::Config;
use strict; use warnings; use WebDAO::Base; use base 'WebDAO::Base'; use Text::ParseWords 'parse_line'; use IO::File; our $VERSION = '0.2'; __PACKAGE__->attributes qw/ __conf _path/; #method for convert 'file_name', \*FH, \$string, <IO::File> 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; # _log1 $self "File $path not exists" unless -e $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 _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; _log1 $self "File $path not exists" unless -e $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__