File Coverage

lib/Uplug/Config.pm
Criterion Covered Total %
statement 78 234 33.3
branch 19 144 13.1
condition 4 28 14.2
subroutine 13 27 48.1
pod 9 21 42.8
total 123 454 27.0


line stmt bran cond sub pod time code
1             #-*-perl-*-
2             #####################################################################
3             #
4             # $Author$
5             # $Id$
6             #
7             #---------------------------------------------------------------------------
8             # Copyright (C) 2004 Jörg Tiedemann
9             #
10             # This program is free software; you can redistribute it and/or modify
11             # it under the terms of the GNU General Public License as published by
12             # the Free Software Foundation; either version 2 of the License, or
13             # (at your option) any later version.
14             #
15             # This program is distributed in the hope that it will be useful,
16             # but WITHOUT ANY WARRANTY; without even the implied warranty of
17             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18             # GNU General Public License for more details.
19             #
20             # You should have received a copy of the GNU General Public License
21             # along with this program; if not, write to the Free Software
22             # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23             #---------------------------------------------------------------------------
24              
25             =head1 NAME
26              
27             Uplug::Config - process Uplug configuration files
28              
29             =head1 SYNOPSIS
30              
31             # name of a Uplug module
32             $module = 'pre/basic';
33              
34             # find the local file for a given module
35             $file = FindConfig( $module );
36             # read the configuration of a given module
37             $config = ReadConfig( $module );
38             # write a config hash to a file
39             WriteConfig( 'newfile.txt', $config );
40              
41             # print information about a specific module
42             PrintConfigInfo( $module );
43             # list all available modules
44             ListAvailableModules();
45             # list all available modules within a certain sub category
46             ListAvailableModules( 'pre' );
47              
48             # find a program (look into various possible dir's)
49             $program = find_executable( $program_name );
50              
51             # Uplug-specific directories
52             $dir = shared_home; # home of all shared files
53             $dir = shared_bin; # home of distributed binaries
54             $dir = shared_systems; # home of Uplug module configurations
55              
56             =head1 DESCRIPTION
57              
58             This module handles Uplug configuration files. Configuration files are usually stored in the global shared folder 'system' for the Uplug libraries. Local files with relative paths and absolute paths are also accepted. Configuration files need to conform the norms of the Uplug libraries and use a perlish format (complex hashs dumped to file using L).
59              
60             When reading configuration files, certain variables are expanded (see below in C).
61              
62             =head2 The Structure of Uplug configuration files
63              
64             A Uplug module is specified by its configuration file. A config file is basically a perlish data structure representing a reference to a hash. A typical module configuration looks like this:
65              
66             {
67              
68             ##--------------------------------------------------------
69             ## module describes the actual program to be executed
70             ## - stdin/stdin specifies which data stream will be used
71             ## to read from / write to STDIN/STDOUT
72             ##--------------------------------------------------------
73              
74             'module' => {
75             'name' => 'module name',
76             'program' => 'executable',
77             'location' => '/path/to/bin/dir',
78             'stdin' => 'input stream name',
79             'stdout' => 'output stream name',
80             },
81              
82             ##--------------------------------------------------------
83             ## description can be any string describing the module
84             ##--------------------------------------------------------
85              
86             'description' => 'description of the module',
87              
88             ##--------------------------------------------------------
89             ## 'input' can be any number of named data streams
90             ## to read from
91             ##--------------------------------------------------------
92              
93             'input' => {
94             'input stream name' => {
95             'format' => 'input format',
96             },
97             },
98              
99             ##--------------------------------------------------------
100             ## 'output' can be any number of named data streams
101             ## to write to, 'write_mode' = 'overwrite' forces Uplug
102             ## to overwrite existing files (default = do not do that)
103             ##--------------------------------------------------------
104              
105             'output' => {
106             'output stream name' => {
107             'format' => 'output format',
108             'write_mode' => 'overwrite'
109             }
110             },
111              
112             ##--------------------------------------------------------
113             ## 'parameter' may contain any kind of parameter
114             ## (even in deep, nested structures)
115             ##--------------------------------------------------------
116              
117             'parameter' => {
118             'name' => {
119             'key' => value,
120             ...
121             }
122             },
123              
124             ##--------------------------------------------------------
125             ## 'arguments' can be used to describe command-line arg's
126             ## using the key-value pairs in 'shortcuts':
127             ## - the key is the flag to be used (with additional '-')
128             ## - the value describes the path to the key to be set
129             ## with the command line argument (separated by ':')
130             ## example: 'f' => 'input:text:format' is used to enable
131             ## the command line flag '-f format' which sets
132             ## the format key in config->input->text
133             ##--------------------------------------------------------
134              
135             'arguments' => {
136             'shortcuts' => {
137             'command-line-flag1' => 'parameter:name:key',
138             'command-line-flag2' => 'input:input stream name:format',
139             ...
140             }
141             }
142             }
143              
144              
145             Config files may include the following variables to refer to standard locations within the Uplug toolbox. They will be expanded when reading the configuration before executing the commands.
146              
147             $UplugHome ..... environment ($UPLUGHOME) or /path/to/uplug
148             $UplugSystem ... environment ($UPLUGCONFIG) or /UPLUGSHARE/systems
149             $UplugBin ...... /path/to/uplug/bin
150             $UplugIni ...... /UPLUGSHARE/ini
151             $UplugLang ..... /UPLUGSHARE/lang
152             $UplugData ..... data
153              
154             C is the path to the global shared directory (if Uplug is installed properly) or the path to the local directory C in your local copy of Uplug (if you don't use the makefile to install Uplug globally). See further down for more information on environment variables and default locations in Uplug.
155              
156             Uplug modules may also point to a sequence of sub-modules. Add the following structures to the config-hash within the 'module' structure:
157              
158              
159             {
160             'module' => {
161             'name' => 'module name',
162              
163             ##--------------------------------------------------------
164             ## submodules are lists of Uplug config files
165             ## (make sure that they exist and that Uplug can find them)
166             ## - submodule names can be used to describe them
167             ## - do not specify programs at the same time!
168             ##--------------------------------------------------------
169              
170             'submodules' => [
171             'config1',
172             'config2',
173             ...
174             ],
175             'submodule names' => [
176             'name of sub-module 1 (config1)',
177             'name of sub-module 2 (config2)',
178             ...
179             ],
180              
181             ##--------------------------------------------------------
182             ## You can define loops over sub-sequences of sub-modules
183             ## You can only define one loop per config file!
184             ## The example below defines a loop over
185             ## sub-module 1 and 2 which will be run 3 times
186             ## (start counting with 1)
187             ##--------------------------------------------------------
188              
189             'loop' => '1:2',
190             'iterations' => '4'
191             }
192             }
193              
194             Look at the pre-defined configuration files to see more examples of possible configuration structures.
195              
196             =cut
197              
198              
199             package Uplug::Config;
200              
201             require 5.004;
202              
203 5     5   29 use strict;
  5         18  
  5         228  
204 5     5   29 use vars qw(@ISA @EXPORT);
  5         9  
  5         321  
205 5     5   26 use vars qw(%NamedIO);
  5         7  
  5         2817  
206              
207 5     5   2382 use FindBin qw/$Bin $Script/;
  5         10  
  5         650  
208             # use File::ShareDir qw/dist_dir/;
209 5     5   23 use Exporter qw/import/;
  5         10  
  5         152  
210 5     5   6794 use Data::Dumper;
  5         69121  
  5         19824  
211              
212             our @EXPORT = qw/FindConfig ReadConfig WriteConfig
213             PrintConfigInfo
214             ListAvailableModules
215             CheckParameter GetNamedIO
216             CheckParam GetParam SetParam
217             find_executable
218             shared_home
219             shared_bin
220             shared_ini
221             shared_lib
222             shared_lang
223             shared_systems/;
224              
225             =head1 Public variables
226              
227             $SHARED_HOME # home of shared files (get with C)
228             $SHARED_BIN # home of binary files (get with C)
229             $SHARED_SYS # home of config-files (get with C)
230             $SHARED_INI # global configuration (get with C)
231             $SHARED_LANG # language-specific files (get with C)
232             $SHARED_LIB # home of external libraries (get with C)
233              
234             $OS_TYPE # type of operating system (uname -s)
235             $MACHINE_TYPE # type of machine architecture (uname -m)
236              
237             C<$SHARED_HOME> is the global directory of shared files for Uplug (if properly installed) or the directory set in the environment variable UPLUGSHARE.
238              
239             If you start a local copy of C (not the globally installed one): Uplug tries to find local directories of shared files ('share') relative to the location of the startup script (C or C) or relative to the environment variable UPLUGHOME (if set). Note that the environment variable UPLUGSHARE overwrites these settings again.
240              
241             =cut
242              
243             # try to find the shared files for Uplug
244             # - the global Uplug shared files dir
245             # - overwrite with UPLUGSHARE (if set in environment)
246             # - take local Uplug 'share' folders if we start a local copy of uplug
247              
248             ## local shared folder
249              
250             my $SHARED_LOCAL_HOME;
251             $SHARED_LOCAL_HOME = $Bin.'/../share' if (-d $Bin.'/../share');
252             $SHARED_LOCAL_HOME = $Bin.'/share' if (-d $Bin.'/share');
253              
254             ## global shared folder
255              
256             my $SHARED_HOME;
257             eval{
258             require File::ShareDir;
259             $SHARED_HOME = File::ShareDir::dist_dir('Uplug');
260             };
261             unless (-d $SHARED_HOME){
262             if ((defined $ENV{UPLUGHOME}) && (-d $ENV{UPLUGHOME}.'/share')){
263             $SHARED_HOME = $ENV{UPLUGHOME}.'/share';
264             }
265             }
266             if ((defined $ENV{UPLUGSHARE}) && (-d $ENV{UPLUGSHARE})){
267             $SHARED_HOME = $ENV{UPLUGSHARE};
268             }
269             $SHARED_HOME = $SHARED_LOCAL_HOME unless (-d $SHARED_HOME);
270              
271              
272              
273             ## other global locations
274              
275             our $SHARED_BIN = $SHARED_HOME . '/bin';
276             our $SHARED_INI = $SHARED_HOME . '/ini';
277             our $SHARED_LANG = $SHARED_HOME . '/lang';
278             our $SHARED_LIB = $SHARED_HOME . '/lib';
279             our $SHARED_SYS = $SHARED_HOME . '/systems';
280              
281             our $OS_TYPE = $ENV{OS_TYPE} || `uname -s`;
282             our $MACHINE_TYPE = $ENV{MACHINE_TYPE} || `uname -m`;
283              
284             chomp($OS_TYPE);
285             chomp($MACHINE_TYPE);
286              
287              
288             ## local files
289              
290             my $SHARED_LOCAL_BIN = $SHARED_LOCAL_HOME . '/bin';
291             my $SHARED_LOCAL_INI = $SHARED_LOCAL_HOME . '/ini';
292             my $SHARED_LOCAL_LANG = $SHARED_LOCAL_HOME . '/lang';
293             my $SHARED_LOCAL_LIB = $SHARED_LOCAL_HOME . '/lib';
294             my $SHARED_LOCAL_SYS = $SHARED_LOCAL_HOME . '/systems';
295              
296              
297             =head1 Pre-defined data streams
298              
299             There are two configuration files that contain information about pre-defined data streams. They are expected to be in C<$SHARED_INI>. These two files are read by default:
300              
301             DataStreams.ini
302             UserDataStreams.ini
303              
304             =cut
305              
306             ## "named" IO streams are stored in %NamedIO
307             ## read them from the files below (in ENV{UPLUGHOME}/ini)
308              
309             &ReadNamed('DataStreams.ini'); # default "IO streams"
310             &ReadNamed('UserDataStreams.ini'); # user "IO streams"
311              
312              
313              
314 0 0   0 0 0 sub shared_home { return defined($_[0]) ? $SHARED_HOME = $_[0] : $SHARED_HOME; }
315 0 0   0 0 0 sub shared_bin { return defined($_[0]) ? $SHARED_BIN = $_[0] : $SHARED_BIN; }
316 0 0   0 0 0 sub shared_ini { return defined($_[0]) ? $SHARED_INI = $_[0] : $SHARED_INI; }
317 0 0   0 0 0 sub shared_lang { return defined($_[0]) ? $SHARED_LANG = $_[0] : $SHARED_LANG; }
318 0 0   0 0 0 sub shared_lib { return defined($_[0]) ? $SHARED_LIB = $_[0] : $SHARED_LIB; }
319 0 0   0 0 0 sub shared_systems{ return defined($_[0]) ? $SHARED_SYS = $_[0] : $SHARED_SYS; }
320              
321             =head1 Functions
322              
323             =head2 C
324              
325             $program_name = 'GIZA++';
326             $program = find_executable( $program_name );
327              
328             Tries to find the executable program on your local system. It first looks in your global path. Thereafter, it checks the shared home of binaries bundled in this package. It uses C<$OS_TYPE> and C<$MACHINE_TYPE> to identify the appropriate binary.
329              
330             =cut
331              
332              
333             sub find_executable{
334 0     0 1 0 my $name = shift;
335              
336             # try to find in the path
337              
338 0         0 my $path = `which $name`;
339 0         0 chomp($path);
340 0 0       0 return $path if (-e $path);
341              
342             # try to find it in the shared tools dir (local and global)
343              
344 0 0       0 return join('/',$SHARED_LOCAL_BIN,$OS_TYPE,$MACHINE_TYPE,$name)
345             if (-e join('/',$SHARED_LOCAL_BIN,$OS_TYPE,$MACHINE_TYPE,$name) );
346 0 0       0 return join('/',$SHARED_LOCAL_BIN,$OS_TYPE,$name)
347             if (-e join('/',$SHARED_LOCAL_BIN,$OS_TYPE,$name) );
348 0 0       0 return $SHARED_LOCAL_BIN.'/'.$name if (-e $SHARED_LOCAL_BIN.'/'.$name);
349              
350 0 0       0 return join('/',$SHARED_BIN,$OS_TYPE,$MACHINE_TYPE,$name)
351             if (-e join('/',$SHARED_BIN,$OS_TYPE,$MACHINE_TYPE,$name) );
352 0 0       0 return join('/',$SHARED_BIN,$OS_TYPE,$name)
353             if (-e join('/',$SHARED_BIN,$OS_TYPE,$name) );
354 0 0       0 return $SHARED_BIN.'/'.$name if (-e $SHARED_BIN.'/'.$name);
355              
356             # try to find it
357              
358 0         0 $path = `find -name '$name' $SHARED_BIN`;
359 0         0 chomp($path);
360 0 0       0 return $path if (-x $path);
361              
362 0         0 return $name;
363             }
364              
365             =head2 C
366              
367             CheckParameter ( $config, $param, $module );
368              
369             Reads configuration for a given module, merges this with the (default) configuration hash in $config and sets additional parameters given in C<$param>. The global configuration of C<$module> overwrites the default configuration of C<$config> and parameters in C overwrite this merged configuration.
370              
371             C<$param> can be a reference to an array (actually containing key-value pairs) or a string of space-separated key-value pairs. These are usually the command-line arguments given when starting a specific module using the Uplug startup scripts. This means that command-line short-cuts as specified in the configuration file will be expanded to set the appropriate key in the deep data structure of the config-hash. (see also C)
372              
373             =cut
374              
375             #------------------------------------------------------------------------
376             # CheckParameter($config,$param,$file)
377             # * config .... pointer to hash with default config
378             # * param ..... command-line parameters (usually a pointer ot an ARRAY)
379             # * file ...... config-file (replaces default config options)
380              
381             sub CheckParameter{
382 0     0 1 0 my ($config,$param,$file)=@_;
383              
384 0 0       0 if (ref($config) ne 'HASH'){$config={};}
  0         0  
385 0         0 my @arg;
386 0 0       0 if (ref($param) eq 'ARRAY'){@arg=@$param;}
  0 0       0  
  0         0  
387             elsif($param=~/\S\s\S/){@arg=split(/\s+/,$param);}
388              
389 0 0       0 if (-e $file){
390 0         0 my $new=&ReadConfig($file);
391 0         0 $config=&MergeConfig($config,$new);
392             }
393 0         0 for (0..$#arg){ # special treatment for the
394 0 0       0 if ($arg[$_] eq '-i'){ # -i argument --> config file
395 0         0 my $new=&ReadConfig($arg[$_+1]);
396 0         0 $config=&MergeConfig($config,$new);
397             }
398             }
399 0         0 &CheckParam($config,@arg);
400              
401 0         0 return $config;
402             }
403              
404              
405             # $config = MergeConfig($config1,$config2)
406             # copy all keys from $config2 to $config1 and return $config1
407              
408             sub MergeConfig{
409 0     0 0 0 my ($conf1,$conf2)=@_;
410 0 0       0 if (ref($conf1) ne 'HASH'){return $conf1;}
  0         0  
411 0 0       0 if (ref($conf2) ne 'HASH'){return $conf1;}
  0         0  
412 0         0 for (keys %{$conf2}){
  0         0  
413 0         0 $conf1->{$_}=$conf2->{$_};
414             }
415 0         0 return $conf1;
416             }
417              
418             =head2 C
419              
420             $file = FindConfig( $module );
421              
422             Look for the physical configuration file for a given module. This function checks C<$SHARED_SYS>, C<$SHARED_INI>, C<$UPLUGHOME>, C<$UPLUGHOME/systems> and C<$UPLUGHOME/ini> in that order.
423              
424             =cut
425              
426             sub FindConfig{
427 5     5 1 26 my $file=shift;
428              
429 5 50       204 return $file if (-f $file);
430              
431             ## take local files first
432              
433 0 0       0 if (-f "$SHARED_LOCAL_SYS/$file"){
    0          
434 0         0 return "$SHARED_LOCAL_SYS/$file";
435             }
436             elsif (-f "$SHARED_LOCAL_INI/$file"){
437 0         0 return "$SHARED_LOCAL_INI/$file";
438             }
439              
440             ## look for global files
441              
442 0 0 0     0 if (-f "$SHARED_SYS/$file"){
    0 0        
    0 0        
    0          
    0          
443 0         0 return "$SHARED_SYS/$file";
444             }
445             elsif (-f "$SHARED_INI/$file"){
446 0         0 return "$SHARED_INI/$file";
447             }
448             elsif ((defined $ENV{UPLUGHOME}) &&
449             (-f "$ENV{UPLUGHOME}/$file")){
450 0         0 return "$ENV{UPLUGHOME}/$file";
451             }
452             elsif ((defined $ENV{UPLUGHOME}) &&
453             (-f "$ENV{UPLUGHOME}/systems/$file")){
454 0         0 return "$ENV{UPLUGHOME}/systems/$file";
455             }
456             elsif ((defined $ENV{UPLUGHOME}) &&
457             (-f "$ENV{UPLUGHOME}/ini/$file")){
458 0         0 return "$ENV{UPLUGHOME}/ini/$file";
459             }
460              
461 0         0 print STDERR "cannot find file '$file'!\n";
462 0         0 return $file;
463             }
464              
465              
466             =head2 C
467              
468             $config = ReadConfig( $module, @params );
469              
470             Read the configuration of a given module, expand 'named data streams' (the ones defined in C and C) and Uplug variables (see below) and set parameters specified in C<@{params}>.
471              
472             =cut
473              
474             #------------------------------------------------------------------------
475             # read configuration files
476             # - essentially this restores a Perl hash from a hash dump
477             # - some variables are expanded before restoring (see ExpandVar)
478             # - "named" IO streams are replaced with their expanded specifications
479             # - command line arguments are expanded and set in the config hash
480              
481              
482             sub ReadConfig{
483 5     5 1 26 my $file=shift;
484 5         28 my @param=@_;
485              
486 5         59 $file = FindConfig($file);
487 5 50       156 warn "# Uplug::Config: config file '$file' not found!\n"
488             unless (-f $file);
489              
490 5   50     387 open F,"<$file" || die "# Uplug::Config: cannot open file '$file'!\n";
491 5         1143 my @lines=;
492 5         249 my $text=join '',@lines;
493 5         59 close F;
494 5         44 $text=&ExpandVar($text);
495 5         7900 my $config=eval $text;
496 5         54 &ExpandNamed($config);
497 5         34 &CheckParam($config,@param);
498 5         119 return $config;
499             }
500              
501             =head2 C
502              
503             WriteConfig( $file, $config )
504              
505             Dump the configuration hash in C<$config> to file C<$file>.
506              
507             =cut
508              
509             #------------------------------------------------------------------------
510             # write configuration file
511             # dump a perl hash into a text file (nothing else)
512              
513             sub WriteConfig{
514 0     0 1 0 my $file=shift;
515 0         0 my $config=shift;
516              
517 0 0       0 if ($file){
518 0   0     0 open F,">$file" || die "# Config: cannot open '$file'!\n";
519             }
520              
521 0         0 $Data::Dumper::Indent=1;
522 0         0 $Data::Dumper::Terse=1;
523 0         0 $Data::Dumper::Purity=1;
524 0 0       0 if ($file){
525 0         0 print F Dumper($config);
526 0         0 close F;
527             }
528             else{
529 0         0 print Dumper($config); # stdout if no file is given
530             }
531             }
532              
533             =head2 C
534              
535             ExpandVar( $config_string );
536              
537             Expand Uplug variables in a given configuration string.
538              
539             $UplugHome - Uplug home directory
540             $UplugLang - default directory for language specific data
541             $UplugSystem - default directory for module configuration files
542             $UplugData - default directory for data files (= ./data)
543             $UplugIni - default directory for initalization files
544             $UplugBin - default directory for Uplug scripts (called by modules)
545              
546             =cut
547              
548             sub ExpandVar{
549 5     5 1 14 my $configtext=shift;
550              
551             # make sure that UPLUGHOME is defined
552 5 50       137 $ENV{UPLUGHOME} = $Bin unless (defined $ENV{UPLUGHOME});
553              
554 5         66 $configtext=~s/\$UplugHome/$ENV{UPLUGHOME}/gs;
555 5         342 $configtext=~s/\$UplugLang/$SHARED_LANG/gs;
556 5 50       54 if (defined $ENV{UPLUGCONFIG}){
557 0         0 $configtext=~s/\$UplugSystem/$ENV{UPLUGCONFIG}/gs;
558             }
559             else{
560 5         45 $configtext=~s/\$UplugSystem/$SHARED_SYS/gs;
561             }
562 5         42 $configtext=~s/\$UplugData/data/gs;
563 5         41 $configtext=~s/\$UplugIni/$SHARED_INI/gs;
564 5         39 $configtext=~s/\$UplugBin/$ENV{UPLUGHOME}\/bin/gs;
565 5         76 return $configtext;
566             }
567              
568             =head2 C
569              
570             ExpandNamed( $config );
571              
572             Expand 'named data streams' in a given configuration hash.
573              
574             =cut
575              
576             #------------------------------------------------------------------------
577             # ExpandNamed .... expand "named" IO streams
578             #
579             # some input/output specifications are stored in ini/DataStreams.ini
580             # this provides a shorthand for some standard I/O
581             # (use attribute 'stream name' to point to one of the defined IO streams)
582             #
583             # ExpandNamed substitutes these shorthands in "input" and "output" in a
584             # module configuration hash with the actual specifications
585             #
586              
587             sub ExpandNamed{
588 5     5 0 14 my $config=shift;
589 5         25 my $input=GetParam($config,'input');
590 5 50       211 if (ref($input) eq 'HASH'){
591 0         0 for my $i (keys %$input){
592 0 0       0 if (ref($input->{$i}) eq 'HASH'){
593 0 0       0 if (exists $input->{$i}->{'stream name'}){
594 0         0 $input->{$i}=&GetNamedIO($input->{$i});
595             }
596             }
597             }
598             }
599 5         18 my $output=GetParam($config,'output');
600 5 50       35 if (ref($output) eq 'HASH'){
601 0         0 for my $i (keys %$output){
602 0 0       0 if (ref($output->{$i}) eq 'HASH'){
603 0 0       0 if (exists $output->{$i}->{'stream name'}){
604 0         0 $output->{$i}=&GetNamedIO($output->{$i});
605             }
606             }
607             }
608             }
609 5         358 return $config;
610             }
611              
612             #------------------------------------------------------------------------
613             # GetNamedIO ... return specifications of a "named" IO stream
614              
615             sub GetNamedIO{
616 0     0 0 0 my $name=shift;
617 0         0 my $spec={};
618 0 0       0 if (ref($name) eq 'HASH'){
619 0         0 $spec=$name;
620 0         0 $name=$name->{'stream name'};
621             }
622 0 0       0 if (exists $NamedIO{$name}){
623 0         0 my $conf=eval $NamedIO{$name};
624 0 0       0 if (ref($conf) eq 'HASH'){
625 0         0 for (keys %$conf){
626 0 0       0 if (exists $spec->{$_}){next;}
  0         0  
627 0         0 $spec->{$_}=$conf->{$_};
628             }
629 0         0 delete $spec->{'stream name'};
630             }
631             }
632 0         0 return $spec;
633             }
634              
635             =head2 C
636              
637             CheckParam( $config, @params );
638              
639             Check command line parameters and modify the config hash according to the given parameters C<@params>. Possible command line arguments are specified in the config hash, in either of the following:
640              
641             { arguments => { shortcuts => { ... } } }
642             { arguments => { optons => { ... } } }
643             { options => { ... } }
644              
645             Example: define an option '-in file-name' for setting the file-name (=file)
646             of the input stream called 'text' with the following code:
647              
648             { 'arguments' => {
649             'shortcuts' => {
650             'in' => 'input:text:file'
651             }
652             }
653              
654             If you use the flag '-in' its argument (e.g. 'my-file.txt') will be moved to
655              
656             { input => { text => { file => my-file.txt } } }
657              
658             in the config hash.
659              
660             =cut
661              
662             sub CheckParam{
663 5     5 1 10 my $config=shift;
664              
665 5 50 33     33 if ((@_ == 1) && ($_[0]=~/\S\s\S/)){ # if next argument is a string with
666 0         0 my @params=split(/\s+/,$_[0]); # spaces: split it into an array
667 0         0 return CheckParam($config,@params); # and try again
668             }
669              
670 5         21 my $flags=GetParam($config,'arguments','shortcuts');
671 5 50       28 if (ref($flags) ne 'HASH'){
672 5         17 $flags=GetParam($config,'arguments','options');
673             }
674 5 50       52 if (ref($flags) ne 'HASH'){
675 5         14 $flags=GetParam($config,'options');
676             }
677             # return if (ref($flags) ne 'HASH');
678 5         24 while (@_){
679 0         0 my $f=shift; # flag name
680 0         0 my @attr=();
681 0 0       0 if ($f=~/^\-/){ # if it is a short-cut flag:
682 0         0 $f=~s/^\-//; # delete leading '-'
683 0 0       0 if (exists $flags->{$f}){
684 0         0 @attr=split(/:/,$flags->{$f});
685             }
686             }
687             else{ # otherwise: long paramter type
688 0         0 @attr=split(/:/,$f);
689             }
690 0         0 my $val=1; # value = 1
691 0 0 0     0 if ((@_) and ($_[0]!~/^\-/)){ # ... or next argument if it exists
692 0         0 $val=shift;
693             }
694 0         0 SetParam($config,$val,@attr); # finally set the parameter!
695             }
696 5         12 return $config;
697             }
698              
699             #------------------------------------------------------------------------
700             # SetParam($config,@attr,$value) ... set a parameter in a config hash
701             #
702             # $config is a pointer to hash
703             # @attr is a sequence of attribute names (refer to nested hash structures)
704             # $value is the value to be set
705              
706             sub SetParam{
707 0     0 0 0 my $config=shift;
708 0         0 my $value=shift; # value
709 0         0 my $attr=pop(@_); # attribute name
710              
711 0 0       0 if (ref($config) ne 'HASH'){$config={};}
  0         0  
712 0         0 foreach (@_){
713 0 0       0 if (ref($config->{$_}) ne 'HASH'){
714 0         0 $config->{$_}={};
715             }
716 0         0 $config=$config->{$_};
717             }
718 0         0 $config->{$attr}=$value;
719             }
720              
721             #------------------------------------------------------------------------
722             # GetParam(config,@attr) ... get the value of a (nested attribute)
723              
724             sub GetParam{
725 25     25 0 37 my $config=shift;
726 25         680 my $attr=pop(@_);
727 25         77 foreach (@_){
728 10 50       39 if (ref($config) eq 'HASH'){
  0         0  
729 10         48 $config=$config->{$_};
730             }
731             else{return undef;}
732             }
733 25         81 return $config->{$attr};
734             }
735              
736              
737             #------------------------------------------------------------------------
738             # ReadNamed .... read pre-defined IO streams from a file and store
739             # the specifications in the global NamedIO hash
740              
741             sub ReadNamed{
742 10     10 0 86 my $file=shift;
743 10 50       251 if (! -f $file){
744 10 50 33     999 if (-f 'ini/'.$file){
    100 33        
    50          
    50          
745 0         0 $file='ini/'.$file;
746             }
747             elsif (-f $SHARED_HOME.'/ini/'.$file){
748 5         37 $file=$SHARED_HOME.'/ini/'.$file;
749             }
750             elsif ((defined $ENV{UPLUGHOME}) && (-f $ENV{UPLUGHOME}.'/'.$file)){
751 0         0 $file=$ENV{UPLUGHOME}.'/'.$file;
752             }
753             elsif ((defined $ENV{UPLUGHOME}) && (-f $ENV{UPLUGHOME}.'/ini/'.$file)){
754 0         0 $file=$ENV{UPLUGHOME}.'/ini/'.$file
755             }
756             }
757 10 100       351 if (! -f $file){return 0;}
  5         13  
758 5         62 my $config=&ReadConfig($file);
759 5 50       26 if (ref($config) eq 'HASH'){
760 5         37 $Data::Dumper::Indent=1;
761 5         35 $Data::Dumper::Terse=1;
762 5         23 $Data::Dumper::Purity=1;
763 5         47 for (keys %$config){
764 230         19577 $NamedIO{$_}=Dumper($config->{$_});
765             }
766             }
767 5         494 return 1;
768             }
769              
770             =head2 C
771              
772             ListAvailableModules( 'category' )
773              
774             List all available modules within a specific module category. List all modules if no category is given.
775              
776             =cut
777              
778              
779             sub ListAvailableModules{
780 0   0 0 1   my $dir = shift || $SHARED_SYS;
781 0 0         unless (-d $dir){
782 0           $dir = $SHARED_SYS.'/'.$dir;
783             }
784 0           system("find $dir -type f | sed 's#^$dir/##' | sort");
785             }
786              
787             =head2 C
788              
789             PrintConfigInfo( $module );
790              
791             Print information about a given module (taken from its configuration file).
792              
793             =cut
794              
795             sub PrintConfigInfo{
796 0     0 1   my $config = &ReadConfig(@_);
797 0 0         return 0 unless (ref($config) eq 'HASH');
798 0 0         if (ref($$config{module}) eq 'HASH'){
799 0           print "Module Name: ",$$config{module}{name},"\n\n";
800             }
801 0           print $$config{description},"\n\n";
802 0 0         if (ref($$config{arguments}) eq 'HASH'){
803 0 0         if (ref($$config{arguments}{shortcuts}) eq 'HASH'){
804 0           print "Command-line arguments:\n\n";
805 0           foreach (sort keys %{$$config{arguments}{shortcuts}}){
  0            
806 0           printf " -%-10s %s\n",$_,$$config{arguments}{shortcuts}{$_};
807             }
808             }
809             }
810 0 0         if (ref($$config{module}) eq 'HASH'){
811 0 0         if (ref($$config{module}{submodules}) eq 'ARRAY'){
812 0           print "\nSub-modules:\n\n";
813 0           foreach (@{$$config{module}{submodules}}){
  0            
814 0           printf " %s\n",$_;
815             }
816             }
817             }
818              
819 0 0         if (ref($$config{input}) eq 'HASH'){
820 0           print "\nINPUT:\n";
821 0           foreach (sort keys %{$$config{input}}){
  0            
822 0           printf " %-20s format: %s\n",$_,$$config{input}{$_}{format};
823             }
824             }
825 0 0         if (ref($$config{output}) eq 'HASH'){
826 0           print "\nOUTPUT:\n";
827 0           foreach (sort keys %{$$config{output}}){
  0            
828 0           printf " %-20s format: %s\n",$_,$$config{output}{$_}{format};
829             }
830             }
831              
832              
833 0 0         if (ref($$config{module}) eq 'HASH'){
834 0           print "\n";
835 0 0         if (exists $$config{module}{stdin}){
836 0           print "Can read from STDIN (input:$$config{module}{stdin})\n";
837             }
838 0 0         if (exists $$config{module}{stdout}){
839 0           print "May write to STDOUT (output:$$config{module}{stdout})\n";
840             }
841             }
842 0           print "\nMore details? Print the config file with\n";
843 0           print " uplug -p $_[0]\n";
844             }
845              
846              
847              
848              
849             ## return a true value
850              
851             1;
852              
853              
854             __END__