Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

Config.pm @ 81

Last change on this file since 81 was 81, checked in by ymipsl, 15 years ago
ajout FCM 1.5
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
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/^#\sinclude\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(?:/\\|!)\sdepends\son\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__

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

Context Navigation

source: XMLIO_V2/tools/FCM/lib/Fcm/Config.pm @ 81

Download in other formats: