source: codes/icosagcm/devel/tools/FCM/lib/Fcm/Config.pm @ 907

Last change on this file since 907 was 10, checked in by ymipsl, 12 years ago

dynamico tree creation

YM
File size: 23.5 KB
Line 
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.1',
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
189        CC           => 'cc',              # C compiler
190        CFLAGS       => '',                # CC flags
191        CC_COMPILE   => '-c',              # CC flag, compile only
192        CC_OUTPUT    => '-o',              # CC flag, specify output file name
193        CC_INCLUDE   => '-I',              # CC flag, specify "include" path
194        CC_DEFINE    => '-D',              # CC flag, define macro
195
196        FPP          => 'cpp',             # Fortran pre-processor
197        FPPFLAGS     => '-P -traditional', # FPP flags
198        FPP_INCLUDE  => '-I',              # FPP flag, specify "include" path
199        FPP_DEFINE   => '-D',              # FPP flag, define macro
200
201        FC           => 'f90',             # Fortran compiler
202        FFLAGS       => '',                # FC flags
203        FC_COMPILE   => '-c',              # FC flag, compile only
204        FC_OUTPUT    => '-o',              # FC flag, specify output file name
205        FC_INCLUDE   => '-I',              # FC flag, specify "include" path
206        FC_DEFINE    => '-D',              # FC flag, define macro
207
208        LD           => 'ld',              # linker
209        LDFLAGS      => '',                # LD flags
210        LD_OUTPUT    => '-o',              # LD flag, specify output file name
211        LD_LIBSEARCH => '-L',              # LD flag, specify "library" path
212        LD_LIBLINK   => '-l',              # LD flag, specify link library
213
214        AR           => 'ar',              # library archiver
215        ARFLAGS      => 'rs',              # AR flags
216
217        MAKE         => 'make',            # make command
218        MAKEFLAGS    => '',                # make flags
219        MAKE_SILENT  => '-s',              # make flag, silent diagnostic
220        MAKE_JOB     => '-j',              # make flag, number of jobs
221
222        INTERFACE    => 'file',            # name interface after file/program
223        GENINTERFACE => 'ECMWF',           # Fortran 9x interface generator
224
225        MIRROR       => 'rsync',           # extract mirroring tool
226        REMOTE_SHELL => 'remsh',           # command to invoke the remote shell
227      },
228
229      # List of tools that are local to FCM, (will not be exported to a Makefile)
230      LOCALTOOL => 'CPP,CPPFLAGS,CPP_INCLUDE,CPP_DEFINE,FPP,FPPFLAGS,' .
231                   'FPP_INCLUDE,FPP_DEFINE,MAKE,MAKEFLAGS,MAKE_SILENT,' .
232                   'MAKE_JOB,INTERFACE,GENINTERFACE,MIRROR,REMOTE_SHELL',
233
234      # Cache file names/extensions
235      CACHE => {
236        EXTCONFIG   => '.config',       # ext cache, commit version info
237        PCKFILE     => '.pck_file',     # bld cache, source package list
238        PCKPPDEPEND => '.pck_ppdepend', # bld cache, source package PP dependency
239        PCKDEPEND   => '.pck_depend',   # bld cache, source package dependency
240        BLDTOOL     => '.bld_tool',     # bld cache, build tool list
241        PPOPTION    => '.bld_pp',       # bld cache, PP option
242        EXE_DEP     => '.exe_dep',      # bld cache, executable extra dependency
243      },
244
245      # Input file name extension and type
246      # (may overlap with output and vpath, see below)
247      INFILE_EXT => {
248        # General extensions
249        'f'    => 'FORTRAN::SOURCE',
250        'for'  => 'FORTRAN::SOURCE',
251        'ftn'  => 'FORTRAN::SOURCE',
252        'f77'  => 'FORTRAN::SOURCE',
253        'f90'  => 'FORTRAN::FORTRAN9X::SOURCE',
254        'f95'  => 'FORTRAN::FORTRAN9X::SOURCE',
255        'F'    => 'FPP::SOURCE',
256        'FOR'  => 'FPP::SOURCE',
257        'FTN'  => 'FPP::SOURCE',
258        'F77'  => 'FPP::SOURCE',
259        'F90'  => 'FPP::FPP9X::SOURCE',
260        'F95'  => 'FPP::FPP9X::SOURCE',
261        'c'    => 'C::SOURCE',
262        'cpp'  => 'C::C++::SOURCE',
263        'h'    => 'CPP::INCLUDE',
264        'o'    => 'BINARY::OBJ',
265        'obj'  => 'BINARY::OBJ',
266        'exe'  => 'BINARY::EXE',
267        'a'    => 'BINARY::LIB',
268        'sh'   => 'SHELL::SCRIPT',
269        'ksh'  => 'SHELL::SCRIPT',
270        'bash' => 'SHELL::SCRIPT',
271        'csh'  => 'SHELL::SCRIPT',
272        'pl'   => 'PERL::SCRIPT',
273        'pm'   => 'PERL::SCRIPT',
274        'py'   => 'PYTHON::SCRIPT',
275        'tcl'  => 'TCL::SCRIPT',
276        'pro'  => 'PVWAVE::SCRIPT',
277
278        # Local extensions
279        'cfg'       => 'CFGFILE',
280        'h90'       => 'CPP::INCLUDE',
281        'inc'       => 'FORTRAN::FORTRAN9X::INCLUDE',
282        'interface' => 'FORTRAN::FORTRAN9X::INCLUDE::INTERFACE',
283      },
284
285      # Input file name pattern and type
286      INFILE_PAT => {
287        '\w+Scr_\w+'              => 'SHELL::SCRIPT',
288        '\w+Comp_\w+'             => 'SHELL::SCRIPT::GENTASK',
289        '\w+(?:IF|Interface)_\w+' => 'SHELL::SCRIPT::GENIF',
290        '\w+Suite_\w+'            => 'SHELL::SCRIPT::GENSUITE',
291        '\w+List_\w+'             => 'SHELL::SCRIPT::GENLIST',
292        '\w+Sql_\w+'              => 'SCRIPT::SQL',
293      },
294
295      # Input text file pattern and type
296      INFILE_TXT => {
297        '(?:[ck]|ba)?sh'  => 'SHELL::SCRIPT',
298        'perl'            => 'PERL::SCRIPT',
299        'python'          => 'PYTHON::SCRIPT',
300        'tcl(?:sh)?|wish' => 'TCL::SCRIPT',
301      },
302
303      # Output file type and extension
304      # (may overlap with input (above) and vpath (below))
305      OUTFILE_EXT => {
306        CFG       => '.cfg',       # FCM configuration file
307        DONE      => '.done',      # "done" files for compiled source
308        ETC       => '.etc',       # "etc" dummy file
309        EXE       => '.exe',       # binary executables
310        FLAGS     => '.flags',     # "flags" files, compiler flags config
311        IDONE     => '.idone',     # "done" files for included source
312        INTERFACE => '.interface', # interface for F90 subroutines/functions
313        LIB       => '.a',         # archive object library
314        MK        => '.mk',        # dependency files, Makefile fragments
315        MOD       => '.mod',       # compiled Fortran module information files
316        OBJ       => '.o',         # compiled object files
317        PDONE     => '.pdone',     # "done" files for pre-processed files
318        TAR       => '.tar',       # TAR archive
319      },
320
321      # VPATH, each value must be a comma separate list
322      # EMPTY      translates to %
323      # IN:<FLAG>  translates to any key in {INFILE_EXT} if the value contains
324      #            the word in <FLAG>
325      # OUT:<FLAG> translates to {OUTFILE_EXT}{<FLAG>}
326      VPATH   => {
327        BIN   => 'EMPTY,OUT:EXE,IN:SCRIPT',
328        BLD   => 'OUT:MK',
329        DONE  => 'OUT:DONE,OUT:IDONE,OUT:ETC',
330        FLAGS => 'OUT:FLAGS',
331        INC   => 'IN:INCLUDE',
332        LIB   => 'OUT:LIB',
333        OBJ   => 'OUT:OBJ',
334      },
335
336      # Dependency scan types for pre-processing
337      PP_DEP_TYPE => {
338        FPP => 'H',
339        CPP => 'H',
340        C   => 'H',
341      },
342
343      # Dependency scan types
344      DEP_TYPE => {
345        FORTRAN => 'USE::INTERFACE::INC::OBJ',
346        FPP     => 'USE::INTERFACE::INC::H::OBJ',
347        CPP     => 'H::OBJ',
348        C       => 'H::OBJ',
349        SCRIPT  => 'EXE',
350      },
351
352      # Dependency pattern for each type
353      DEP_PATTERN => {
354        H         => q/^#\s*include\s*['"](\S+)['"]/,
355        USE       => q/^\s*use\s+(\w+)/,
356        INTERFACE => q/^#?\s*include\s+['"](\S+##OUTFILE_EXT::INTERFACE##)['"]/,
357        INC       => q/^\s*include\s+['"](\S+)['"]/,
358        OBJ       => q#^\s*(?:/\*|!)\s*depends\s*on\s*:\s*(\S+)#,
359        EXE       => q/^\s*(?:#|;)\s*(?:calls|list|if|interface)\s*:\s*(\S+)/,
360      },
361
362      # Types that always need to be built
363      ALWAYS_BUILD_TYPE => 'PVWAVE,GENLIST,SQL',
364
365      # Excluded dependency
366      EXCL_DEP => {
367        # Fortran intrinsic modules
368        'USE::ISO_C_BINDING'            => {'' => 1},
369        'USE::IEEE_EXCEPTIONS'          => {'' => 1},
370        'USE::IEEE_ARITHMETIC'          => {'' => 1},
371        'USE::IEEE_FEATURES'            => {'' => 1},
372
373        # Fortran intrinsic subroutines
374        'OBJ::CPU_TIME'                 => {'' => 1},
375        'OBJ::GET_COMMAND'              => {'' => 1},
376        'OBJ::GET_COMMAND_ARGUMENT'     => {'' => 1},
377        'OBJ::GET_ENVIRONMENT_VARIABLE' => {'' => 1},
378        'OBJ::MOVE_ALLOC'               => {'' => 1},
379        'OBJ::MVBITS'                   => {'' => 1},
380        'OBJ::RANDOM_NUMBER'            => {'' => 1},
381        'OBJ::RANDOM_SEED'              => {'' => 1},
382        'OBJ::SYSTEM_CLOCK'             => {'' => 1},
383
384        # Dummy statements
385        'OBJ::NONE'                     => {'' => 1},
386        'EXE::NONE'                     => {'' => 1},
387      },
388
389      # Extra executable dependencies
390      EXE_DEP => {},
391
392      # Fortran BLOCKDATA dependencies
393      BLOCKDATA => {},
394
395      # Rename main program targets
396      EXE_NAME => {},
397
398      # Build sub-directories that can be archived by "tar"
399      TAR_DIRS => 'BLD,CACHE,DONE,FLAGS,INC,PPSRC,OBJ',
400
401      # Misc
402      MISC => {
403        CPDUMMY       => '$(FCM_DONEDIR)/FCM_CP.dummy',
404                                         # build system "copy" dummy target
405        DIR_SEPARATOR => '/',            # repository directory separator
406        EXPURL_PREFIX => 'fcm:',         # expandable URL keyword prefix
407        LOCK_BLD      => 'fcm.bld.lock', # build lock file
408        LOCK_EXT      => 'fcm.ext.lock', # extract lock file
409        MAKEFILE      => 'Makefile',     # name of Makefile
410        RUN_ENV_SH    => 'fcm_env.ksh',  # bld runtime environment shell script
411        WEB_BROWSER   => 'firefox',      # web browser
412      },
413
414      # Repository URL, revision, and Trac URL keywords
415      REPOS    => {},
416      REVISION => {},
417      TRAC     => {},
418    },
419  };
420
421  bless $self, $class;
422  return $self;
423}
424
425# ------------------------------------------------------------------------------
426# SYNOPSIS
427#   $file = $config->central_config ();
428#   $config->central_config ($file);
429#
430# DESCRIPTION
431#   This method returns the path name of the central configuration file. If an
432#   argument $file is specified, the path name of the central configuration
433#   file is set to its value.
434# ------------------------------------------------------------------------------
435
436sub central_config {
437  my $self = shift;
438
439  if (@_) {
440    $self->{CNTL_CONFIG} = $_[0];
441  }
442
443  return $self->{CNTL_CONFIG};
444}
445
446# ------------------------------------------------------------------------------
447# SYNOPSIS
448#   $file = $config->user_config ();
449#   $config->user_config ($file);
450#
451# DESCRIPTION
452#   This method returns the path name of the user configuration file. If an
453#   argument $file is specified, the path name of the user configuration file
454#   is set to its value.
455# ------------------------------------------------------------------------------
456
457sub user_config {
458  my $self = shift;
459
460  if (@_) {
461    $self->{USER_CONFIG} = $_[0];
462  }
463
464  return $self->{USER_CONFIG};
465}
466
467# ------------------------------------------------------------------------------
468# SYNOPSIS
469#   $mode = $config->verbose ();
470#   $config->verbose ($mode);
471#
472# DESCRIPTION
473#   This method returns the diagnostic verbose level. If an argument $mode is
474#   specified, the diagnostic verbose level is set to its value.
475# ------------------------------------------------------------------------------
476
477sub verbose {
478  my $self = shift;
479
480  if (@_) {
481    $self->{VERBOSE} = $_[0];
482  }
483
484  return $self->{VERBOSE};
485}
486
487# ------------------------------------------------------------------------------
488# SYNOPSIS
489#   $setting = $config->setting (arg, [...]);
490#
491# DESCRIPTION
492#   This method returns an item under the SETTING hash table. The depth within
493#   the hash table is given by the list of arguments, which should match with
494#   the keys in the multi-dimension SETTING hash table.
495# ------------------------------------------------------------------------------
496
497sub setting {
498  my $self = shift;
499
500  if (@_) {
501    my $label   = shift;
502    my $setting = $self->{SETTING};
503    return _get_hash_value ($setting->{$label}, @_) if exists $setting->{$label};
504  }
505
506  return undef;
507
508}
509
510# ------------------------------------------------------------------------------
511# SYNOPSIS
512#   $config->assign_setting (
513#     LABELS => \@labels, # setting labels
514#     VALUE  => $value,   # setting value
515#   );
516#
517# DESCRIPTION
518#   This method assigns a VALUE to a SETTING specified by the names in LABEL.
519# ------------------------------------------------------------------------------
520
521sub assign_setting {
522  my $self = shift;
523  my %args = @_;
524
525  my @labels = exists $args{LABELS} ? @{ $args{LABELS} } : ();
526  my $value  = exists $args{VALUE}  ? $args{VALUE}       : undef;
527
528  my $setting = $self->{SETTING};
529  while (defined (my $label = shift @labels)) {
530    if (exists $setting->{$label}) {
531      if (ref $setting->{$label}) {
532        $setting = $setting->{$label};
533
534      } else {
535        $setting->{$label} = $value;
536        last;
537      }
538
539    } else {
540      if (@labels) {
541        $setting->{$label} = {};
542        $setting           = $setting->{$label};
543
544      } else {
545        $setting->{$label} = $value;
546      }
547    }
548  }
549
550  return;
551}
552
553# ------------------------------------------------------------------------------
554# SYNOPSIS
555#   $variable = $config->variable ([arg]);
556#
557# DESCRIPTION
558#   If arg is set, this method returns the value of a variable named arg. If
559#   arg is not set, this method returns the VARIABLE hash.
560# ------------------------------------------------------------------------------
561
562sub variable {
563  my $self     = shift;
564
565  my $variable = $self->{VARIABLE};
566
567  if (@_) {
568    my $label   = shift;
569    return exists $variable->{$label} ? $variable->{$label} : undef;
570
571  } else {
572    return %{ $variable };
573  }
574}
575
576# ------------------------------------------------------------------------------
577# SYNOPSIS
578#   $config->assign_variable (
579#     LABEL => $label, # variable label
580#     VALUE => $value, # variable value
581#   );
582#
583# DESCRIPTION
584#   This method assigns a VALUE to a VARIABLE named by LABEL.
585# ------------------------------------------------------------------------------
586
587sub assign_variable {
588  my $self = shift;
589  my %args = @_;
590
591  my $label = exists $args{LABEL} ? $args{LABEL} : undef;
592  my $value = exists $args{VALUE} ? $args{VALUE} : undef;
593
594  if ($label) {
595    $self->{VARIABLE}{$label} = $value;
596  }
597
598  return;
599}
600
601# ------------------------------------------------------------------------------
602# SYNOPSIS
603#   $config->get_config ();
604#
605# DESCRIPTION
606#   This method reads the configuration settings from the central and the user
607#   configuration files.
608# ------------------------------------------------------------------------------
609
610sub get_config {
611  my $self = shift;
612
613  $self->_read_config_file ($self->{CNTL_CONFIG}) if $self->{CNTL_CONFIG}; 
614  $self->_read_config_file ($self->{USER_CONFIG}) if $self->{USER_CONFIG};
615
616  return;
617}
618
619# ------------------------------------------------------------------------------
620# SYNOPSIS
621#   $config->_read_config_file ();
622#
623# DESCRIPTION
624#   This internal method reads a configuration file and assign values to the
625#   attributes of the current instance.
626# ------------------------------------------------------------------------------
627
628sub _read_config_file {
629  my $self        = shift;
630  my $config_file = $_[0];
631
632  return undef unless -r $config_file;
633
634  my $cfgfile = Fcm::CfgFile->new (SRC => $config_file, TYPE => 'FCM');
635  $cfgfile->read_cfg ();
636  my @lines = $cfgfile->lines ();
637
638  LINE: for my $line (@lines) {
639    my $label = $line->{LABEL};
640    my $value = $line->{VALUE};
641
642    next unless $label;
643
644    # "Environment variables" start with $
645    if ($label =~ s/^\$([A-Za-z_]\w*)$/$1/) {
646      $ENV{$label} = $value;
647      next LINE;
648    }
649
650    # "Settings variables" start with "set::"
651    my @tags = map {uc $_} split (/::/, $label);
652    if ($tags[0] eq uc $self->{SETTING}{CFG_LABEL}{SETTING}) {
653      shift @tags;
654      $self->assign_setting (LABELS => \@tags, VALUE => $value);
655      next LINE;
656    }
657
658    # Not a standard setting variable, put in internal variable list
659    $label =~ s/^\%//;
660    $self->assign_variable (LABEL => $label, VALUE => $value);
661  }
662
663  1;
664}
665
666# ------------------------------------------------------------------------------
667# SYNOPSIS
668#   $ref = _get_hash_value (arg1, arg2, ...);
669#
670# DESCRIPTION
671#   This internal method recursively gets a value from a multi-dimensional
672#   hash.
673# ------------------------------------------------------------------------------
674
675sub _get_hash_value {
676  my $value = shift;
677
678  while (defined (my $arg = shift)) {
679    if (exists $value->{$arg}) {
680      $value = $value->{$arg};
681
682    } else {
683      return undef;
684    }
685  }
686
687  return $value;
688}
689
690# ------------------------------------------------------------------------------
691
6921;
693
694__END__
Note: See TracBrowser for help on using the repository browser.