ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/RuntimeFile.pm
Revision: 1.4
Committed: Fri Dec 14 09:03:42 2007 UTC (17 years, 4 months ago) by muzaffar
Content type: text/plain
Branch: MAIN
CVS Tags: V1_1_7, V1_1_6, V1_1_5, V1_1_4, V1_1_3, V1_1_2, V1_1_0_reltag8, V1_1_0_reltag7, V1_1_0_reltag6, V1_1_1, V1_1_0_reltag5, V1_1_0_reltag4, V1_1_0_reltag3, V1_1_0_reltag2, V1_1_0_reltag1, V1_1_0_reltag, V1_1_0_cand3, V1_1_0_cand2, V1_1_0_cand1
Changes since 1.3: +1 -1 lines
Log Message:
replace head with xml branch

File Contents

# User Rev Content
1 sashby 1.2 #____________________________________________________________________
2     # File: RuntimeFile.pm
3     #____________________________________________________________________
4     #
5     # Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6     # Update: 2004-05-19 15:40:10+0200
7 muzaffar 1.4 # Revision: $Id: RuntimeFile.pm,v 1.2.4.1 2007/11/08 15:25:25 muzaffar Exp $
8 sashby 1.2 #
9     # Copyright: 2004 (C) Shaun Ashby
10     #
11     #--------------------------------------------------------------------
12     package RuntimeFile;
13     require 5.004;
14     use ActiveDoc::SimpleDoc;
15     use Exporter;
16     @ISA=qw(Exporter);
17     @EXPORT_OK=qw( );
18    
19     sub new()
20     ###############################################################
21     # new() #
22     ###############################################################
23     # modified : Wed May 19 15:40:33 2004 / SFA #
24     # params : #
25     # : #
26     # function : #
27     # : #
28     ###############################################################
29     {
30     my $proto=shift;
31     my $class=ref($proto) || $proto;
32     my $self={};
33    
34     $self->{runtimefile} = shift;
35     $self->{content} = {};
36     $self->{varstore} = {};
37     $self->{thisrtinfo} = [];
38    
39     bless $self,$class;
40     return $self;
41     }
42    
43     sub read()
44     {
45     my $self=shift;
46     use Cwd;
47    
48     # Check to see that the rt file exists:
49     if ( ! -f cwd()."/".$self->{runtimefile} )
50     {
51     $::scram->scramfatal("Runtime file \"".$self->{runtimefile}."\" does not exist or is not readable!.");
52     }
53     else
54     {
55     print "Reading RT environment from file ",$self->{runtimefile},"\n", if ($ENV{SCRAM_DEBUG});
56     }
57    
58     # A new SimpleDoc object to parse the file:
59     $self->{simpledoc} = ActiveDoc::SimpleDoc->new();
60    
61     $self->{simpledoc}->newparse("RUNTIME");
62     $self->{simpledoc}->filetoparse($self->{runtimefile});
63     $self->{simpledoc}->addtag("RUNTIME","Runtime",
64     \&runtimetagOpen, $self,
65     \&runtimetagInfo, $self,
66     \&runtimetagClose, $self);
67    
68     # Parse the file:
69 muzaffar 1.3 my $fhead='<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="RuntimeFile" version="1.0">';
70     my $ftail='</doc>';
71     $self->{simpledoc}->parse("RUNTIME",$fhead,$ftail);
72 sashby 1.2 delete $self->{simpledoc};
73     }
74    
75     sub content()
76     {
77     my $self = shift;
78     return $self->{content};
79     }
80    
81     sub info()
82     {
83     my $self=shift;
84     my ($rtname) = @_;
85    
86     if (exists ($self->{content}->{$rtname}))
87     {
88     if (exists ($self->{content}->{$rtname}->{'info'}))
89     {
90     print $rtname,":\n";
91     foreach my $iline (@{$self->{content}->{$rtname}->{'info'}})
92     {
93     print $iline,"\n";
94     }
95     }
96     else
97     {
98     print "No description for runtime variable \"",$rtname,"\" in file ".$self->{runtimefile}."!\n";
99     }
100     }
101     else
102     {
103     $::scram->scramerror("Runtime variable ".$rtname." is not defined in ".$self->{runtimefile}."!");
104     exit(1);
105     }
106     }
107    
108     sub runtimetagOpen()
109     {
110     my ($self, $name, $hashref) = @_;
111     $self->{simpledoc}->checktag($name, $hashref, "name");
112     $self->{thisrtname} = $hashref->{'name'};
113    
114     # Check for values (as value or default):
115     foreach my $t (qw(value)) # Only support "value"
116     {
117     if (exists ($hashref->{$t}))
118     {
119     # Try to expand the value:
120     my $thisvalue = $self->_expandvars($self->{varstore},$hashref->{$t});
121     # There were no dollar signs so we can assume
122     # that everything was evaluated properly:
123     if ($thisvalue !~ /\$/)
124     {
125     $self->{varstore}->{$hashref->{'name'}} = $thisvalue;
126     $self->{content}->{$hashref->{'name'}} = { value => $thisvalue };
127     }
128     }
129     }
130     }
131    
132     sub runtimetagInfo()
133     {
134     my ($self, $name, @infotext) = @_;
135     push(@{$self->{thisrtinfo}},@infotext);
136     }
137    
138     sub runtimetagClose()
139     {
140     my ($self, $name, $hashref) = @_;
141     $self->{content}->{$self->{thisrtname}}->{'info'} = $self->{thisrtinfo};
142     delete $self->{thisrtname};
143     $self->{thisrtinfo} = [];
144     }
145    
146     sub _expandvars
147     {
148     my $self=shift;
149     # $dataenvref is the store of tags already parsed (e.g., X_BASE, LIBDIR etc.):
150     my ($dataenvref,$string) = @_;
151    
152     return "" , if ( ! defined $string );
153     # To evaluate variables in brackets, like $(X):
154     $string =~ s{\$\((\w+)\)}
155     {
156     if (defined $dataenvref->{$1})
157     {
158     $self->_expandvars($dataenvref, $dataenvref->{$1});
159     }
160     elsif (defined $ENV{$1})
161     {
162     $self->_expandvars($dataenvref, $ENV{$1});
163     }
164     else
165     {
166     "\$$1";
167     }
168     }egx;
169    
170     # To evaluate variables like $X:
171     $string =~ s{\$(\w+)}
172     {
173     if (defined $dataenvref->{$1})
174     {
175     $self->_expandvars($dataenvref, $dataenvref->{$1});
176     }
177     elsif (defined $ENV{$1})
178     {
179     $self->_expandvars($dataenvref, $ENV{$1});
180     }
181     else
182     {
183     "\$$1";
184     }
185     }egx;
186    
187     # Now return false if the string wasn't properly evaluated (i.e. some $ remain), otherwise
188     # return the expanded string:
189     ($string =~ /\$/) ? return undef : return $string;
190    
191     }
192    
193     1;