source: LMDZ5/branches/testing/tools/fcm/lib/Fcm/Config.pm @ 5371

Last change on this file since 5371 was 1665, checked in by Laurent Fairhead, 12 years ago

Version testing basée sur la r1628

http://lmdz.lmd.jussieu.fr/utilisateurs/distribution-du-modele/versions-intermediaires

Testing release based on r1628
File size: 24.7 KB
RevLine 
[1578]1#!/usr/bin/perl
2# ------------------------------------------------------------------------------
3# NAME
4#   Fcm::Config
5#
6# DESCRIPTION
7#   This is a class for reading and processing central and user configuration
8#   settings for FCM.
9#
10# COPYRIGHT
11#   (C) Crown copyright Met Office. All rights reserved.
12#   For further details please refer to the file COPYRIGHT.txt
13#   which you should have received as part of this distribution.
14# ------------------------------------------------------------------------------
15
16package Fcm::Config;
17
18# Standard pragma
19use warnings;
20use strict;
21
22# Standard modules
23use File::Basename;
24use File::Spec::Functions;
25use FindBin;
26use POSIX qw/setlocale LC_ALL/;
27
28# FCM component modules
29use Fcm::CfgFile;
30
31# Other declarations:
32sub _get_hash_value;
33
34# ------------------------------------------------------------------------------
35# SYNOPSIS
36#   $config = Fcm::Config->new (VERBOSE => $verbose);
37#
38# DESCRIPTION
39#   This method constructs a new instance of the Fcm::Config class.
40#
41# ARGUMENTS
42#   VERBOSE - Set the verbose level of diagnostic output
43# ------------------------------------------------------------------------------
44
45sub new {
46  my $this  = shift;
47  my %args  = @_;
48  my $class = ref $this || $this;
49
50  # Ensure that all subsequent Subversion output is in UK English
51  if (setlocale (LC_ALL, 'en_GB')) {
52    $ENV{LANG} = 'en_GB';
53  }
54
55  # Location of the central/user configuration file
56  my $cntl_config = catfile (dirname ($FindBin::Bin), 'etc', 'fcm.cfg');
57  $cntl_config    = catfile $FindBin::Bin, 'fcm.cfg' unless -r $cntl_config;
58  my $user_config = exists $ENV{HOME} ? catfile $ENV{HOME}, '.fcm' : '';
59
60  # Verbose mode
61  my $verbose     = exists $ENV{FCM_VERBOSE} ? $ENV{FCM_VERBOSE} : 1;
62
63  my $self = {
64    CNTL_CONFIG => -r $cntl_config ? $cntl_config : '',
65    USER_CONFIG => -r $user_config ? $user_config : '',
66    VERBOSE     => exists $args{VERBOSE} ? $args{VERBOSE} : $verbose,
67    VARIABLE    => {},
68
69    # Primary settings
70    SETTING => {
71      # Release identifier/version
72      RELEASE  => '1.2',
73
74      # Location of file with the last changed revision of the FCM trunk
75      REV_FILE => catfile (dirname ($FindBin::Bin), 'etc', 'fcm_rev'),
76
77      # Default names of known FCM configuration files
78      CFG_NAME => {
79        BLD        => 'bld.cfg',      # bld cfg
80        EXT        => 'ext.cfg',      # ext cfg
81        SRCPACKAGE => '@PACKAGE.cfg', # source package cfg
82      },
83
84      # Latest version of known FCM configuration files
85      CFG_VERSION => {
86        BLD        => '1.0', # bld cfg
87        EXT        => '1.0', # ext cfg
88        SRCPACKAGE => '1.0', # source package cfg
89      },
90
91      # Labels for all types of FCM configuration files
92      CFG_LABEL => {
93        CFGFILE => {
94          TYPE    => 'CFG::TYPE',       # config file type
95          VERSION => 'CFG::VERSION',    # version of config file syntax
96        },
97
98        # Labels for central/user internal config setting
99        SETTING    => 'SET',
100
101        # Labels for ext and bld cfg
102        USE        => 'USE',            # use (inherit from) another ext/bld
103        SRCDIR     => 'SRC',            # prefix, source directory
104
105        # Labels for bld and pck cfg
106        TARGET     => 'TARGET',         # BLD: targets of current build
107                                        # PCK: target name of source file
108
109        # Labels for bld cfg
110        NAME        => 'NAME',          # build name
111        DIR         => 'DIR',           # prefix, build directory
112        PP          => 'PP',            # prefix, pre-process?
113        LIB         => 'LIB',           # declare name of a library
114        SEARCH_SRC  => 'SEARCH_SRC',    # search src/ sub-directory?
115        EXE_NAME    => 'EXE_NAME',      # rename a main program target
116        TOOL        => 'TOOL',          # prefix, build tool
117        INHERIT     => 'INHERIT',       # prefix, inheritance flag
118        EXCL_DEP    => 'EXCL_DEP',      # exclude these automatic dependencies
119        INFILE_EXT  => 'INFILE_EXT',    # input file name extension and type
120        OUTFILE_EXT => 'OUTFILE_EXT',   # output file type and name extension
121        EXE_DEP     => 'EXE_DEP',       # extra executable dependencies
122        BLOCKDATA   => 'BLOCKDATA',     # BLOCKDATA dependencies
123
124        # Labels for ext cfg
125        DEST       => {                 # local extract destinations
126          ROOTDIR  => 'DEST::ROOTDIR',  # top directory for this extract
127          SRCDIR   => 'DEST::SRCDIR',   # extracted source directory
128          CFGDIR   => 'DEST::CFGDIR',   # generated configuration directory
129          CACHEDIR => 'DEST::CACHEDIR', # cache directory for fast extract
130          BLD_CFG  => 'DEST::BLD_CFG',  # generated bld cfg file
131          EXT_CFG  => 'DEST::EXT_CFG',  # generated ext cfg file
132        },
133        RDEST      => {                 # remote extract destionations
134          MACHINE  => 'RDEST::MACHINE', # name of remote machine
135          LOGNAME  => 'RDEST::LOGNAME', # user logname on remote machine
136          ROOTDIR  => 'RDEST::ROOTDIR', # top directory for this extract
137          SRCDIR   => 'RDEST::SRCDIR',  # extracted source directory
138          CFGDIR   => 'RDEST::CFGDIR',  # generated configuration directory
139          BLD_CFG  => 'RDEST::BLD_CFG', # generated bld cfg file
140          EXT_CFG  => 'RDEST::EXT_CFG', # generated ext cfg file
141        },
142        INC        => 'INC',            # "include" settings in another cfg file
143        BDECLARE   => 'BLD',            # declare entries for build system
144        OVERRIDE   => 'OVERRIDE',       # set conflict override option
145        REPOS      => 'REPOS',          # set repos loc for a project branch
146        VERSION    => 'VERSION',        # set version for a project branch
147        EXPSRCDIR  => 'EXPSRC',         # prefix, expandable source directory
148        MIRROR     => 'MIRROR',         # mirror tool
149
150        # Labels for pck cfg
151        TYPE       => 'TYPE',           # type of source file/build task
152        SCAN       => 'SCAN',           # scan source file for dependency
153        INTNAME    => 'INTNAME',        # internal name of source file
154        DEP        => 'DEP',            # source file/build task dependencies
155      },
156
157      # Keywords in known FCM configuration files
158      CFG_KEYWORD => 'USE,INC,TARGET,EXCL_DEP',
159
160      # Types of "inc" statements expandable CFG files
161      CFG_EXP_INC => 'BLD,EXT,FCM',
162
163      # Standard sub-directories for extract/build
164      DIR => {
165        BIN    => 'bin',    # executable
166        BLD    => 'bld',    # build
167        CACHE  => '.cache', # cache
168        CFG    => 'cfg',    # configuration
169        DONE   => 'done',   # "done"
170        ETC    => 'etc',    # miscellaneous items
171        FLAGS  => 'flags',  # "flags"
172        INC    => 'inc',    # include
173        LIB    => 'lib',    # library
174        OBJ    => 'obj',    # object
175        PPSRC  => 'ppsrc',  # pre-processed source
176        SRC    => 'src',    # source
177        TMP    => 'tmp',    # temporary directory
178      },
179
180      # Build commands and options (i.e. tools)
181      TOOL => {
182        SHELL        => '/usr/bin/ksh',    # Default shell
183
184        CPP          => 'cpp',             # C pre-processor
185        CPPFLAGS     => '-C',              # CPP flags
186        CPP_INCLUDE  => '-I',              # CPP flag, specify "include" path
187        CPP_DEFINE   => '-D',              # CPP flag, define macro
188        CPPKEYS      => '',                # CPP keys (definition macro)
189
190        CC           => 'cc',              # C compiler
191        CFLAGS       => '',                # CC flags
192        CC_COMPILE   => '-c',              # CC flag, compile only
193        CC_OUTPUT    => '-o',              # CC flag, specify output file name
194        CC_INCLUDE   => '-I',              # CC flag, specify "include" path
195        CC_DEFINE    => '-D',              # CC flag, define macro
196
197        FPP          => 'cpp',             # Fortran pre-processor
198        FPPFLAGS     => '-P -traditional', # FPP flags
199        FPP_INCLUDE  => '-I',              # FPP flag, specify "include" path
200        FPP_DEFINE   => '-D',              # FPP flag, define macro
201        FPPKEYS      => '',                # FPP keys (definition macro)
202
203        FC           => 'f90',             # Fortran compiler
204        FFLAGS       => '',                # FC flags
205        FC_COMPILE   => '-c',              # FC flag, compile only
206        FC_OUTPUT    => '-o',              # FC flag, specify output file name
207        FC_INCLUDE   => '-I',              # FC flag, specify "include" path
208        FC_DEFINE    => '-D',              # FC flag, define macro
209
210        LD           => 'ld',              # linker
211        LDFLAGS      => '',                # LD flags
212        LD_OUTPUT    => '-o',              # LD flag, specify output file name
213        LD_LIBSEARCH => '-L',              # LD flag, specify "library" path
214        LD_LIBLINK   => '-l',              # LD flag, specify link library
215
216        AR           => 'ar',              # library archiver
217        ARFLAGS      => 'rs',              # AR flags
218
219        MAKE         => 'make',            # make command
220        MAKEFLAGS    => '',                # make flags
221        MAKE_SILENT  => '-s',              # make flag, silent diagnostic
222        MAKE_JOB     => '-j',              # make flag, number of jobs
223
224        INTERFACE    => 'file',            # name interface after file/program
225        GENINTERFACE => 'ECMWF',           # Fortran 9x interface generator
226
227        MIRROR       => 'rsync',           # extract mirroring tool
228        REMOTE_SHELL => 'remsh',           # command to invoke the remote shell
229        GRAPHIC_DIFF => 'xxdiff',          # graphical diff tool
230      },
231
232      # List of tools that are local to FCM, (will not be exported to a Makefile)
233      LOCALTOOL => 'CPP,CPPFLAGS,CPP_INCLUDE,CPP_DEFINE,FPP,FPPFLAGS,' .
234                   'FPP_INCLUDE,FPP_DEFINE,GRAPHIC_DIFF,MAKE,MAKEFLAGS,' .
235                   'MAKE_SILENT,MAKE_JOB,INTERFACE,GENINTERFACE,MIRROR,' .
236                   'REMOTE_SHELL',
237
238      # Supported tools for compilable source
239      SRC_TOOL => {
240        FORTRAN => {
241          COMPILER => 'FC',
242          FLAGS    => 'FFLAGS',
243          OUTPUT   => 'FC_OUTPUT',
244          INCLUDE  => 'FC_INCLUDE',
245        },
246
247        FPP     => {
248          COMPILER => 'FC',
249          FLAGS    => 'FFLAGS',
250          PPKEYS   => 'FPPKEYS',
251          OUTPUT   => 'FC_OUTPUT',
252          INCLUDE  => 'FC_INCLUDE',
253          DEFINE   => 'FC_DEFINE',
254        },
255
256        C       => {
257          COMPILER => 'CC',
258          FLAGS    => 'CFLAGS',
259          PPKEYS   => 'CPPKEYS',
260          OUTPUT   => 'CC_OUTPUT',
261          INCLUDE  => 'CC_INCLUDE',
262          DEFINE   => 'CC_DEFINE',
263        },
264      },
265
266      # Cache file names/extensions
267      CACHE => {
268        EXTCONFIG   => '.config',       # ext cache, commit version info
269        PCKFILE     => '.pck_file',     # bld cache, source package list
270        PCKPPDEPEND => '.pck_ppdepend', # bld cache, source package PP dependency
271        PCKDEPEND   => '.pck_depend',   # bld cache, source package dependency
272        BLDTOOL     => '.bld_tool',     # bld cache, build tool list
273        PPOPTION    => '.bld_pp',       # bld cache, PP option
274        EXE_DEP     => '.exe_dep',      # bld cache, executable extra dependency
275      },
276
277      # Input file name extension and type
278      # (may overlap with output and vpath, see below)
279      INFILE_EXT => {
280        # General extensions
281        'f'    => 'FORTRAN::SOURCE',
282        'for'  => 'FORTRAN::SOURCE',
283        'ftn'  => 'FORTRAN::SOURCE',
284        'f77'  => 'FORTRAN::SOURCE',
285        'f90'  => 'FORTRAN::FORTRAN9X::SOURCE',
286        'f95'  => 'FORTRAN::FORTRAN9X::SOURCE',
287        'F'    => 'FPP::SOURCE',
288        'FOR'  => 'FPP::SOURCE',
289        'FTN'  => 'FPP::SOURCE',
290        'F77'  => 'FPP::SOURCE',
291        'F90'  => 'FPP::FPP9X::SOURCE',
292        'F95'  => 'FPP::FPP9X::SOURCE',
293        'c'    => 'C::SOURCE',
294        'cpp'  => 'C::C++::SOURCE',
295        'h'    => 'CPP::INCLUDE',
296        'o'    => 'BINARY::OBJ',
297        'obj'  => 'BINARY::OBJ',
298        'exe'  => 'BINARY::EXE',
299        'a'    => 'BINARY::LIB',
300        'sh'   => 'SHELL::SCRIPT',
301        'ksh'  => 'SHELL::SCRIPT',
302        'bash' => 'SHELL::SCRIPT',
303        'csh'  => 'SHELL::SCRIPT',
304        'pl'   => 'PERL::SCRIPT',
305        'pm'   => 'PERL::SCRIPT',
306        'py'   => 'PYTHON::SCRIPT',
307        'tcl'  => 'TCL::SCRIPT',
308        'pro'  => 'PVWAVE::SCRIPT',
309
310        # Local extensions
311        'cfg'       => 'CFGFILE',
312        'h90'       => 'CPP::INCLUDE',
313        'inc'       => 'FORTRAN::FORTRAN9X::INCLUDE',
314        'interface' => 'FORTRAN::FORTRAN9X::INCLUDE::INTERFACE',
315      },
316
317      # Input file name pattern and type
318      INFILE_PAT => {
319        '\w+Scr_\w+'              => 'SHELL::SCRIPT',
320        '\w+Comp_\w+'             => 'SHELL::SCRIPT::GENTASK',
321        '\w+(?:IF|Interface)_\w+' => 'SHELL::SCRIPT::GENIF',
322        '\w+Suite_\w+'            => 'SHELL::SCRIPT::GENSUITE',
323        '\w+List_\w+'             => 'SHELL::SCRIPT::GENLIST',
324        '\w+Sql_\w+'              => 'SCRIPT::SQL',
325      },
326
327      # Input text file pattern and type
328      INFILE_TXT => {
329        '(?:[ck]|ba)?sh'  => 'SHELL::SCRIPT',
330        'perl'            => 'PERL::SCRIPT',
331        'python'          => 'PYTHON::SCRIPT',
332        'tcl(?:sh)?|wish' => 'TCL::SCRIPT',
333      },
334
335      # Ignore input files matching the following names (comma-separated list)
336      INFILE_IGNORE => 'fcm_env.ksh',
337
338      # Output file type and extension
339      # (may overlap with input (above) and vpath (below))
340      OUTFILE_EXT => {
341        CFG       => '.cfg',       # FCM configuration file
342        DONE      => '.done',      # "done" files for compiled source
343        ETC       => '.etc',       # "etc" dummy file
344        EXE       => '.exe',       # binary executables
345        FLAGS     => '.flags',     # "flags" files, compiler flags config
346        IDONE     => '.idone',     # "done" files for included source
347        INTERFACE => '.interface', # interface for F90 subroutines/functions
348        LIB       => '.a',         # archive object library
349        MK        => '.mk',        # dependency files, Makefile fragments
350        MOD       => '.mod',       # compiled Fortran module information files
351        OBJ       => '.o',         # compiled object files
352        PDONE     => '.pdone',     # "done" files for pre-processed files
353        TAR       => '.tar',       # TAR archive
354      },
355
356      # VPATH, each value must be a comma separate list
357      # EMPTY      translates to %
358      # IN:<FLAG>  translates to any key in {INFILE_EXT} if the value contains
359      #            the word in <FLAG>
360      # OUT:<FLAG> translates to {OUTFILE_EXT}{<FLAG>}
361      VPATH   => {
362        BIN   => 'EMPTY,OUT:EXE,IN:SCRIPT',
363        BLD   => 'OUT:MK',
364        DONE  => 'OUT:DONE,OUT:IDONE,OUT:ETC',
365        FLAGS => 'OUT:FLAGS',
366        INC   => 'IN:INCLUDE',
367        LIB   => 'OUT:LIB',
368        OBJ   => 'OUT:OBJ',
369      },
370
371      # Dependency scan types for pre-processing
372      PP_DEP_TYPE => {
373        FPP => 'H',
374        CPP => 'H',
375        C   => 'H',
376      },
377
378      # Dependency scan types
379      DEP_TYPE => {
380        FORTRAN => 'USE::INTERFACE::INC::OBJ',
381        FPP     => 'USE::INTERFACE::INC::H::OBJ',
382        CPP     => 'H::OBJ',
383        C       => 'H::OBJ',
384        SCRIPT  => 'EXE',
385      },
386
387      # Dependency pattern for each type
388      DEP_PATTERN => {
389        H         => q/^#\s*include\s*['"](\S+)['"]/,
390        USE       => q/^\s*use\s+(\w+)/,
391        INTERFACE => q/^#?\s*include\s+['"](\S+##OUTFILE_EXT::INTERFACE##)['"]/,
392        INC       => q/^\s*include\s+['"](\S+)['"]/,
393        OBJ       => q#^\s*(?:/\*|!)\s*depends\s*on\s*:\s*(\S+)#,
394        EXE       => q/^\s*(?:#|;)\s*(?:calls|list|if|interface)\s*:\s*(\S+)/,
395      },
396
397      # Types that always need to be built
398      ALWAYS_BUILD_TYPE => 'PVWAVE,GENLIST,SQL',
399
400      # Types that cannot have duplicated targets
401      NO_DUPLICATED_TARGET_TYPE => '',
402
403      # Excluded dependency
404      EXCL_DEP => {
405        # Fortran intrinsic modules
406        'USE::ISO_C_BINDING'            => {'' => 1},
407        'USE::IEEE_EXCEPTIONS'          => {'' => 1},
408        'USE::IEEE_ARITHMETIC'          => {'' => 1},
409        'USE::IEEE_FEATURES'            => {'' => 1},
410
411        # Fortran intrinsic subroutines
412        'OBJ::CPU_TIME'                 => {'' => 1},
413        'OBJ::GET_COMMAND'              => {'' => 1},
414        'OBJ::GET_COMMAND_ARGUMENT'     => {'' => 1},
415        'OBJ::GET_ENVIRONMENT_VARIABLE' => {'' => 1},
416        'OBJ::MOVE_ALLOC'               => {'' => 1},
417        'OBJ::MVBITS'                   => {'' => 1},
418        'OBJ::RANDOM_NUMBER'            => {'' => 1},
419        'OBJ::RANDOM_SEED'              => {'' => 1},
420        'OBJ::SYSTEM_CLOCK'             => {'' => 1},
421
422        # Dummy statements
423        'OBJ::NONE'                     => {'' => 1},
424        'EXE::NONE'                     => {'' => 1},
425      },
426
427      # Extra executable dependencies
428      EXE_DEP => {},
429
430      # Fortran BLOCKDATA dependencies
431      BLOCKDATA => {},
432
433      # Rename main program targets
434      EXE_NAME => {},
435
436      # Build sub-directories that can be archived by "tar"
437      TAR_DIRS => 'BLD,CACHE,DONE,FLAGS,INC,PPSRC,OBJ',
438
439      # Misc
440      MISC => {
441        CPDUMMY       => '$(FCM_DONEDIR)/FCM_CP.dummy',
442                                         # build system "copy" dummy target
443        DIR_SEPARATOR => '/',            # repository directory separator
444        EXPURL_PREFIX => 'fcm:',         # expandable URL keyword prefix
445        LOCK_BLD      => 'fcm.bld.lock', # build lock file
446        LOCK_EXT      => 'fcm.ext.lock', # extract lock file
447        MAKEFILE      => 'Makefile',     # name of Makefile
448        RUN_ENV_SH    => 'fcm_env.ksh',  # bld runtime environment shell script
449        WEB_BROWSER   => 'firefox',      # web browser
450      },
451
452      # URL, revision, and Trac URL keywords
453      URL      => {},
454      REVISION => {},
455      TRAC     => {},
456    },
457  };
458
459  # Backward compatibility: the REPOS setting is equivalent to the URL setting
460  $self->{SETTING}{REPOS} = $self->{SETTING}{URL};
461
462  bless $self, $class;
463  return $self;
464}
465
466# ------------------------------------------------------------------------------
467# SYNOPSIS
468#   $file = $config->central_config ();
469#   $config->central_config ($file);
470#
471# DESCRIPTION
472#   This method returns the path name of the central configuration file. If an
473#   argument $file is specified, the path name of the central configuration
474#   file is set to its value.
475# ------------------------------------------------------------------------------
476
477sub central_config {
478  my $self = shift;
479
480  if (@_) {
481    $self->{CNTL_CONFIG} = $_[0];
482  }
483
484  return $self->{CNTL_CONFIG};
485}
486
487# ------------------------------------------------------------------------------
488# SYNOPSIS
489#   $file = $config->user_config ();
490#   $config->user_config ($file);
491#
492# DESCRIPTION
493#   This method returns the path name of the user configuration file. If an
494#   argument $file is specified, the path name of the user configuration file
495#   is set to its value.
496# ------------------------------------------------------------------------------
497
498sub user_config {
499  my $self = shift;
500
501  if (@_) {
502    $self->{USER_CONFIG} = $_[0];
503  }
504
505  return $self->{USER_CONFIG};
506}
507
508# ------------------------------------------------------------------------------
509# SYNOPSIS
510#   $mode = $config->verbose ();
511#   $config->verbose ($mode);
512#
513# DESCRIPTION
514#   This method returns the diagnostic verbose level. If an argument $mode is
515#   specified, the diagnostic verbose level is set to its value.
516# ------------------------------------------------------------------------------
517
518sub verbose {
519  my $self = shift;
520
521  if (@_) {
522    $self->{VERBOSE} = $_[0];
523  }
524
525  return $self->{VERBOSE};
526}
527
528# ------------------------------------------------------------------------------
529# SYNOPSIS
530#   $setting = $config->setting (arg, [...]);
531#
532# DESCRIPTION
533#   This method returns an item under the SETTING hash table. The depth within
534#   the hash table is given by the list of arguments, which should match with
535#   the keys in the multi-dimension SETTING hash table.
536# ------------------------------------------------------------------------------
537
538sub setting {
539  my $self = shift;
540
541  if (@_) {
542    my $label   = shift;
543    my $setting = $self->{SETTING};
544    return _get_hash_value ($setting->{$label}, @_) if exists $setting->{$label};
545  }
546
547  return undef;
548
549}
550
551# ------------------------------------------------------------------------------
552# SYNOPSIS
553#   $config->assign_setting (
554#     LABELS => \@labels, # setting labels
555#     VALUE  => $value,   # setting value
556#   );
557#
558# DESCRIPTION
559#   This method assigns a VALUE to a SETTING specified by the names in LABEL.
560# ------------------------------------------------------------------------------
561
562sub assign_setting {
563  my $self = shift;
564  my %args = @_;
565
566  my @labels = exists $args{LABELS} ? @{ $args{LABELS} } : ();
567  my $value  = exists $args{VALUE}  ? $args{VALUE}       : undef;
568
569  my $setting = $self->{SETTING};
570  while (defined (my $label = shift @labels)) {
571    if (exists $setting->{$label}) {
572      if (ref $setting->{$label}) {
573        $setting = $setting->{$label};
574
575      } else {
576        $setting->{$label} = $value;
577        last;
578      }
579
580    } else {
581      if (@labels) {
582        $setting->{$label} = {};
583        $setting           = $setting->{$label};
584
585      } else {
586        $setting->{$label} = $value;
587      }
588    }
589  }
590
591  return;
592}
593
594# ------------------------------------------------------------------------------
595# SYNOPSIS
596#   $variable = $config->variable ([arg]);
597#
598# DESCRIPTION
599#   If arg is set, this method returns the value of a variable named arg. If
600#   arg is not set, this method returns the VARIABLE hash.
601# ------------------------------------------------------------------------------
602
603sub variable {
604  my $self     = shift;
605
606  my $variable = $self->{VARIABLE};
607
608  if (@_) {
609    my $label   = shift;
610    return exists $variable->{$label} ? $variable->{$label} : undef;
611
612  } else {
613    return %{ $variable };
614  }
615}
616
617# ------------------------------------------------------------------------------
618# SYNOPSIS
619#   $config->assign_variable (
620#     LABEL => $label, # variable label
621#     VALUE => $value, # variable value
622#   );
623#
624# DESCRIPTION
625#   This method assigns a VALUE to a VARIABLE named by LABEL.
626# ------------------------------------------------------------------------------
627
628sub assign_variable {
629  my $self = shift;
630  my %args = @_;
631
632  my $label = exists $args{LABEL} ? $args{LABEL} : undef;
633  my $value = exists $args{VALUE} ? $args{VALUE} : undef;
634
635  if ($label) {
636    $self->{VARIABLE}{$label} = $value;
637  }
638
639  return;
640}
641
642# ------------------------------------------------------------------------------
643# SYNOPSIS
644#   $config->get_config ();
645#
646# DESCRIPTION
647#   This method reads the configuration settings from the central and the user
648#   configuration files.
649# ------------------------------------------------------------------------------
650
651sub get_config {
652  my $self = shift;
653
654  $self->_read_config_file ($self->{CNTL_CONFIG}) if $self->{CNTL_CONFIG}; 
655  $self->_read_config_file ($self->{USER_CONFIG}) if $self->{USER_CONFIG};
656
657  return;
658}
659
660# ------------------------------------------------------------------------------
661# SYNOPSIS
662#   $config->_read_config_file ();
663#
664# DESCRIPTION
665#   This internal method reads a configuration file and assign values to the
666#   attributes of the current instance.
667# ------------------------------------------------------------------------------
668
669sub _read_config_file {
670  my $self        = shift;
671  my $config_file = $_[0];
672
673  return undef unless -r $config_file;
674
675  my $cfgfile = Fcm::CfgFile->new (SRC => $config_file, TYPE => 'FCM');
676  $cfgfile->read_cfg ();
677  my @lines = $cfgfile->lines ();
678
679  LINE: for my $line (@lines) {
680    my $label = $line->{LABEL};
681    my $value = $line->{VALUE};
682
683    next unless $label;
684
685    # "Environment variables" start with $
686    if ($label =~ s/^\$([A-Za-z_]\w*)$/$1/) {
687      $ENV{$label} = $value;
688      next LINE;
689    }
690
691    # "Settings variables" start with "set::"
692    my @tags = map {uc $_} split (/::/, $label);
693    if ($tags[0] eq uc $self->{SETTING}{CFG_LABEL}{SETTING}) {
694      shift @tags;
695      $self->assign_setting (LABELS => \@tags, VALUE => $value);
696      next LINE;
697    }
698
699    # Not a standard setting variable, put in internal variable list
700    $label =~ s/^\%//;
701    $self->assign_variable (LABEL => $label, VALUE => $value);
702  }
703
704  1;
705}
706
707# ------------------------------------------------------------------------------
708# SYNOPSIS
709#   $ref = _get_hash_value (arg1, arg2, ...);
710#
711# DESCRIPTION
712#   This internal method recursively gets a value from a multi-dimensional
713#   hash.
714# ------------------------------------------------------------------------------
715
716sub _get_hash_value {
717  my $value = shift;
718
719  while (defined (my $arg = shift)) {
720    if (exists $value->{$arg}) {
721      $value = $value->{$arg};
722
723    } else {
724      return undef;
725    }
726  }
727
728  return $value;
729}
730
731# ------------------------------------------------------------------------------
732
7331;
734
735__END__
Note: See TracBrowser for help on using the repository browser.