source: branches/UKMO/r6232_tracer_advection/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Config.pm @ 9295

Last change on this file since 9295 was 9295, checked in by jcastill, 3 years ago

Remove svn keywords

File size: 30.0 KB
Line 
1# ------------------------------------------------------------------------------
2# NAME
3#   Fcm::Config
4#
5# DESCRIPTION
6#   This is a class for reading and processing central and user configuration
7#   settings for FCM.
8#
9# COPYRIGHT
10#   (C) Crown copyright Met Office. All rights reserved.
11#   For further details please refer to the file COPYRIGHT.txt
12#   which you should have received as part of this distribution.
13# ------------------------------------------------------------------------------
14
15package Fcm::Config;
16
17# Standard pragma
18use warnings;
19use strict;
20
21# Standard modules
22use File::Basename;
23use File::Spec::Functions;
24use FindBin;
25use POSIX qw/setlocale LC_ALL/;
26
27# FCM component modules
28use Fcm::CfgFile;
29
30# Other declarations:
31sub _get_hash_value;
32
33# Delimiter for setting and for list
34our $DELIMITER         = '::';
35our $DELIMITER_PATTERN = qr{::|/};
36our $DELIMITER_LIST    = ',';
37
38my $INSTANCE;
39
40# ------------------------------------------------------------------------------
41# SYNOPSIS
42#   $config = Fcm::Config->instance();
43#
44# DESCRIPTION
45#   Returns an instance of this class.
46# ------------------------------------------------------------------------------
47
48sub instance {
49    my ($class) = @_;
50    if (!defined($INSTANCE)) {
51        $INSTANCE = $class->new();
52        $INSTANCE->get_config();
53        $INSTANCE->is_initialising(0);
54    }
55    return $INSTANCE;
56}
57
58# ------------------------------------------------------------------------------
59# SYNOPSIS
60#   $obj = Fcm::Config->new (VERBOSE => $verbose);
61#
62# DESCRIPTION
63#   This method constructs a new instance of the Fcm::Config class.
64#
65# ARGUMENTS
66#   VERBOSE - Set the verbose level of diagnostic output
67# ------------------------------------------------------------------------------
68
69sub new {
70  my $this  = shift;
71  my %args  = @_;
72  my $class = ref $this || $this;
73
74  # Ensure that all subsequent Subversion output is in UK English
75  if (setlocale (LC_ALL, 'en_GB')) {
76    $ENV{LANG} = 'en_GB';
77  }
78
79  my $self = {
80    initialising   => 1,
81    central_config => undef,
82    user_config    => undef,
83    user_id        => undef,
84    verbose        => exists $args{VERBOSE} ? $args{VERBOSE} : undef,
85    variable       => {},
86
87    # Primary settings
88    setting => {
89      # Current command
90      FCM_COMMAND => &basename ($0),
91
92      # Current FCM release identifier
93      FCM_RELEASE => '1-5',
94
95      # Location of file with the last changed revision of the FCM trunk
96      FCM_REV_FILE => catfile (dirname ($FindBin::Bin), 'etc', 'fcm_rev'),
97
98      # Fortran BLOCKDATA dependencies
99      BLD_BLOCKDATA => {},
100
101      # Copy dummy target
102      BLD_CPDUMMY => '$(FCM_DONEDIR)/FCM_CP.dummy',
103
104      # No dependency check
105      BLD_DEP_N => {},
106
107      # Additional (PP) dependencies
108      BLD_DEP => {},
109      BLD_DEP_PP => {},
110
111      # Excluded dependency
112      BLD_DEP_EXCL => {
113        '' => [
114          # Fortran intrinsic modules
115          'USE' . $DELIMITER . 'ISO_C_BINDING',
116          'USE' . $DELIMITER . 'IEEE_EXCEPTIONS',
117          'USE' . $DELIMITER . 'IEEE_ARITHMETIC',
118          'USE' . $DELIMITER . 'IEEE_FEATURES',
119
120          # Fortran intrinsic subroutines
121          'OBJ' . $DELIMITER . 'CPU_TIME',
122          'OBJ' . $DELIMITER . 'GET_COMMAND',
123          'OBJ' . $DELIMITER . 'GET_COMMAND_ARGUMENT',
124          'OBJ' . $DELIMITER . 'GET_ENVIRONMENT_VARIABLE',
125          'OBJ' . $DELIMITER . 'MOVE_ALLOC',
126          'OBJ' . $DELIMITER . 'MVBITS',
127          'OBJ' . $DELIMITER . 'RANDOM_NUMBER',
128          'OBJ' . $DELIMITER . 'RANDOM_SEED',
129          'OBJ' . $DELIMITER . 'SYSTEM_CLOCK',
130
131          # Dummy statements
132          'OBJ' . $DELIMITER . 'NONE',
133          'EXE' . $DELIMITER . 'NONE',
134        ],
135      },
136
137      # Extra executable dependencies
138      BLD_DEP_EXE => {},
139
140      # Dependency pattern for each type
141      BLD_DEP_PATTERN => {
142        H         => q/^#\s*include\s*['"](\S+)['"]/,
143        USE       => q/^\s*use\s+(\w+)/,
144        INTERFACE => q/^#?\s*include\s+['"](\S+##OUTFILE_EXT/ . $DELIMITER .
145                     q/INTERFACE##)['"]/,
146        INC       => q/^\s*include\s+['"](\S+)['"]/,
147        OBJ       => q#^\s*(?:/\*|!)\s*depends\s*on\s*:\s*(\S+)#,
148        EXE       => q/^\s*(?:#|;)\s*(?:calls|list|if|interface)\s*:\s*(\S+)/,
149      },
150
151      # Rename main program targets
152      BLD_EXE_NAME => {},
153
154      # Rename library targets
155      BLD_LIB => {'' => 'fcm_default'},
156
157      # Name of Makefile and run environment shell script
158      BLD_MISC => {
159        'BLDMAKEFILE' => 'Makefile',
160        'BLDRUNENVSH' => 'fcm_env.sh',
161      },
162
163      # PP flags
164      BLD_PP => {},
165
166      # Custom source file type
167      BLD_TYPE => {},
168
169      # Types that always need to be built
170      BLD_TYPE_ALWAYS_BUILD =>                   'PVWAVE' .
171                               $DELIMITER_LIST . 'GENLIST' .
172                               $DELIMITER_LIST . 'SQL',
173
174      # Dependency scan types
175      BLD_TYPE_DEP => {
176        FORTRAN =>              'USE' .
177                   $DELIMITER . 'INTERFACE' .
178                   $DELIMITER . 'INC' .
179                   $DELIMITER . 'OBJ',
180        FPP     =>              'USE' .
181                   $DELIMITER . 'INTERFACE' .
182                   $DELIMITER . 'INC' .
183                   $DELIMITER . 'H' .
184                   $DELIMITER . 'OBJ',
185        CPP     =>              'H' .
186                   $DELIMITER . 'OBJ',
187        C       =>              'H' .
188                   $DELIMITER . 'OBJ',
189        SCRIPT  =>              'EXE',
190      },
191
192      # Dependency scan types for pre-processing
193      BLD_TYPE_DEP_PP => {
194        FPP => 'H',
195        CPP => 'H',
196        C   => 'H',
197      },
198
199      # Types that cannot have duplicated targets
200      BLD_TYPE_NO_DUPLICATED_TARGET => '',
201
202      # BLD_VPATH, each value must be a comma separate list
203      # ''     translates to %
204      # 'FLAG' translates to {OUTFILE_EXT}{FLAG}
205      BLD_VPATH   => {
206        BIN   => q{},
207        ETC   => 'ETC',
208        DONE  => join($DELIMITER_LIST, qw{DONE IDONE}),
209        FLAGS => 'FLAGS',
210        INC   => q{},
211        LIB   => 'LIB',
212        OBJ   => 'OBJ',
213      },
214
215      # Cache basename
216      CACHE          => '.config',
217      CACHE_DEP      => '.config_dep',
218      CACHE_DEP_PP   => '.config_dep_pp',
219      CACHE_FILE_SRC => '.config_file_src',
220
221      # Types of "inc" statements expandable CFG files
222      CFG_EXP_INC =>                   'BLD' .
223                     $DELIMITER_LIST . 'EXT' .
224                     $DELIMITER_LIST . 'FCM',
225
226      # Configuration file labels that can be declared more than once
227      CFG_KEYWORD =>                   'USE' .
228                     $DELIMITER_LIST . 'INC' .
229                     $DELIMITER_LIST . 'TARGET' .
230                     $DELIMITER_LIST . 'BLD_DEP_EXCL',
231
232      # Labels for all types of FCM configuration files
233      CFG_LABEL => {
234        CFGFILE => 'CFG', # config file information
235        INC     => 'INC', # "include" from an configuration file
236
237        # Labels for central/user internal config setting
238        SETTING => 'SET',
239
240        # Labels for systems that allow inheritance
241        DEST => 'DEST', # destination
242        USE  => 'USE',  # use (inherit) a previous configuration
243
244        # Labels for bld and pck cfg
245        TARGET => 'TARGET', # BLD: declare targets, PCK: target of source file
246
247        # Labels for bld cfg
248        BLD_BLOCKDATA => 'BLOCKDATA',   # declare Fortran BLOCKDATA dependencies
249        BLD_DEP       => 'DEP',         # additional dependencies
250        BLD_DEP_N     => 'NO_DEP',      # no dependency check
251        BLD_DEP_EXCL  => 'EXCL_DEP',    # exclude automatic dependencies
252        BLD_DEP_EXE   => 'EXE_DEP',     # declare dependencies for program
253        BLD_EXE_NAME  => 'EXE_NAME',    # rename a main program
254        BLD_LIB       => 'LIB',         # rename library
255        BLD_PP        => 'PP',          # sub-package needs pre-process?
256        BLD_TYPE      => 'SRC_TYPE',    # custom source file type
257        DIR           => 'DIR',         # DEPRECATED, same as DEST
258        INFILE_EXT    => 'INFILE_EXT',  # change input file name extension type
259        INHERIT       => 'INHERIT',     # inheritance flag
260        NAME          => 'NAME',        # name the build
261        OUTFILE_EXT   => 'OUTFILE_EXT', # change output file type extension
262        FILE          => 'SRC',         # declare a sub-package
263        SEARCH_SRC    => 'SEARCH_SRC',  # search src/ sub-directory?
264        TOOL          => 'TOOL',        # declare a tool
265
266        # Labels for ext cfg
267        BDECLARE   => 'BLD',      # build declaration
268        CONFLICT   => 'CONFLICT', # set conflict mode
269        DIRS       => 'SRC',      # declare source directory
270        EXPDIRS    => 'EXPSRC',   # declare expandable source directory
271        MIRROR     => 'MIRROR',   # DEPRECATED, same as RDEST::MIRROR_CMD
272        OVERRIDE   => 'OVERRIDE', # DEPRECATED, replaced by CONFLICT
273        RDEST      => 'RDEST',    # declare remote destionation
274        REVISION   => 'REVISION', # declare branch revision in a project
275        REVMATCH   => 'REVMATCH', # branch revision must match changed revision
276        REPOS      => 'REPOS',    # declare branch in a project
277        VERSION    => 'VERSION',  # DEPRECATED, same as REVISION
278      },
279
280      # Default names of known FCM configuration files
281      CFG_NAME => {
282        BLD        => 'bld.cfg',      # build configuration file
283        EXT        => 'ext.cfg',      # extract configuration file
284        PARSED     => 'parsed_',      # as-parsed configuration file prefix
285      },
286
287      # Latest version of known FCM configuration files
288      CFG_VERSION => {
289        BLD        => '1.0', # bld cfg
290        EXT        => '1.0', # ext cfg
291      },
292
293      # Standard sub-directories for extract/build
294      DIR => {
295        BIN    => 'bin',    # executable
296        BLD    => 'bld',    # build
297        CACHE  => '.cache', # cache
298        CFG    => 'cfg',    # configuration
299        DONE   => 'done',   # "done"
300        ETC    => 'etc',    # miscellaneous items
301        FLAGS  => 'flags',  # "flags"
302        INC    => 'inc',    # include
303        LIB    => 'lib',    # library
304        OBJ    => 'obj',    # object
305        PPSRC  => 'ppsrc',  # pre-processed source
306        SRC    => 'src',    # source
307        TMP    => 'tmp',    # temporary directory
308      },
309
310      # A flag to indicate whether the revision of a given branch for extract
311      # must match with the revision of a changed revision of the branch
312      EXT_REVMATCH => 0, # default is false (allow any revision)
313
314      # Input file name extension and type
315      # (may overlap with output (below) and vpath (above))
316      INFILE_EXT => {
317        # General extensions
318        'f'    =>              'FORTRAN' .
319                  $DELIMITER . 'SOURCE',
320        'for'  =>              'FORTRAN' .
321                  $DELIMITER . 'SOURCE',
322        'ftn'  =>              'FORTRAN' .
323                  $DELIMITER . 'SOURCE',
324        'f77'  =>              'FORTRAN' .
325                  $DELIMITER . 'SOURCE',
326        'f90'  =>              'FORTRAN' .
327                  $DELIMITER . 'FORTRAN9X' .
328                  $DELIMITER . 'SOURCE',
329        'f95'  =>              'FORTRAN' .
330                  $DELIMITER . 'FORTRAN9X' .
331                  $DELIMITER . 'SOURCE',
332        'F'    =>              'FPP' .
333                  $DELIMITER . 'SOURCE',
334        'FOR'  =>              'FPP' .
335                  $DELIMITER . 'SOURCE',
336        'FTN'  =>              'FPP' .
337                  $DELIMITER . 'SOURCE',
338        'F77'  =>              'FPP' .
339                  $DELIMITER . 'SOURCE',
340        'F90'  =>              'FPP' .
341                  $DELIMITER . 'FPP9X' .
342                  $DELIMITER . 'SOURCE',
343        'F95'  =>              'FPP' .
344                  $DELIMITER . 'FPP9X' .
345                  $DELIMITER . 'SOURCE',
346        'c'    =>              'C' .
347                  $DELIMITER . 'SOURCE',
348        'cpp'  =>              'C' .
349                  $DELIMITER . 'C++' .
350                  $DELIMITER . 'SOURCE',
351        'h'    =>              'CPP' .
352                  $DELIMITER . 'INCLUDE',
353        'o'    =>              'BINARY' .
354                  $DELIMITER . 'OBJ',
355        'obj'  =>              'BINARY' .
356                  $DELIMITER . 'OBJ',
357        'exe'  =>              'BINARY' .
358                  $DELIMITER . 'EXE',
359        'a'    =>              'BINARY' .
360                  $DELIMITER . 'LIB',
361        'sh'   =>              'SCRIPT' .
362                  $DELIMITER . 'SHELL',
363        'ksh'  =>              'SCRIPT' .
364                  $DELIMITER . 'SHELL',
365        'bash' =>              'SCRIPT' .
366                  $DELIMITER . 'SHELL',
367        'csh'  =>              'SCRIPT' .
368                  $DELIMITER . 'SHELL',
369        'pl'   =>              'SCRIPT' .
370                  $DELIMITER . 'PERL',
371        'pm'   =>              'SCRIPT' .
372                  $DELIMITER . 'PERL',
373        'py'   =>              'SCRIPT' .
374                  $DELIMITER . 'PYTHON',
375        'tcl'  =>              'SCRIPT' .
376                  $DELIMITER . 'TCL',
377        'pro'  =>              'SCRIPT' .
378                  $DELIMITER . 'PVWAVE',
379
380        # Local extensions
381        'cfg'       =>              'CFGFILE',
382        'h90'       =>              'CPP' .
383                       $DELIMITER . 'INCLUDE',
384        'inc'       =>              'FORTRAN' .
385                       $DELIMITER . 'FORTRAN9X' .
386                       $DELIMITER . 'INCLUDE',
387        'interface' =>              'FORTRAN' .
388                       $DELIMITER . 'FORTRAN9X' .
389                       $DELIMITER . 'INCLUDE' .
390                       $DELIMITER . 'INTERFACE',
391      },
392
393      # Ignore input files matching the following names (comma-separated list)
394      INFILE_IGNORE =>                   'fcm_env.ksh' .
395                       $DELIMITER_LIST . 'fcm_env.sh',
396
397      # Input file name pattern and type
398      INFILE_PAT => {
399        '\w+Scr_\w+'              =>              'SCRIPT' .
400                                     $DELIMITER . 'SHELL',
401        '\w+Comp_\w+'             =>              'SCRIPT' .
402                                     $DELIMITER . 'SHELL' .
403                                     $DELIMITER . 'GENTASK',
404        '\w+(?:IF|Interface)_\w+' =>              'SCRIPT' .
405                                     $DELIMITER . 'SHELL' .
406                                     $DELIMITER . 'GENIF',
407        '\w+Suite_\w+'            =>              'SCRIPT' .
408                                     $DELIMITER . 'SHELL' .
409                                     $DELIMITER . 'GENSUITE',
410        '\w+List_\w+'             =>              'SCRIPT' .
411                                     $DELIMITER . 'SHELL' .
412                                     $DELIMITER . 'GENLIST',
413        '\w+Sql_\w+'              =>              'SCRIPT' .
414                                     $DELIMITER . 'SQL',
415      },
416
417      # Input text file pattern and type
418      INFILE_TXT => {
419        '(?:[ck]|ba)?sh'  =>              'SCRIPT' .
420                             $DELIMITER . 'SHELL',
421        'perl'            =>              'SCRIPT' .
422                             $DELIMITER . 'PERL',
423        'python'          =>              'SCRIPT' .
424                             $DELIMITER . 'PYTHON',
425        'tcl(?:sh)?|wish' =>              'SCRIPT' .
426                             $DELIMITER . 'TCL',
427      },
428
429      # Lock file
430      LOCK => {
431        BLDLOCK => 'fcm.bld.lock', # build lock file
432        EXTLOCK => 'fcm.ext.lock', # extract lock file
433      },
434
435      # Output file type and extension
436      # (may overlap with input and vpath (above))
437      OUTFILE_EXT => {
438        CFG       => '.cfg',       # FCM configuration file
439        DONE      => '.done',      # "done" files for compiled source
440        ETC       => '.etc',       # "etc" dummy file
441        EXE       => '.exe',       # binary executables
442        FLAGS     => '.flags',     # "flags" files, compiler flags config
443        IDONE     => '.idone',     # "done" files for included source
444        INTERFACE => '.interface', # interface for F90 subroutines/functions
445        LIB       => '.a',         # archive object library
446        MOD       => '.mod',       # compiled Fortran module information files
447        OBJ       => '.o',         # compiled object files
448        PDONE     => '.pdone',     # "done" files for pre-processed files
449        TAR       => '.tar',       # TAR archive
450      },
451
452      # Build commands and options (i.e. tools)
453      TOOL => {
454        SHELL        => '/bin/sh',         # Default shell
455
456        CPP          => 'cpp',             # C pre-processor
457        CPPFLAGS     => '-C',              # CPP flags
458        CPP_INCLUDE  => '-I',              # CPP flag, specify "include" path
459        CPP_DEFINE   => '-D',              # CPP flag, define macro
460        CPPKEYS      => '',                # CPP keys (definition macro)
461
462        CC           => 'cc',              # C compiler
463        CFLAGS       => '',                # CC flags
464        CC_COMPILE   => '-c',              # CC flag, compile only
465        CC_OUTPUT    => '-o',              # CC flag, specify output file name
466        CC_INCLUDE   => '-I',              # CC flag, specify "include" path
467        CC_DEFINE    => '-D',              # CC flag, define macro
468
469        FPP          => 'cpp',             # Fortran pre-processor
470        FPPFLAGS     => '-P -traditional', # FPP flags
471        FPP_INCLUDE  => '-I',              # FPP flag, specify "include" path
472        FPP_DEFINE   => '-D',              # FPP flag, define macro
473        FPPKEYS      => '',                # FPP keys (definition macro)
474
475        FC           => 'f90',             # Fortran compiler
476        FFLAGS       => '',                # FC flags
477        FC_COMPILE   => '-c',              # FC flag, compile only
478        FC_OUTPUT    => '-o',              # FC flag, specify output file name
479        FC_INCLUDE   => '-I',              # FC flag, specify "include" path
480        FC_MODSEARCH => '',                # FC flag, specify "module" path
481        FC_DEFINE    => '-D',              # FC flag, define macro
482
483        LD           => '',                # linker
484        LDFLAGS      => '',                # LD flags
485        LD_OUTPUT    => '-o',              # LD flag, specify output file name
486        LD_LIBSEARCH => '-L',              # LD flag, specify "library" path
487        LD_LIBLINK   => '-l',              # LD flag, specify link library
488
489        AR           => 'ar',              # library archiver
490        ARFLAGS      => 'rs',              # AR flags
491
492        MAKE         => 'make',            # make command
493        MAKEFLAGS    => '',                # make flags
494        MAKE_FILE    => '-f',              # make flag, path to Makefile
495        MAKE_SILENT  => '-s',              # make flag, silent diagnostic
496        MAKE_JOB     => '-j',              # make flag, number of jobs
497
498        INTERFACE    => 'file',            # name interface after file/program
499        GENINTERFACE => '',                # Fortran 9x interface generator
500
501        DIFF3        => 'diff3',           # extract diff3 merge
502        DIFF3FLAGS   => '-E -m',           # DIFF3 flags
503        GRAPHIC_DIFF => 'xxdiff',          # graphical diff tool
504        GRAPHIC_MERGE=> 'xxdiff',          # graphical merge tool
505      },
506
507      # List of tools that are local to FCM, (will not be exported to a Makefile)
508      TOOL_LOCAL =>                   'CPP' .
509                    $DELIMITER_LIST . 'CPPFLAGS' .
510                    $DELIMITER_LIST . 'CPP_INCLUDE' .
511                    $DELIMITER_LIST . 'CPP_DEFINE' .
512                    $DELIMITER_LIST . 'DIFF3' .
513                    $DELIMITER_LIST . 'DIFF3_FLAGS' .
514                    $DELIMITER_LIST . 'FPP' .
515                    $DELIMITER_LIST . 'FPPFLAGS' .
516                    $DELIMITER_LIST . 'FPP_INCLUDE' .
517                    $DELIMITER_LIST . 'FPP_DEFINE' .
518                    $DELIMITER_LIST . 'GRAPHIC_DIFF' .
519                    $DELIMITER_LIST . 'GRAPHIC_MERGE' .
520                    $DELIMITER_LIST . 'MAKE' .
521                    $DELIMITER_LIST . 'MAKEFLAGS' .
522                    $DELIMITER_LIST . 'MAKE_FILE' .
523                    $DELIMITER_LIST . 'MAKE_SILENT' .
524                    $DELIMITER_LIST . 'MAKE_JOB' .
525                    $DELIMITER_LIST . 'INTERFACE' .
526                    $DELIMITER_LIST . 'GENINTERFACE' .
527                    $DELIMITER_LIST . 'MIRROR' .
528                    $DELIMITER_LIST . 'REMOTE_SHELL',
529
530      # List of tools that allow sub-package declarations
531      TOOL_PACKAGE =>                   'CPPFLAGS' .
532                      $DELIMITER_LIST . 'CPPKEYS' .
533                      $DELIMITER_LIST . 'CFLAGS' .
534                      $DELIMITER_LIST . 'FPPFLAGS' .
535                      $DELIMITER_LIST . 'FPPKEYS' .
536                      $DELIMITER_LIST . 'FFLAGS' .
537                      $DELIMITER_LIST . 'LD' .
538                      $DELIMITER_LIST . 'LDFLAGS' .
539                      $DELIMITER_LIST . 'INTERFACE' .
540                      $DELIMITER_LIST . 'GENINTERFACE',
541
542      # Supported tools for compilable source
543      TOOL_SRC_PP => {
544        FPP     => {
545          COMMAND => 'FPP',
546          FLAGS   => 'FPPFLAGS',
547          PPKEYS  => 'FPPKEYS',
548          INCLUDE => 'FPP_INCLUDE',
549          DEFINE  => 'FPP_DEFINE',
550        },
551
552        C       => {
553          COMMAND => 'CPP',
554          FLAGS   => 'CPPFLAGS',
555          PPKEYS  => 'CPPKEYS',
556          INCLUDE => 'CPP_INCLUDE',
557          DEFINE  => 'CPP_DEFINE',
558        },
559      },
560
561      # Supported tools for compilable source
562      TOOL_SRC => {
563        FORTRAN => {
564          COMMAND => 'FC',
565          FLAGS   => 'FFLAGS',
566          OUTPUT  => 'FC_OUTPUT',
567          INCLUDE => 'FC_INCLUDE',
568        },
569
570        FPP     => {
571          COMMAND => 'FC',
572          FLAGS   => 'FFLAGS',
573          PPKEYS  => 'FPPKEYS',
574          OUTPUT  => 'FC_OUTPUT',
575          INCLUDE => 'FC_INCLUDE',
576          DEFINE  => 'FC_DEFINE',
577        },
578
579        C       => {
580          COMMAND => 'CC',
581          FLAGS   => 'CFLAGS',
582          PPKEYS  => 'CPPKEYS',
583          OUTPUT  => 'CC_OUTPUT',
584          INCLUDE => 'CC_INCLUDE',
585          DEFINE  => 'CC_DEFINE',
586        },
587      },
588
589      # FCM URL keyword and prefix, FCM revision keyword, and FCM Trac URL
590      URL          => {},
591      URL_REVISION => {},
592
593      URL_BROWSER_MAPPING => {},
594      URL_BROWSER_MAPPING_DEFAULT => {
595        LOCATION_COMPONENT_PATTERN
596        => qr{\A // ([^/]+) /+ ([^/]+)_svn /+(.*) \z}xms,
597        BROWSER_URL_TEMPLATE
598        => 'http://{1}/projects/{2}/intertrac/source:{3}{4}',
599        BROWSER_REV_TEMPLATE => '@{1}',
600      },
601
602      # Default web browser
603      WEB_BROWSER   => 'firefox',
604    },
605  };
606
607  # Backward compatibility: the REPOS setting is equivalent to the URL setting
608  $self->{setting}{REPOS} = $self->{setting}{URL};
609
610  # Alias the REVISION and TRAC setting to URL_REVISION and URL_TRAC
611  $self->{setting}{REVISION} = $self->{setting}{URL_REVISION};
612
613  bless $self, $class;
614  return $self;
615}
616
617# ------------------------------------------------------------------------------
618# SYNOPSIS
619#   $value = $obj->X;
620#   $obj->X ($value);
621#
622# DESCRIPTION
623#   Details of these properties are explained in the "new" method.
624# ------------------------------------------------------------------------------
625
626for my $name (qw/central_config user_config user_id verbose/) {
627  no strict 'refs';
628
629  *$name = sub {
630    my $self = shift;
631
632    # Argument specified, set property to specified argument
633    if (@_) {
634      $self->{$name} = $_[0];
635    }
636
637    # Default value for property
638    if (not defined $self->{$name}) {
639      if ($name eq 'central_config') {
640        # Central configuration file
641        if (-r catfile (dirname ($FindBin::Bin), 'etc', 'fcm.cfg')) {
642          $self->{$name} = catfile (
643            dirname ($FindBin::Bin), 'etc', 'fcm.cfg'
644          );
645
646        } elsif (-r catfile ($FindBin::Bin, 'fcm.cfg')) {
647          $self->{$name} = catfile ($FindBin::Bin, 'fcm.cfg');
648        }
649
650      } elsif ($name eq 'user_config') {
651        # User configuration file
652        my $home = (getpwuid ($<))[7];
653        $home = $ENV{HOME} if not defined $home;
654        $self->{$name} = catfile ($home, '.fcm')
655          if defined ($home) and -r catfile ($home, '.fcm');
656
657      } elsif ($name eq 'user_id') {
658        # User ID of current process
659        my $user = (getpwuid ($<))[0];
660        $user = $ENV{LOGNAME} if not defined $user;
661        $user = $ENV{USER} if not defined $user;
662        $self->{$name} = $user;
663
664      } elsif ($name eq 'verbose') {
665        # Verbose mode
666        $self->{$name} = exists $ENV{FCM_VERBOSE} ? $ENV{FCM_VERBOSE} : 1;
667      }
668    }
669
670    return $self->{$name};
671  }
672}
673
674# ------------------------------------------------------------------------------
675# SYNOPSIS
676#   $flag = $obj->is_initialising();
677#
678# DESCRIPTION
679#   Returns true if this object is initialising.
680# ------------------------------------------------------------------------------
681sub is_initialising {
682  my ($self, $value) = @_;
683  if (defined($value)) {
684    $self->{initialising} = $value;
685  }
686  return $self->{initialising};
687}
688
689
690# ------------------------------------------------------------------------------
691# SYNOPSIS
692#   %hash = %{ $obj->X () };
693#   $obj->X (\%hash);
694#
695#   $value = $obj->X ($index);
696#   $obj->X ($index, $value);
697#
698# DESCRIPTION
699#   Details of these properties are explained in the "new" method.
700#
701#   If no argument is set, this method returns a hash containing a list of
702#   objects. If an argument is set and it is a reference to a hash, the objects
703#   are replaced by the the specified hash.
704#
705#   If a scalar argument is specified, this method returns a reference to an
706#   object, if the indexed object exists or undef if the indexed object does
707#   not exist. If a second argument is set, the $index element of the hash will
708#   be set to the value of the argument.
709# ------------------------------------------------------------------------------
710
711for my $name (qw/variable/) {
712  no strict 'refs';
713
714  *$name = sub {
715    my ($self, $arg1, $arg2) = @_;
716
717    # Ensure property is defined as a reference to a hash
718    $self->{$name} = {} if not defined ($self->{$name});
719
720    # Argument 1 can be a reference to a hash or a scalar index
721    my ($index, %hash);
722
723    if (defined $arg1) {
724      if (ref ($arg1) eq 'HASH') {
725        %hash = %$arg1;
726
727      } else {
728        $index = $arg1;
729      }
730    }
731
732    if (defined $index) {
733      # A scalar index is defined, set and/or return the value of an element
734      $self->{$name}{$index} = $arg2 if defined $arg2;
735
736      return (
737        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
738      );
739
740    } else {
741      # A scalar index is not defined, set and/or return the hash
742      $self->{$name} = \%hash if defined $arg1;
743      return $self->{$name};
744    }
745  }
746}
747
748# ------------------------------------------------------------------------------
749# SYNOPSIS
750#   $setting = $obj->setting (@labels);
751#   $obj->setting (\@labels, $setting);
752#
753# DESCRIPTION
754#   This method returns/sets an item under the setting hash table. The depth
755#   within the hash table is given by the list of arguments @labels, which
756#   should match with the keys in the multi-dimension setting hash table.
757# ------------------------------------------------------------------------------
758
759sub setting {
760  my $self = shift;
761
762  if (@_) {
763    my $arg1 = shift;
764    my $s    = $self->{setting};
765
766    if (ref ($arg1) eq 'ARRAY') {
767      # Assign setting
768      # ------------------------------------------------------------------------
769      my $value = shift;
770
771      while (defined (my $label = shift @$arg1)) {
772        if (exists $s->{$label}) {
773          if (ref $s->{$label} eq 'HASH') {
774            $s = $s->{$label};
775
776          } else {
777            $s->{$label} = $value;
778            last;
779          }
780
781        } else {
782          if (@$arg1) {
783            $s->{$label} = {};
784            $s           = $s->{$label};
785
786          } else {
787            $s->{$label} = $value;
788          }
789        }
790      }
791
792    } else {
793      # Get setting
794      # ------------------------------------------------------------------------
795      return _get_hash_value ($s->{$arg1}, @_) if exists $s->{$arg1};
796    }
797  }
798
799  return undef;
800}
801
802# ------------------------------------------------------------------------------
803# SYNOPSIS
804#   $obj->get_config ();
805#
806# DESCRIPTION
807#   This method reads the configuration settings from the central and the user
808#   configuration files.
809# ------------------------------------------------------------------------------
810
811sub get_config {
812  my $self = shift;
813
814  $self->_read_config_file ($self->central_config); 
815  $self->_read_config_file ($self->user_config);
816
817  return;
818}
819
820# ------------------------------------------------------------------------------
821# SYNOPSIS
822#   $obj->_read_config_file ();
823#
824# DESCRIPTION
825#   This internal method reads a configuration file and assign values to the
826#   attributes of the current instance.
827# ------------------------------------------------------------------------------
828
829sub _read_config_file {
830  my $self        = shift;
831  my $config_file = $_[0];
832
833  if (!$config_file || !-f $config_file || !-r $config_file) {
834    return;
835  }
836
837  my $cfgfile = Fcm::CfgFile->new (SRC => $config_file, TYPE => 'FCM');
838  $cfgfile->read_cfg ();
839
840  LINE: for my $line (@{ $cfgfile->lines }) {
841    next unless $line->label;
842
843    # "Environment variables" start with $
844    if ($line->label =~ /^\$([A-Za-z_]\w*)$/) {
845      $ENV{$1} = $line->value;
846      next LINE;
847    }
848
849    # "Settings variables" start with "set"
850    if ($line->label_starts_with_cfg ('SETTING')) {
851      my @tags = $line->label_fields;
852      shift @tags;
853      @tags = map {uc} @tags;
854      $self->setting (\@tags, $line->value);
855      next LINE;
856    }
857
858    # Not a standard setting variable, put in internal variable list
859    (my $label = $line->label) =~ s/^\%//;
860    $self->variable ($label, $line->value);
861  }
862
863  1;
864}
865
866# ------------------------------------------------------------------------------
867# SYNOPSIS
868#   $ref = _get_hash_value (arg1, arg2, ...);
869#
870# DESCRIPTION
871#   This internal method recursively gets a value from a multi-dimensional
872#   hash.
873# ------------------------------------------------------------------------------
874
875sub _get_hash_value {
876  my $value = shift;
877
878  while (defined (my $arg = shift)) {
879    if (exists $value->{$arg}) {
880      $value = $value->{$arg};
881
882    } else {
883      return undef;
884    }
885  }
886
887  return $value;
888}
889
890# ------------------------------------------------------------------------------
891
8921;
893
894__END__
Note: See TracBrowser for help on using the repository browser.