SCRAM/src/Runtime.pm

#
# Runtime.pm
#
# Written by Christopher Williams
#
# Description
# -----------
# Prepare a runtime environment
#
# Interface
# ---------
# new()         : A new Runtime object
# file(file)    : Specify an environment description file
# doc(var)      : Print out any documentation for the runtime env
# list()        : return a list of all variables set
# sethash(hashref) : Set the environment in the hash provided
# printenv(shell) : output environment to stdout in shell format
# getvalue(var) : return a string - modified by type for the var specified
# addvar(name,value[,type]) : add a variable - if necessary specify a type
# unshiftvar(name,value{,type]) : unshift a variable 

package Runtime;
require 5.004;
use ActiveDoc::SimpleDoc;

sub new {
        my $class=shift;
        $self={};
        $self->{Arch}=1;
        $self->{validtypes}={ 'path'=>1 };
        push @{$self->{ARCHBLOCK}}, $self->{Arch};
        bless $self, $class;
        return $self;
}

sub file {
        my $self=shift;
        my $filename=shift;
        $self->_parsefile($filename);
}

sub sethash {
        my $self=shift;
        my $hashref=shift;

        foreach $var ( @{$self->{'varlist'}} ) {
          $$hashref{$var}=$self->_expandvar($self->getvalue($var));
        }
}

sub printenv {
        my $self=shift;
        my $shell=shift; 

        foreach $var ( @{$self->{'varlist'}} ) {
          $self->_printoutenv($shell,$var,
                $self->_expandvar($self->getvalue($var)));
        } 
}

sub list {
        my $self=shift;
        return @{$self->{'varlist'}};
}

sub doc {
        my $self=shift;
        my $var=shift;
        return $self->{vardoc}{$var};
}

sub getvalue {
        my $self=shift;
        my $name=shift;

        my $string;
        my @vals=@{$self->{vars}{$name}};
        
        if ( defined $self->{'vartype'}{$name} ) { #any type proceesing
           $string=&{"_".$self->{'vartype'}{$name}}($self,@vals);
        }
        else {
           $string=$vals[0];
        }
        return $string;
}

sub addvar {
        my $self=shift;
        my $name=shift;
        my $val=shift;

        push @{$self->{'varlist'}}, $name;
        push @{$self->{'vars'}{$name}}, $val;
        if ( @_ ) {
          $self->{'vartype'}{$name}=shift;;
        }
        else {
          $self->{'vartype'}{$name}=undef;
        }
}

sub unshiftvar {
        my $self=shift;
        my $name=shift;
        my $val=shift;

        if ( exists $self->{'vars'}{$name} ) {
          unshift @{$self->{'vars'}{$name}}, $val;
        }
        else {
          $self->addvar($name,$val,@_);
        }
}

# ---- Support Routines
sub _expandvar {
        my $self=shift;
        my $string=shift;

        return "" , if ( ! defined $string );
         $string=~s{
                \$\((\w+)\)
        }{
          if (defined $ENV{$1}) {
                $self->_expandvar($ENV{$1});
          } else {
                "\$".$1;
          }
        }egx;
         $string=~s{
                \$(\w+)
        }{
          if (defined $ENV{$1}) {
                $self->_expandvar($ENV{$1});
          } else {
                "\$".$1;
          }
        }egx;
        return $string;
}

sub _path {
        my $self=shift;
        my @vals=@_;

        @vals=$self->_removedoubles(@vals);
        my $string=join ":", @vals;
        return $string;
}

#
# removes doubles and whitespace
#
sub _removedoubles {
        my $self=shift;
        my @red=();

        foreach $elem ( @_ ) {
          $elem=~s/^\s+//; # chop leading whitespace
          if ( (! grep { $_ eq $elem } @red ) && ( $elem ne "")) { 
               push @red,$elem;
          }
        }
        return @red;
}

sub _parsefile {
        my $self=shift;
        my $filename=shift;

        $self->{switch}=ActiveDoc::SimpleDoc->new();
        $self->{switch}->newparse("runtime");
        $self->{switch}->addignoretags("runtime");
        $self->{switch}->filetoparse($filename);
        $self->{switch}->addtag("runtime","Runtime",
             \&Runtime_start, $self,
             \&Runtime_text, $self,
             \&Runtime_end, $self);
        $self->{switch}->addtag("runtime","Architecture",
             \&Arch_Start, $self, "",$self, \&Arch_End, $self);
        $self->{Runtimecontext}=0;
        $self->{switch}->parse("runtime");
}

sub _printoutenv {
        my $self=shift;
        my $shell=shift;
        my $variable=shift;
        my $value=shift;

        if ( $shell eq "csh" ) {
          print "setenv $variable \"$value\";\n";
        }
        elsif ( $shell eq "sh" ) {
          print "$variable=\"$value\";\n";
          print "export $variable;\n";
        }
}

# ------ Tag Routines 

sub Runtime_start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->checktag($name,$hashref,'name');
        $self->{switch}->checktag($name,$hashref,'value');
        if ( $self->{Arch} ) {
          if ( $self->{Runtimecontext} == 1 ) {
           $self->{switch}->parseerror("No </$name> before new tag"); 
          }
          $self->{Runtimecontext}=1;

          push @{$self->{'varlist'}}, $$hashref{'name'};
          push @{$self->{'vars'}{$$hashref{'name'}}}, $$hashref{'value'};
          if ( defined $$hashref{'type'} ) {
             if ( ( exists $self->{'vartype'}{$$hashref{'name'}} ) &&
                ( $self->{'vartype'}{$$hashref{'name'}} ne $$hashref{'type'}) ){
                   $self->{switch}->parseerror("Redefinition of Variable".
                        " type for ".$$hashref{'name'});
             }
             $self->{'vartype'}{$$hashref{'name'}}=$$hashref{'type'};
             if ( ! defined $self->{validtypes}{$$hashref{'type'}} ) {
                $self->{switch}->parseerror(
                     "Unknown type ".$$hashref{'type'});
             }
          }
          else {
             $self->{'vartype'}{$$hashref{'name'}}=undef;
          }
        }
}

sub Runtime_text {
        my $self=shift;
        my $name=shift;
        my @vars=@_;

        if ( $self->{Arch} ) {
            my $var=$self->{varlist}[$#{$self->{varlist}}];
            $self->{'vardoc'}{$var}=$self->{'vardoc'}{$var}.
                         (join "", @vars);
        }
}

sub Runtime_end {
        my $self=shift;
        my $name=shift;
        if ( $self->{Arch} ) {
           $self->{Runtimecontext}=0;
        }
}

sub Arch_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $toolswitch->checktag($name, $hashref,'name');
        ( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1) 
                                                : ($self->{Arch}=0);
        push @{$self->{ARCHBLOCK}}, $self->{Arch};
}

sub Arch_End {
        my $self=shift;
        my $name=shift;

        pop @{$self->{ARCHBLOCK}};
        $self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
}

Revision:	1.4
Committed:	Mon Oct 1 16:11:06 2001 UTC (23 years, 7 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	SCRAM_V1, SCRAMV1_IMPORT, V0_19_7, V0_19_6, V0_19_6p1, V0_19_5, SFATEST, V0_19_4, V0_19_4_pre3, V0_19_4_pre2, V0_19_4_pre1, V0_19_3, V0_19_2, V0_19_1
Branch point for:	SCRAM_V1_BRANCH, V0_19_4_B
Changes since 1.3:	+1 -1 lines
Log Message:	Committing some changes.
#	User	Rev	Content
1	williamc	1.2	#
2			# Runtime.pm
3			#
4			# Written by Christopher Williams
5			#
6			# Description
7			# -----------
8			# Prepare a runtime environment
9			#
10			# Interface
11			# ---------
12			# new() : A new Runtime object
13			# file(file) : Specify an environment description file
14			# doc(var) : Print out any documentation for the runtime env
15			# list() : return a list of all variables set
16	williamc	1.3	# sethash(hashref) : Set the environment in the hash provided
17	williamc	1.2	# printenv(shell) : output environment to stdout in shell format
18			# getvalue(var) : return a string - modified by type for the var specified
19	williamc	1.3	# addvar(name,value[,type]) : add a variable - if necessary specify a type
20			# unshiftvar(name,value{,type]) : unshift a variable
21	williamc	1.2
22			package Runtime;
23			require 5.004;
24			use ActiveDoc::SimpleDoc;
25
26			sub new {
27			my $class=shift;
28			$self={};
29			$self->{Arch}=1;
30			$self->{validtypes}={ 'path'=>1 };
31			push @{$self->{ARCHBLOCK}}, $self->{Arch};
32			bless $self, $class;
33			return $self;
34			}
35
36			sub file {
37			my $self=shift;
38			my $filename=shift;
39			$self->_parsefile($filename);
40			}
41
42	williamc	1.3	sub sethash {
43			my $self=shift;
44			my $hashref=shift;
45
46			foreach $var ( @{$self->{'varlist'}} ) {
47			$$hashref{$var}=$self->_expandvar($self->getvalue($var));
48			}
49			}
50
51	williamc	1.2	sub printenv {
52			my $self=shift;
53			my $shell=shift;
54
55			foreach $var ( @{$self->{'varlist'}} ) {
56			$self->_printoutenv($shell,$var,
57			$self->_expandvar($self->getvalue($var)));
58			}
59			}
60
61			sub list {
62			my $self=shift;
63			return @{$self->{'varlist'}};
64			}
65
66			sub doc {
67			my $self=shift;
68			my $var=shift;
69			return $self->{vardoc}{$var};
70			}
71
72			sub getvalue {
73			my $self=shift;
74			my $name=shift;
75
76			my $string;
77			my @vals=@{$self->{vars}{$name}};
78
79			if ( defined $self->{'vartype'}{$name} ) { #any type proceesing
80	williamc	1.3	$string=&{"_".$self->{'vartype'}{$name}}($self,@vals);
81	williamc	1.2	}
82			else {
83			$string=$vals[0];
84			}
85			return $string;
86			}
87
88	williamc	1.3	sub addvar {
89			my $self=shift;
90			my $name=shift;
91			my $val=shift;
92
93			push @{$self->{'varlist'}}, $name;
94			push @{$self->{'vars'}{$name}}, $val;
95			if ( @_ ) {
96			$self->{'vartype'}{$name}=shift;;
97			}
98			else {
99			$self->{'vartype'}{$name}=undef;
100			}
101			}
102
103			sub unshiftvar {
104			my $self=shift;
105			my $name=shift;
106			my $val=shift;
107
108			if ( exists $self->{'vars'}{$name} ) {
109			unshift @{$self->{'vars'}{$name}}, $val;
110			}
111			else {
112			$self->addvar($name,$val,@_);
113			}
114			}
115
116	williamc	1.2	# ---- Support Routines
117			sub _expandvar {
118			my $self=shift;
119			my $string=shift;
120
121			return "" , if ( ! defined $string );
122			$string=~s{
123			\$\((\w+)\)
124			}{
125			if (defined $ENV{$1}) {
126			$self->_expandvar($ENV{$1});
127			} else {
128			"\$".$1;
129			}
130			}egx;
131			$string=~s{
132			\$(\w+)
133			}{
134			if (defined $ENV{$1}) {
135			$self->_expandvar($ENV{$1});
136			} else {
137			"\$".$1;
138			}
139			}egx;
140			return $string;
141			}
142
143			sub _path {
144			my $self=shift;
145			my @vals=@_;
146
147			@vals=$self->_removedoubles(@vals);
148			my $string=join ":", @vals;
149			return $string;
150	williamc	1.3	}
151
152			#
153			# removes doubles and whitespace
154			#
155			sub _removedoubles {
156			my $self=shift;
157			my @red=();
158
159			foreach $elem ( @_ ) {
160			$elem=~s/^\s+//; # chop leading whitespace
161			if ( (! grep { $_ eq $elem } @red ) && ( $elem ne "")) {
162			push @red,$elem;
163			}
164			}
165			return @red;
166	williamc	1.2	}
167
168			sub _parsefile {
169			my $self=shift;
170			my $filename=shift;
171
172			$self->{switch}=ActiveDoc::SimpleDoc->new();
173			$self->{switch}->newparse("runtime");
174			$self->{switch}->addignoretags("runtime");
175			$self->{switch}->filetoparse($filename);
176			$self->{switch}->addtag("runtime","Runtime",
177			\&Runtime_start, $self,
178			\&Runtime_text, $self,
179			\&Runtime_end, $self);
180			$self->{switch}->addtag("runtime","Architecture",
181			\&Arch_Start, $self, "",$self, \&Arch_End, $self);
182			$self->{Runtimecontext}=0;
183			$self->{switch}->parse("runtime");
184			}
185
186			sub _printoutenv {
187			my $self=shift;
188			my $shell=shift;
189			my $variable=shift;
190			my $value=shift;
191
192			if ( $shell eq "csh" ) {
193			print "setenv $variable \"$value\";\n";
194			}
195			elsif ( $shell eq "sh" ) {
196			print "$variable=\"$value\";\n";
197			print "export $variable;\n";
198			}
199			}
200
201			# ------ Tag Routines
202
203			sub Runtime_start {
204			my $self=shift;
205			my $name=shift;
206			my $hashref=shift;
207
208			$self->{switch}->checktag($name,$hashref,'name');
209			$self->{switch}->checktag($name,$hashref,'value');
210			if ( $self->{Arch} ) {
211			if ( $self->{Runtimecontext} == 1 ) {
212			$self->{switch}->parseerror("No </$name> before new tag");
213			}
214			$self->{Runtimecontext}=1;
215
216			push @{$self->{'varlist'}}, $$hashref{'name'};
217			push @{$self->{'vars'}{$$hashref{'name'}}}, $$hashref{'value'};
218			if ( defined $$hashref{'type'} ) {
219			if ( ( exists $self->{'vartype'}{$$hashref{'name'}} ) &&
220			( $self->{'vartype'}{$$hashref{'name'}} ne $$hashref{'type'}) ){
221			$self->{switch}->parseerror("Redefinition of Variable".
222			" type for ".$$hashref{'name'});
223			}
224			$self->{'vartype'}{$$hashref{'name'}}=$$hashref{'type'};
225	sashby	1.4	if ( ! defined $self->{validtypes}{$$hashref{'type'}} ) {
226	williamc	1.2	$self->{switch}->parseerror(
227			"Unknown type ".$$hashref{'type'});
228			}
229			}
230			else {
231			$self->{'vartype'}{$$hashref{'name'}}=undef;
232			}
233			}
234			}
235
236			sub Runtime_text {
237			my $self=shift;
238			my $name=shift;
239			my @vars=@_;
240
241			if ( $self->{Arch} ) {
242			my $var=$self->{varlist}[$#{$self->{varlist}}];
243			$self->{'vardoc'}{$var}=$self->{'vardoc'}{$var}.
244			(join "", @vars);
245			}
246			}
247
248			sub Runtime_end {
249			my $self=shift;
250			my $name=shift;
251			if ( $self->{Arch} ) {
252			$self->{Runtimecontext}=0;
253			}
254			}
255
256			sub Arch_Start {
257			my $self=shift;
258			my $name=shift;
259			my $hashref=shift;
260
261			$toolswitch->checktag($name, $hashref,'name');
262			( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
263			: ($self->{Arch}=0);
264			push @{$self->{ARCHBLOCK}}, $self->{Arch};
265			}
266
267			sub Arch_End {
268			my $self=shift;
269			my $name=shift;
270
271			pop @{$self->{ARCHBLOCK}};
272			$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
273			}
274