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


line stmt bran cond sub pod time code
1             package MetaStore::Config;
2              
3             =head1 NAME
4              
5             MetaStore::Config - Configuration file class.
6              
7             =head1 SYNOPSIS
8              
9             use MetaStore::Config;
10             my $conf = new MetaStore::Config:: ( $opt{config} );
11             my $value = $conf->general->{db_name};
12              
13              
14             =head1 DESCRIPTION
15              
16             Configuration file class
17              
18             =head3 Format of INI-FILE
19              
20             Data is organized in sections. Each key/value pair is delimited with an
21             equal (=) sign. Sections are declared on their own lines enclosed in
22             '[' and ']':
23              
24             [BLOCK1]
25             KEY1 ?=VALUE1
26             KEY2 +=VALUE2
27              
28              
29             [BLOCK2]
30             KEY1=VALUE1
31             KEY2=VALUE2
32              
33             #%INCLUDE file.inc%
34              
35             B - set value unless it defined before
36             B<+=> - add value
37             B<=> - set value to key
38             B<#%INCLUDE file.inc%> - include config ini file
39              
40             =cut
41              
42 1     1   984 use strict;
  1         2  
  1         35  
43 1     1   3 use warnings;
  1         2  
  1         21  
44 1     1   167 use WebDAO::Base;
  0            
  0            
45             use base 'WebDAO::Base';
46             use Text::ParseWords 'parse_line';
47             use IO::File;
48             our $VERSION = '0.3';
49              
50             __PACKAGE__->mk_attr( __conf=>undef, _path=>undef);
51              
52              
53             #method for convert 'file_name', \*FH, \$string, to hash
54              
55             sub convert_ini2hash {
56             my $data = shift;
57              
58             #if we got filename
59             unless ( ref $data ) {
60             my $fh = new IO::File:: "< $data";
61             my $res = &convert_ini2hash($fh);
62             close $fh;
63             return $res;
64             }
65              
66             #We got file descriptor ?
67             if ( ref $data
68             and ( UNIVERSAL::isa( $data, 'IO::Handle' ) or ( ref $data ) eq 'GLOB' )
69             or UNIVERSAL::isa( $data, 'Tie::Handle' ) )
70             {
71              
72             #read all data from file descripto to scalar
73             my $str;
74             {
75             local $/;
76             $str = <$data>;
77             }
78             return &convert_ini2hash( \$str );
79             }
80             my %result = ();
81             my $line_num = 0;
82             my $section = 'default';
83              
84             #if in param ref to scalar
85             foreach ( split /(?:\015{1,2}\012|\015|\012)/, $$data ) {
86             my $line = $_;
87             $line_num++;
88              
89             # skipping comments and empty lines:
90              
91             $line =~ /^\s*(\n|\#|;)/ and next;
92             $line =~ /\S/ or next;
93              
94             chomp $line;
95              
96             $line =~ s/^\s+//g;
97             $line =~ s/\s+$//g;
98              
99             # parsing the block name:
100             $line =~ /^\s*\[\s*([^\]]+)\s*\]$/ and $section = lc($1), next;
101              
102             # parsing key/value pairs
103             # process ?= and += features
104             if ( $line =~ /^\s*([^=]*\w)\s*([\?\+]?=)\s*(.*)\s*$/ ) {
105             my $key = lc($1);
106             my @value = parse_line( '\s*,\s*', 0, $3 );
107             my $op = $2;
108              
109             #add current key
110             if ( $op =~ /\+=/ ) {
111             push @{ $result{$section}->{$key} }, @value;
112             next;
113             }
114              
115             # skip if already defined key
116             elsif ( $op =~ /\?=/ ) {
117             next if defined $result{$section}->{$key};
118             }
119              
120             # set current value to result hash
121             $result{$section}->{$key} = \@value;
122             next;
123             }
124              
125             # if we came this far, the syntax couldn't be validated:
126             warn "syntax error on line $line_num: '$line'";
127             return {};
128             }
129              
130             #strip values
131             while ( my ( $sect_name, $sect_hash ) = each %result ) {
132             while ( my ( $key, $val ) = each %$sect_hash ) {
133             if ( scalar(@$val) < 2 ) {
134             $result{$sect_name}->{$key} = shift @$val;
135             }
136             }
137             }
138             return \%result;
139             }
140              
141             sub get_full_path_for {
142             my $root_file = shift;
143              
144             # my $file_to = shift;
145             my @req_path = @_;
146             my $req_path = join "/", @req_path;
147             return $req_path if $req_path =~ /^\//;
148             my @ini_path = split( "/", $root_file );
149              
150             #strip file name
151             pop @ini_path;
152             my $path = join "/" => @ini_path, $req_path;
153              
154             # _log1 $self "File $path not exists" unless -e $path;
155             return $path;
156             }
157              
158             sub process_includes {
159             my $file = shift;
160             my $fh = ( new IO::File:: "< $file" ) || die "$file: $!";
161             my $str = '';
162             while ( defined( my $line = <$fh> ) ) {
163              
164             $str .=
165             $line =~ /#%INCLUDE\s*(.*)\s*%/
166             ? &process_includes( &get_full_path_for( $file, $1 ) )
167             : $line;
168             }
169             close $fh;
170             return $str;
171             }
172              
173             sub new {
174             my $class = shift;
175             my $self = {};
176             my $stat;
177             bless( $self, $class );
178             return ( $stat = $self->_init(@_) ) ? $self : $stat;
179             }
180              
181             sub _init {
182             my $self = shift;
183             my $file_path = shift;
184              
185             #process inludes in in data
186             my $inc = &process_includes($file_path);
187             $self->__conf( &convert_ini2hash(\$inc) );
188             $self->_path($file_path);
189             return 1;
190             }
191              
192             sub get_full_path {
193             my $self = shift;
194             my @req_path = @_;
195             my $req_path = join "/", @req_path;
196             return $req_path if $req_path =~ /^\//;
197             my @ini_path = split( "/", $self->_path );
198             pop @ini_path;
199             my $path = join "/" => @ini_path, $req_path;
200             _log1 "File $path not exists" unless -e $path;
201             return $path;
202             }
203              
204             sub AUTOLOAD {
205             my $self = shift;
206             return if $MetaStore::Config::AUTOLOAD =~ /::DESTROY$/;
207             ( my $auto_sub ) = $MetaStore::Config::AUTOLOAD =~ /.*::(.*)/;
208             return $self->__conf->{$auto_sub};
209             }
210             1;
211             __END__