Context Navigation

Config.pm

Last change on this file was 1578, checked in by jghattas, 13 years ago

Add fcm in LMDZ5/tools directory

It is no longer needed to have fcm in your environement PATH variable.
Now makelmdz_fcm takes by default this fcm. It is still possible to use
another fcm, using -fcm_path argument in makelmdz_fcm.

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: LMDZ5/branches/LMDZ5_SPLA/tools/fcm/lib/Fcm/Config.pm

Download in other formats: