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
# printenv(shell) : output environment to stdout in shell format
# getvalue(var) : return a string - modified by type for the var specified

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 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}}(@vals);
        }
        else {
           $string=$vals[0];
        }
        return $string;
}

# ---- 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;
}

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.1.2.6
Committed:	Wed Apr 12 15:55:05 2000 UTC (25 years, 1 month ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
CVS Tags:	V0_16_4, V0_16_3, V0_16_2, V0_16_1, V0_16_0, V0_15_1, V0_15_0, V0_15_0beta, V0_14_0, V0_12_12_4, V0_12_12_3, V0_12_12_2, V0_12_12_1, V0_12_12_0, PlayGround_0, V0_13_0, V0_12_12, V0_12_11, V0_12_9b, V0_12_10, V0_12_9, V0_12_8, V0_12_7, V0_12_6, V0_12_5, V0_12_4, V0_12_3, V0_12_2, V0_12_1, V0_12_0, V0_11_4, V0_11_3, V0_11_2
Branch point for:	V0_16branch, V0_15branch, HPWbranch
Changes since 1.1.2.5:	+28 -1 lines
Log Message:	Allow variable expansion - in terms of Environment variables
#	User	Rev	Content
1	williamc	1.1.2.1	#
2			# Runtime.pm
3			#
4	williamc	1.1.2.2	# Written by Christopher Williams
5	williamc	1.1.2.1	#
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	williamc	1.1.2.2	# doc(var) : Print out any documentation for the runtime env
15			# list() : return a list of all variables set
16			# printenv(shell) : output environment to stdout in shell format
17			# getvalue(var) : return a string - modified by type for the var specified
18	williamc	1.1.2.1
19			package Runtime;
20			require 5.004;
21	williamc	1.1.2.4	use ActiveDoc::SimpleDoc;
22	williamc	1.1.2.1
23			sub new {
24			my $class=shift;
25			$self={};
26	williamc	1.1.2.2	$self->{Arch}=1;
27	williamc	1.1.2.3	$self->{validtypes}={ 'path'=>1 };
28	williamc	1.1.2.2	push @{$self->{ARCHBLOCK}}, $self->{Arch};
29	williamc	1.1.2.1	bless $self, $class;
30			return $self;
31			}
32
33			sub file {
34			my $self=shift;
35			my $filename=shift;
36	williamc	1.1.2.2	$self->_parsefile($filename);
37			}
38
39			sub printenv {
40			my $self=shift;
41			my $shell=shift;
42
43			foreach $var ( @{$self->{'varlist'}} ) {
44	williamc	1.1.2.6	$self->_printoutenv($shell,$var,
45			$self->_expandvar($self->getvalue($var)));
46	williamc	1.1.2.2	}
47			}
48
49			sub list {
50			my $self=shift;
51			return @{$self->{'varlist'}};
52			}
53
54			sub doc {
55			my $self=shift;
56			my $var=shift;
57			return $self->{vardoc}{$var};
58			}
59
60			sub getvalue {
61			my $self=shift;
62			my $name=shift;
63
64			my $string;
65			my @vals=@{$self->{vars}{$name}};
66	williamc	1.1.2.1
67	williamc	1.1.2.2	if ( defined $self->{'vartype'}{$name} ) { #any type proceesing
68			$string=&{"_".$self->{'vartype'}{$name}}(@vals);
69			}
70			else {
71			$string=$vals[0];
72	williamc	1.1.2.1	}
73	williamc	1.1.2.2	return $string;
74	williamc	1.1.2.1	}
75
76	williamc	1.1.2.2	# ---- Support Routines
77	williamc	1.1.2.6	sub _expandvar {
78			my $self=shift;
79			my $string=shift;
80
81			return "" , if ( ! defined $string );
82			$string=~s{
83			\$\((\w+)\)
84			}{
85			if (defined $ENV{$1}) {
86			$self->_expandvar($ENV{$1});
87			} else {
88			"\$".$1;
89			}
90			}egx;
91			$string=~s{
92			\$(\w+)
93			}{
94			if (defined $ENV{$1}) {
95			$self->_expandvar($ENV{$1});
96			} else {
97			"\$".$1;
98			}
99			}egx;
100			return $string;
101			}
102
103	williamc	1.1.2.2	sub _path {
104	williamc	1.1.2.1	my $self=shift;
105	williamc	1.1.2.2	my @vals=@_;
106
107			@vals=$self->_removedoubles(@vals);
108			my $string=join ":", @vals;
109			return $string;
110	williamc	1.1.2.1	}
111
112	williamc	1.1.2.2	sub _parsefile {
113	williamc	1.1.2.1	my $self=shift;
114	williamc	1.1.2.2	my $filename=shift;
115
116	williamc	1.1.2.4	$self->{switch}=ActiveDoc::SimpleDoc->new();
117			$self->{switch}->newparse("runtime");
118			$self->{switch}->addignoretags("runtime");
119			$self->{switch}->filetoparse($filename);
120			$self->{switch}->addtag("runtime","Runtime",
121			\&Runtime_start, $self,
122			\&Runtime_text, $self,
123			\&Runtime_end, $self);
124			$self->{switch}->addtag("runtime","Architecture",
125			\&Arch_Start, $self, "",$self, \&Arch_End, $self);
126	williamc	1.1.2.2	$self->{Runtimecontext}=0;
127	williamc	1.1.2.4	$self->{switch}->parse("runtime");
128	williamc	1.1.2.2	}
129
130			sub _printoutenv {
131			my $self=shift;
132			my $shell=shift;
133			my $variable=shift;
134			my $value=shift;
135
136			if ( $shell eq "csh" ) {
137			print "setenv $variable \"$value\";\n";
138			}
139			elsif ( $shell eq "sh" ) {
140			print "$variable=\"$value\";\n";
141			print "export $variable;\n";
142			}
143			}
144
145			# ------ Tag Routines
146
147			sub Runtime_start {
148	williamc	1.1.2.4	my $self=shift;
149	williamc	1.1.2.2	my $name=shift;
150	williamc	1.1.2.4	my $hashref=shift;
151	williamc	1.1.2.2
152	williamc	1.1.2.4	$self->{switch}->checktag($name,$hashref,'name');
153			$self->{switch}->checktag($name,$hashref,'value');
154	williamc	1.1.2.2	if ( $self->{Arch} ) {
155			if ( $self->{Runtimecontext} == 1 ) {
156	williamc	1.1.2.5	$self->{switch}->parseerror("No </$name> before new tag");
157	williamc	1.1.2.2	}
158			$self->{Runtimecontext}=1;
159
160			push @{$self->{'varlist'}}, $$hashref{'name'};
161			push @{$self->{'vars'}{$$hashref{'name'}}}, $$hashref{'value'};
162			if ( defined $$hashref{'type'} ) {
163			if ( ( exists $self->{'vartype'}{$$hashref{'name'}} ) &&
164			( $self->{'vartype'}{$$hashref{'name'}} ne $$hashref{'type'}) ){
165	williamc	1.1.2.5	$self->{switch}->parseerror("Redefinition of Variable".
166			" type for ".$$hashref{'name'});
167	williamc	1.1.2.2	}
168			$self->{'vartype'}{$$hashref{'name'}}=$$hashref{'type'};
169			if ( defined $self->{validtypes}{$$hashref{'type'}} ) {
170	williamc	1.1.2.5	$self->{switch}->parseerror(
171			"Unknown type ".$$hashref{'type'});
172	williamc	1.1.2.2	}
173			}
174			else {
175			$self->{'vartype'}{$$hashref{'name'}}=undef;
176			}
177			}
178			}
179
180			sub Runtime_text {
181	williamc	1.1.2.4	my $self=shift;
182	williamc	1.1.2.2	my $name=shift;
183			my @vars=@_;
184
185			if ( $self->{Arch} ) {
186			my $var=$self->{varlist}[$#{$self->{varlist}}];
187			$self->{'vardoc'}{$var}=$self->{'vardoc'}{$var}.
188			(join "", @vars);
189			}
190			}
191
192			sub Runtime_end {
193	williamc	1.1.2.4	my $self=shift;
194	williamc	1.1.2.2	my $name=shift;
195			if ( $self->{Arch} ) {
196			$self->{Runtimecontext}=0;
197			}
198	williamc	1.1.2.1	}
199	williamc	1.1.2.4
200			sub Arch_Start {
201			my $self=shift;
202			my $name=shift;
203			my $hashref=shift;
204
205			$toolswitch->checktag($name, $hashref,'name');
206			( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
207			: ($self->{Arch}=0);
208			push @{$self->{ARCHBLOCK}}, $self->{Arch};
209			}
210
211			sub Arch_End {
212			my $self=shift;
213			my $name=shift;
214
215			pop @{$self->{ARCHBLOCK}};
216			$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
217			}
218