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 ) {
           print "No </$name> before new tag at line ".
                                $self->{switch}->line()."\n";
           exit 1;
          }
          $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'}) ){
                   print "Redefinition of Variable type for ".$$hashref{'name'} 
                        ." on line ".$self->{switch}->line();
             }
             $self->{'vartype'}{$$hashref{'name'}}=$$hashref{'type'};
             if ( defined $self->{validtypes}{$$hashref{'type'}} ) {
                print "Unknown type ".$$hashref{'type'}." on line ".
                        $self->{switch}->line()."\n";
                exit 1;
             }
          }
          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.4
Committed:	Fri Apr 7 08:14:39 2000 UTC (25 years, 1 month ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
Changes since 1.1.2.3:	+38 -19 lines
Log Message:	Use SimpleDoc
#	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			print "No </$name> before new tag at line ".
130			$self->{switch}->line()."\n";
131			exit 1;
132			}
133			$self->{Runtimecontext}=1;
134
135			push @{$self->{'varlist'}}, $$hashref{'name'};
136			push @{$self->{'vars'}{$$hashref{'name'}}}, $$hashref{'value'};
137			if ( defined $$hashref{'type'} ) {
138			if ( ( exists $self->{'vartype'}{$$hashref{'name'}} ) &&
139			( $self->{'vartype'}{$$hashref{'name'}} ne $$hashref{'type'}) ){
140			print "Redefinition of Variable type for ".$$hashref{'name'}
141			." on line ".$self->{switch}->line();
142			}
143			$self->{'vartype'}{$$hashref{'name'}}=$$hashref{'type'};
144			if ( defined $self->{validtypes}{$$hashref{'type'}} ) {
145			print "Unknown type ".$$hashref{'type'}." on line ".
146			$self->{switch}->line()."\n";
147			exit 1;
148			}
149			}
150			else {
151			$self->{'vartype'}{$$hashref{'name'}}=undef;
152			}
153			}
154			}
155
156			sub Runtime_text {
157	williamc	1.1.2.4	my $self=shift;
158	williamc	1.1.2.2	my $name=shift;
159			my @vars=@_;
160
161			if ( $self->{Arch} ) {
162			my $var=$self->{varlist}[$#{$self->{varlist}}];
163			$self->{'vardoc'}{$var}=$self->{'vardoc'}{$var}.
164			(join "", @vars);
165			}
166			}
167
168			sub Runtime_end {
169	williamc	1.1.2.4	my $self=shift;
170	williamc	1.1.2.2	my $name=shift;
171			if ( $self->{Arch} ) {
172			$self->{Runtimecontext}=0;
173			}
174	williamc	1.1.2.1	}
175	williamc	1.1.2.4
176			sub Arch_Start {
177			my $self=shift;
178			my $name=shift;
179			my $hashref=shift;
180
181			$toolswitch->checktag($name, $hashref,'name');
182			( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
183			: ($self->{Arch}=0);
184			push @{$self->{ARCHBLOCK}}, $self->{Arch};
185			}
186
187			sub Arch_End {
188			my $self=shift;
189			my $name=shift;
190
191			pop @{$self->{ARCHBLOCK}};
192			$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
193			}
194