File Coverage

blib/lib/Config/File.pm
Criterion Covered Total %
statement 43 43 100.0
branch 9 12 75.0
condition 4 5 80.0
subroutine 7 7 100.0
pod 1 1 100.0
total 64 68 94.1


line stmt bran cond sub pod time code
1             package Config::File;
2 2     2   8370 use warnings;
  2         10  
  2         69  
3 2     2   11 use strict;
  2         3  
  2         39  
4 2     2   8 use Carp;
  2         4  
  2         99  
5 2     2   11 use Exporter;
  2         4  
  2         75  
6 2     2   901 use IO::File;
  2         16429  
  2         229  
7              
8 2     2   14 use vars qw($VERSION @ISA @EXPORT_OK);
  2         5  
  2         1125  
9             @ISA = qw/Exporter/;
10             @EXPORT_OK = qw/read_config_file/;
11             $VERSION = '1.51';
12              
13             sub read_config_file($) {
14 2     2 1 671 my ( $conf, $file, $fh, $line_num );
15 2         4 $file = shift;
16 2 50       11 $fh = IO::File->new( $file, 'r' )
17             or croak "Can't read configuration in $file: $!\n";
18              
19 2   66     320 while ( ++$line_num and my $line = $fh->getline ) {
20 11         300 my ( $orig_line, $conf_ele, $conf_data );
21 11         20 chomp $line;
22 11         16 $orig_line = $line;
23              
24 11 100       50 next if $line =~ m/^\s*#/;
25 10         21 $line =~ s/(?
26 10         18 $line =~ s/\\#/#/g;
27 10 50       27 next if $line =~ m/^\s*$/;
28 10         22 $line =~ s{\$(\w+)}{
29 2 50       11 exists($conf->{$1}) ? $conf->{$1} : "\$$1"
30             }gsex;
31              
32 10 100       53 unless ( $line =~ m/\s*([^\s=]+)\s*=\s*(.*?)\s*$/ ) {
33 1         15 warn "Line format invalid at line $line_num: '$orig_line'";
34 1         84 next;
35             }
36              
37 9         27 ( $conf_ele, $conf_data ) = ( $1, $2 );
38 9 100       27 unless ( $conf_ele =~ /^[\]\[A-Za-z0-9_-]+$/ ) {
39 1         55 warn "Invalid characters in key $conf_ele at line $line_num"
40             . " - Ignoring";
41 1         32 next;
42             }
43             $conf_ele =
44 8         45 '$conf->{"' . join( '"}->{"', split /[][]+/, $conf_ele ) . '"}';
45 8         21 $conf_data =~ s!([\\\'])!\\$1!g;
46 8         372 eval "$conf_ele = '$conf_data'";
47             }
48 2         96 $fh->close;
49              
50 2   100     42 return $conf // {};
51             }
52              
53             1;
54              
55             __END__