[1980] | 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 | |
---|
| 15 | package Fcm::Config; |
---|
| 16 | |
---|
| 17 | # Standard pragma |
---|
| 18 | use warnings; |
---|
| 19 | use strict; |
---|
| 20 | |
---|
| 21 | # Standard modules |
---|
| 22 | use File::Basename; |
---|
| 23 | use File::Spec::Functions; |
---|
| 24 | use FindBin; |
---|
| 25 | use POSIX qw/setlocale LC_ALL/; |
---|
| 26 | |
---|
| 27 | # FCM component modules |
---|
| 28 | use Fcm::CfgFile; |
---|
| 29 | |
---|
| 30 | # Other declarations: |
---|
| 31 | sub _get_hash_value; |
---|
| 32 | |
---|
| 33 | # Delimiter for setting and for list |
---|
| 34 | our $DELIMITER = '::'; |
---|
| 35 | our $DELIMITER_PATTERN = qr{::|/}; |
---|
| 36 | our $DELIMITER_LIST = ','; |
---|
| 37 | |
---|
| 38 | my $INSTANCE; |
---|
| 39 | |
---|
| 40 | # ------------------------------------------------------------------------------ |
---|
| 41 | # SYNOPSIS |
---|
| 42 | # $config = Fcm::Config->instance(); |
---|
| 43 | # |
---|
| 44 | # DESCRIPTION |
---|
| 45 | # Returns an instance of this class. |
---|
| 46 | # ------------------------------------------------------------------------------ |
---|
| 47 | |
---|
| 48 | sub 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 | |
---|
| 69 | sub 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 | |
---|
| 626 | for 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 | # ------------------------------------------------------------------------------ |
---|
| 681 | sub 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 | |
---|
| 711 | for 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 | |
---|
| 759 | sub 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 | |
---|
| 811 | sub 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 | |
---|
| 829 | sub _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 | |
---|
| 875 | sub _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 | |
---|
| 892 | 1; |
---|
| 893 | |
---|
| 894 | __END__ |
---|