File Coverage

blib/lib/oEdtk/Config.pm
Criterion Covered Total %
statement 49 56 87.5
branch 8 14 57.1
condition 2 6 33.3
subroutine 6 7 85.7
pod 0 2 0.0
total 65 85 76.4


line stmt bran cond sub pod time code
1             package oEdtk::Config;
2              
3 1     1   7 use strict;
  1         2  
  1         42  
4 1     1   5 use warnings;
  1         2  
  1         25  
5              
6 1     1   5 use Config::IniFiles;
  1         1  
  1         25  
7 1     1   5 use Sys::Hostname;
  1         3  
  1         93  
8              
9 1     1   5 use Exporter;
  1         2  
  1         708  
10             our $VERSION = 0.8034;
11             our @ISA = qw(Exporter);
12             our @EXPORT_OK = qw(config_read get_ini_path);
13             my $_INI_PATH;
14              
15             sub get_ini_path(){
16 0     0 0 0 return $_INI_PATH;
17             }
18              
19              
20             sub config_read(@) {
21 2     2 0 5 my ($sections, $app);
22              
23 2 50       11 if (ref($_[0]) eq 'ARRAY') {
24 0         0 $sections = $_[0];
25 0         0 $app = $_[1];
26             } else {
27 2         5 $sections = \@_;
28             }
29              
30 2         4 my $mod = __PACKAGE__;
31 2         12 $mod =~ s/::/\//;
32 2         4 $mod .= '.pm';
33 2         7 my $dir = $INC{$mod};
34 2         17 $dir =~ s/\/[^\/]+$//;
35              
36 2         4 my $ini;
37 2 50       113 if (-e "$dir/iniEdtk/edtk.ini") {
38 0         0 $ini = "$dir/iniEdtk/edtk.ini";
39             } else {
40 2         7 $ini = "$dir/iniEdtk/tplate.edtk.ini";
41 2         202 warn "INFO : accessing $ini\n";
42             }
43 2         16 my $uchost= hostname();
44 2         24 $uchost = uc($uchost);
45              
46 2         6 my %allcfg = ();
47 2         5 for (;;) {
48 2 50       92 die "ERROR: config file not found or unreadable: $ini\n" unless -r $ini;
49 2         27 tie %allcfg, 'Config::IniFiles', (-file => $ini, -default => 'DEFAULT');
50 2         61048 $_INI_PATH = $ini;
51              
52 2         14 my $ini2 = (tied %allcfg)->val($uchost, 'iniEdtk');
53 2 50 33     89 last if not defined $ini2 or $ini2 eq $ini or $ini2 eq 'local';
      33        
54 0         0 $ini = $ini2;
55             }
56              
57              
58             # Get the DEFAULT and ENVDESC sections by default, override with the optional
59             # sections that we were given, and finally with the hostname section.
60 2         5 my %cfg = ();
61 2         9 $cfg{'EDTK_HOST'} = $uchost;
62 2         7 foreach ('DEFAULT', 'ENVDESC', @$sections, $uchost) {
63 6 100       5105 if (exists $allcfg{$_}) {
64 4         101 %cfg = ( %cfg, %{$allcfg{$_}} );
  4         24  
65             }
66             }
67              
68             # Get current application name
69 2 50       89 if (defined($app)) {
70 0         0 $cfg{'EDTK_PRGNAME'} = $app;
71             } else {
72 2 50       33 if ($0 =~ /([\w\-\.]+)\.p[lm]$/i) {
73 0         0 $cfg{'EDTK_PRGNAME'} = $1;
74             } else {
75 2         9 $cfg{'EDTK_PRGNAME'} = $0;
76             }
77             }
78              
79             #### Deprecated was used for Compuset
80             ## my $typ_ext = "$cfg{'EDTK_FTYP_TEST'}|$cfg{'EDTK_FTYP_HOMOL'}|$cfg{'EDTK_FTYP_PROD'}";
81             #
82             # # on pousse les valeurs dans un tableau, pour éliminer les valeurs nulles
83             # my @tTyp_ext;
84             ## push (@tTyp_ext, $cfg{'EDTK_FTYP_TEST'}) if $cfg{'EDTK_FTYP_TEST'};
85             ## push (@tTyp_ext, $cfg{'EDTK_FTYP_HOMOL'}) if $cfg{'EDTK_FTYP_HOMOL'};
86             ## push (@tTyp_ext, $cfg{'EDTK_FTYP_PROD'}) if $cfg{'EDTK_FTYP_PROD'};
87             #
88             # # on recherche chacun des motifs valides
89             # foreach my $typ_ext (@tTyp_ext) {
90             # $cfg{'EDTK_PRGNAME'} =~ s/([\w\-\.]+)($typ_ext)/$1/ie;
91             # # $cfg{'EDTK_TYP_ENVIRO'} = $2 || $cfg{'EDTK_FTYP_DFLT'};
92             # }
93              
94             # Expand variables inside other variables.
95 2         15 foreach my $key (keys %cfg) {
96 88         246 while ($cfg{$key} =~ s/\$(\w+)/$cfg{$1}/ge) {
  68         385  
97             ;
98             }
99             }
100              
101 2         202 return \%cfg;
102             }
103              
104             1;