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->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 _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.5
Committed:	Fri Apr 7 13:34:52 2000 UTC (25 years, 1 month ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
CVS Tags:	V0_11_1, V0_11_0
Changes since 1.1.2.4:	+5 -8 lines
Log Message:	update error messages to parserror
#	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			$self->_printoutenv($shell,$var,$self->getvalue($var));
45			}
46			}
47
48			sub list {
49			my $self=shift;
50			return @{$self->{'varlist'}};
51			}
52
53			sub doc {
54			my $self=shift;
55			my $var=shift;
56			return $self->{vardoc}{$var};
57			}
58
59			sub getvalue {
60			my $self=shift;
61			my $name=shift;
62
63			my $string;
64			my @vals=@{$self->{vars}{$name}};
65	williamc	1.1.2.1
66	williamc	1.1.2.2	if ( defined $self->{'vartype'}{$name} ) { #any type proceesing
67			$string=&{"_".$self->{'vartype'}{$name}}(@vals);
68			}
69			else {
70			$string=$vals[0];
71	williamc	1.1.2.1	}
72	williamc	1.1.2.2	return $string;
73	williamc	1.1.2.1	}
74
75	williamc	1.1.2.2	# ---- Support Routines
76			sub _path {
77	williamc	1.1.2.1	my $self=shift;
78	williamc	1.1.2.2	my @vals=@_;
79
80			@vals=$self->_removedoubles(@vals);
81			my $string=join ":", @vals;
82			return $string;
83	williamc	1.1.2.1	}
84
85	williamc	1.1.2.2	sub _parsefile {
86	williamc	1.1.2.1	my $self=shift;
87	williamc	1.1.2.2	my $filename=shift;
88
89	williamc	1.1.2.4	$self->{switch}=ActiveDoc::SimpleDoc->new();
90			$self->{switch}->newparse("runtime");
91			$self->{switch}->addignoretags("runtime");
92			$self->{switch}->filetoparse($filename);
93			$self->{switch}->addtag("runtime","Runtime",
94			\&Runtime_start, $self,
95			\&Runtime_text, $self,
96			\&Runtime_end, $self);
97			$self->{switch}->addtag("runtime","Architecture",
98			\&Arch_Start, $self, "",$self, \&Arch_End, $self);
99	williamc	1.1.2.2	$self->{Runtimecontext}=0;
100	williamc	1.1.2.4	$self->{switch}->parse("runtime");
101	williamc	1.1.2.2	}
102
103			sub _printoutenv {
104			my $self=shift;
105			my $shell=shift;
106			my $variable=shift;
107			my $value=shift;
108
109			if ( $shell eq "csh" ) {
110			print "setenv $variable \"$value\";\n";
111			}
112			elsif ( $shell eq "sh" ) {
113			print "$variable=\"$value\";\n";
114			print "export $variable;\n";
115			}
116			}
117
118			# ------ Tag Routines
119
120			sub Runtime_start {
121	williamc	1.1.2.4	my $self=shift;
122	williamc	1.1.2.2	my $name=shift;
123	williamc	1.1.2.4	my $hashref=shift;
124	williamc	1.1.2.2
125	williamc	1.1.2.4	$self->{switch}->checktag($name,$hashref,'name');
126			$self->{switch}->checktag($name,$hashref,'value');
127	williamc	1.1.2.2	if ( $self->{Arch} ) {
128			if ( $self->{Runtimecontext} == 1 ) {
129	williamc	1.1.2.5	$self->{switch}->parseerror("No </$name> before new tag");
130	williamc	1.1.2.2	}
131			$self->{Runtimecontext}=1;
132
133			push @{$self->{'varlist'}}, $$hashref{'name'};
134			push @{$self->{'vars'}{$$hashref{'name'}}}, $$hashref{'value'};
135			if ( defined $$hashref{'type'} ) {
136			if ( ( exists $self->{'vartype'}{$$hashref{'name'}} ) &&
137			( $self->{'vartype'}{$$hashref{'name'}} ne $$hashref{'type'}) ){
138	williamc	1.1.2.5	$self->{switch}->parseerror("Redefinition of Variable".
139			" type for ".$$hashref{'name'});
140	williamc	1.1.2.2	}
141			$self->{'vartype'}{$$hashref{'name'}}=$$hashref{'type'};
142			if ( defined $self->{validtypes}{$$hashref{'type'}} ) {
143	williamc	1.1.2.5	$self->{switch}->parseerror(
144			"Unknown type ".$$hashref{'type'});
145	williamc	1.1.2.2	}
146			}
147			else {
148			$self->{'vartype'}{$$hashref{'name'}}=undef;
149			}
150			}
151			}
152
153			sub Runtime_text {
154	williamc	1.1.2.4	my $self=shift;
155	williamc	1.1.2.2	my $name=shift;
156			my @vars=@_;
157
158			if ( $self->{Arch} ) {
159			my $var=$self->{varlist}[$#{$self->{varlist}}];
160			$self->{'vardoc'}{$var}=$self->{'vardoc'}{$var}.
161			(join "", @vars);
162			}
163			}
164
165			sub Runtime_end {
166	williamc	1.1.2.4	my $self=shift;
167	williamc	1.1.2.2	my $name=shift;
168			if ( $self->{Arch} ) {
169			$self->{Runtimecontext}=0;
170			}
171	williamc	1.1.2.1	}
172	williamc	1.1.2.4
173			sub Arch_Start {
174			my $self=shift;
175			my $name=shift;
176			my $hashref=shift;
177
178			$toolswitch->checktag($name, $hashref,'name');
179			( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
180			: ($self->{Arch}=0);
181			push @{$self->{ARCHBLOCK}}, $self->{Arch};
182			}
183
184			sub Arch_End {
185			my $self=shift;
186			my $name=shift;
187
188			pop @{$self->{ARCHBLOCK}};
189			$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
190			}
191