Context Navigation

source: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Config.pm @ 5099

Last change on this file since 5099 was 5095, checked in by abarral, 4 months ago
Revert cosp*/ from the trunk, as it's external code Add missing bits from FCM2 source
File size: 30.3 KB

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

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

Download in other formats: