|
0
|
1 package lib::conf ;
|
|
|
2
|
|
|
3 use strict;
|
|
|
4 use warnings ;
|
|
|
5 use Exporter ;
|
|
|
6 use Carp ;
|
|
|
7 use Data::Dumper ;
|
|
|
8
|
|
|
9 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS);
|
|
|
10
|
|
|
11 our $VERSION = "1.0" ;
|
|
|
12 our @ISA = qw(Exporter) ;
|
|
|
13 our @EXPORT = qw( as_conf get_value_from_conf check_path_and_file ) ;
|
|
|
14 our %EXPORT_TAGS = ( ALL => [qw( as_conf get_value_from_conf )] ) ;
|
|
|
15
|
|
|
16 =head1 NAME
|
|
|
17
|
|
|
18 conf - A module for manage pfem conf file
|
|
|
19
|
|
|
20 =head1 SYNOPSIS
|
|
|
21
|
|
|
22 use conf ;
|
|
|
23 my $object = conf->new() ;
|
|
|
24
|
|
|
25 =head1 DESCRIPTION
|
|
|
26
|
|
|
27 This module does manage conf file (extract all or selected fields)
|
|
|
28
|
|
|
29 =head1 METHODS
|
|
|
30
|
|
|
31 Methods are :
|
|
|
32
|
|
|
33 =head2 METHOD new
|
|
|
34
|
|
|
35 ## Description : new
|
|
|
36 ## Input : $self
|
|
|
37 ## Ouput : bless $self ;
|
|
|
38 ## Usage : new() ;
|
|
|
39
|
|
|
40 =cut
|
|
|
41 ## START of SUB
|
|
|
42 sub new {
|
|
|
43 ## Variables
|
|
|
44 my $self={};
|
|
|
45 bless($self) ;
|
|
|
46 return $self ;
|
|
|
47 }
|
|
|
48 ### END of SUB
|
|
|
49
|
|
|
50 =head2 METHOD as_conf
|
|
|
51
|
|
|
52 ## Description : permet de cr�er l'object conf � partir d'un fichier de conf de type KEY=VALUE
|
|
|
53 ## Input : $file
|
|
|
54 ## Ouput : $oConf (a hash)
|
|
|
55 ## Usage : my ( $oConf ) = as_conf( $file ) ;
|
|
|
56
|
|
|
57 =cut
|
|
|
58 ## START of SUB
|
|
|
59 sub as_conf {
|
|
|
60 ## Retrieve Values
|
|
|
61 my $self = shift ;
|
|
|
62 my ( $file, $separator ) = @_ ;
|
|
|
63
|
|
|
64 # if (!defined $separator) { $separator = ';' } ## set separator to ;
|
|
|
65
|
|
|
66 if ( !defined $file ) { croak "Can't create object with an none defined file\n" ; }
|
|
|
67
|
|
|
68 my %Conf = () ; ## Hash devant contenir l'ensemble des parametres locaux
|
|
|
69
|
|
|
70 if (-e $file) {
|
|
|
71 open (CFG, "<$file") or die "Can't open $file\n" ;
|
|
|
72 while (<CFG>) {
|
|
|
73 chomp $_ ;
|
|
|
74 if ( $_ =~ /^#(.*)/) { next ; }
|
|
|
75 elsif ($_ =~/^(\w+?)=(.*)/) { ## ALPHANUMERIC OR UNDERSCORE ONLY FOR THE KEY AND ANYTHING ELSE FOR VALUE
|
|
|
76
|
|
|
77 my ($key, $value) = ($1, $2) ;
|
|
|
78
|
|
|
79 if (defined $separator) {
|
|
|
80 if ( $value=~/$separator/ ) { ## is a list to split
|
|
|
81 my @tmp = split(/$separator/ , $value) ;
|
|
|
82 $Conf{$key} = \@tmp ;
|
|
|
83 }
|
|
|
84 }
|
|
|
85 else {
|
|
|
86 $Conf{$key} = $value ;
|
|
|
87 }
|
|
|
88 }
|
|
|
89 }
|
|
|
90 close(CFG) ;
|
|
|
91 }
|
|
|
92 else {
|
|
|
93 croak "Can't create object with an none existing file\n" ;
|
|
|
94 }
|
|
|
95
|
|
|
96 return ( \%Conf ) ;
|
|
|
97 }
|
|
|
98 ## END of SUB
|
|
|
99
|
|
|
100 =head2 METHOD as_conf_list
|
|
|
101
|
|
|
102 ## Description : permet de charger une liste txt en array
|
|
|
103 ## Input : $file
|
|
|
104 ## Output : elements
|
|
|
105 ## Usage : my ( elements ) = as_conf_list( $conf_file ) ;
|
|
|
106
|
|
|
107 =cut
|
|
|
108 ## START of SUB
|
|
|
109 sub as_conf_list {
|
|
|
110 ## Retrieve Values
|
|
|
111 my $self = shift ;
|
|
|
112 my ( $file ) = @_ ;
|
|
|
113
|
|
|
114 my @elements = () ;
|
|
|
115 if ( !defined $file ) { croak "Can't create object with an none defined file\n" ; }
|
|
|
116
|
|
|
117 if (-e $file) {
|
|
|
118 open (CFG, "<$file") or die "Can't open $file\n" ;
|
|
|
119 while (<CFG>) {
|
|
|
120 chomp $_ ;
|
|
|
121 if ( $_ =~ /^#(.*)/) { next ; }
|
|
|
122 elsif ($_ =~/^(.*)/) { if (defined $1) { push (@elements, $1) ; } }
|
|
|
123 }
|
|
|
124 }
|
|
|
125 else {
|
|
|
126 croak "Can't create object with an none existing file\n" ;
|
|
|
127 }
|
|
|
128 return(\@elements) ;
|
|
|
129 }
|
|
|
130 ## END of SUB
|
|
|
131
|
|
|
132 =head2 METHOD get_value_from_conf
|
|
|
133
|
|
|
134 ## Description : permet de retourner une valeur du hash de conf � partir d'une key
|
|
|
135 ## Input : $oConf, $Key
|
|
|
136 ## Ouput : $Value
|
|
|
137 ## Usage : my ( $Value ) = get_value_from_conf( $oConf, $Key ) ;
|
|
|
138
|
|
|
139 =cut
|
|
|
140 ## START of SUB
|
|
|
141 sub get_value_from_conf {
|
|
|
142 ## Retrieve Values
|
|
|
143 my $self = shift ;
|
|
|
144 my ( $oConf, $Key ) = @_ ;
|
|
|
145
|
|
|
146 my $Value = undef ;
|
|
|
147
|
|
|
148 if ( defined $oConf ) {
|
|
|
149 if ( defined $oConf->{$Key} ) {
|
|
|
150 $Value = $oConf->{$Key} ;
|
|
|
151 }
|
|
|
152 }
|
|
|
153 else {
|
|
|
154 croak "Can't manage value with undefined object\n" ;
|
|
|
155 }
|
|
|
156 return($Value) ;
|
|
|
157 }
|
|
|
158 ## END of SUB
|
|
|
159
|
|
|
160 =head2 METHOD get_value_from_conf
|
|
|
161
|
|
|
162 ## Description : permet de retourner une valeur du hash de conf � partir d'une key
|
|
|
163 ## Input : $oConf, $Key
|
|
|
164 ## Ouput : $Value
|
|
|
165 ## Usage : my ( $Value ) = get_value_from_conf( $oConf, $Key ) ;
|
|
|
166
|
|
|
167 =cut
|
|
|
168 ## START of SUB
|
|
|
169 sub split_value_from_conf {
|
|
|
170 ## Retrieve Values
|
|
|
171 my $self = shift ;
|
|
|
172 my ( $oConf, $Key, $sep ) = @_ ;
|
|
|
173
|
|
|
174 my $value = undef ;
|
|
|
175 my @values = () ;
|
|
|
176
|
|
|
177 if ( defined $oConf ) {
|
|
|
178 if ( defined $oConf->{$Key} ) {
|
|
|
179 $value = $oConf->{$Key} ;
|
|
|
180 @values = split ( /$sep/, $value) ;
|
|
|
181 }
|
|
|
182 }
|
|
|
183 else {
|
|
|
184 croak "Can't manage value with undefined object\n" ;
|
|
|
185 }
|
|
|
186 return(\@values) ;
|
|
|
187 }
|
|
|
188 ## END of SUB
|
|
|
189
|
|
|
190
|
|
|
191 =head2 METHOD check_path_and_file
|
|
|
192
|
|
|
193 ## Description : permet de v�rifier les path et la pr�sence des exe d�crits dans le file conf. Bloque le script en cas de probleme
|
|
|
194 ## Input : $oConfs
|
|
|
195 ## Ouput : NA
|
|
|
196 ## Usage : &get_value_from_conf( $oConf ) ;
|
|
|
197
|
|
|
198 =cut
|
|
|
199 ## START of SUB
|
|
|
200 sub check_path_and_file {
|
|
|
201
|
|
|
202 my $self = shift ;
|
|
|
203 my ( $oConfs ) = @_ ;
|
|
|
204
|
|
|
205 foreach my $conf ( keys %{ $oConfs } ) {
|
|
|
206 if ( $conf =~ /^FILE/ ) {
|
|
|
207 if ( -e $oConfs->{$conf} ) {
|
|
|
208 if ( -s $oConfs->{$conf} ) { next ; }
|
|
|
209 else { carp "[Warning] : The size of file $oConfs->{$conf} is null\n" ; }
|
|
|
210 }
|
|
|
211 else {
|
|
|
212 carp "[Warning] : The file $oConfs->{$conf} doesn't exist\n" ;
|
|
|
213 }
|
|
|
214 }
|
|
|
215 elsif ( $conf =~ /^PATH/ ) {
|
|
|
216 if ( -d $oConfs->{$conf} ) { next ; }
|
|
|
217 else { carp "[Warning] : The dir $oConfs->{$conf} doesn't exist\n" ; }
|
|
|
218 }
|
|
|
219 else { next ; }
|
|
|
220 }
|
|
|
221 return ;
|
|
|
222 }
|
|
|
223 ## END of SUB
|
|
|
224
|
|
|
225 1 ;
|
|
|
226
|
|
|
227
|
|
|
228 __END__
|
|
|
229
|
|
|
230 =head1 SUPPORT
|
|
|
231
|
|
|
232 You can find documentation for this module with the perldoc command.
|
|
|
233
|
|
|
234 perldoc conf.pm
|
|
|
235
|
|
|
236
|
|
|
237 =head1 Exports
|
|
|
238
|
|
|
239 =over 4
|
|
|
240
|
|
|
241 =item :ALL is as_conf get_value_from_conf
|
|
|
242
|
|
|
243 =back
|
|
|
244
|
|
|
245 =head1 AUTHOR
|
|
|
246
|
|
|
247 Franck Giacomoni E<lt>franck.giacomoni@clermont.inra.frE<gt>
|
|
|
248
|
|
|
249 =head1 LICENSE
|
|
|
250
|
|
|
251 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
|
|
|
252
|
|
|
253 =head1 VERSION
|
|
|
254
|
|
|
255 version 1 : 10 / 02 / 2013
|
|
|
256
|
|
|
257 version 2 : ??
|
|
|
258
|
|
|
259 =cut |
