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;

sub new {
        my $class=shift;
        $self={};
        $self->{Arch}=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;

        my $Tags={
             'Runtime' => \&Runtime_text,
             'Runtime_StartTag' => \&Runtime_start,
             'Runtime_EndTag' => \&Runtime_end,
             'ignore' => 'none',
             'ignore_EndTag' => \&ignoretag_end,
             'ignore_StartTag' => \&ignoretag,
             'Architecture_StartTag' => \&Arch_Start,
             'Architecture' => 'none' ,
             'Architecture_EndTag' => \&Arch_End
        };
        use Utilities::Switcher;
        $self->{switch}=Switcher->new($Tags, $filename);
        $self->{Runtimecontext}=0;
        $self->{switch}->parse();
}

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 $name=shift;
        my @vars=@_;
        my $hashref;

        $hashref=$self->{switch}->SetupValueHash(\@vars);
        $self->{switch}->checkparam($hashref,$name,'name');
        $self->{switch}->checkparam($hashref,$name,'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 $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 $name=shift;
        if ( $self->{Arch} ) {
           $self->{Runtimecontext}=0;
        }
}
Revision:	1.1.2.2
Committed:	Fri Mar 31 08:28:25 2000 UTC (25 years, 1 month ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
Changes since 1.1.2.1:	+139 -10 lines
Log Message:	New runtime parser - less admin tags
#	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
22			sub new {
23			my $class=shift;
24			$self={};
25	williamc	1.1.2.2	$self->{Arch}=1;
26			push @{$self->{ARCHBLOCK}}, $self->{Arch};
27	williamc	1.1.2.1	bless $self, $class;
28			return $self;
29			}
30
31			sub file {
32			my $self=shift;
33			my $filename=shift;
34	williamc	1.1.2.2	$self->_parsefile($filename);
35			}
36
37			sub printenv {
38			my $self=shift;
39			my $shell=shift;
40
41			foreach $var ( @{$self->{'varlist'}} ) {
42			$self->_printoutenv($shell,$var,$self->getvalue($var));
43			}
44			}
45
46			sub list {
47			my $self=shift;
48			return @{$self->{'varlist'}};
49			}
50
51			sub doc {
52			my $self=shift;
53			my $var=shift;
54			return $self->{vardoc}{$var};
55			}
56
57			sub getvalue {
58			my $self=shift;
59			my $name=shift;
60
61			my $string;
62			my @vals=@{$self->{vars}{$name}};
63	williamc	1.1.2.1
64	williamc	1.1.2.2	if ( defined $self->{'vartype'}{$name} ) { #any type proceesing
65			$string=&{"_".$self->{'vartype'}{$name}}(@vals);
66			}
67			else {
68			$string=$vals[0];
69	williamc	1.1.2.1	}
70	williamc	1.1.2.2	return $string;
71	williamc	1.1.2.1	}
72
73	williamc	1.1.2.2	# ---- Support Routines
74			sub _path {
75	williamc	1.1.2.1	my $self=shift;
76	williamc	1.1.2.2	my @vals=@_;
77
78			@vals=$self->_removedoubles(@vals);
79			my $string=join ":", @vals;
80			return $string;
81	williamc	1.1.2.1	}
82
83	williamc	1.1.2.2	sub _parsefile {
84	williamc	1.1.2.1	my $self=shift;
85	williamc	1.1.2.2	my $filename=shift;
86
87			my $Tags={
88			'Runtime' => \&Runtime_text,
89			'Runtime_StartTag' => \&Runtime_start,
90			'Runtime_EndTag' => \&Runtime_end,
91			'ignore' => 'none',
92			'ignore_EndTag' => \&ignoretag_end,
93			'ignore_StartTag' => \&ignoretag,
94			'Architecture_StartTag' => \&Arch_Start,
95			'Architecture' => 'none' ,
96			'Architecture_EndTag' => \&Arch_End
97			};
98			use Utilities::Switcher;
99			$self->{switch}=Switcher->new($Tags, $filename);
100			$self->{Runtimecontext}=0;
101			$self->{switch}->parse();
102			}
103
104			sub _printoutenv {
105			my $self=shift;
106			my $shell=shift;
107			my $variable=shift;
108			my $value=shift;
109
110			if ( $shell eq "csh" ) {
111			print "setenv $variable \"$value\";\n";
112			}
113			elsif ( $shell eq "sh" ) {
114			print "$variable=\"$value\";\n";
115			print "export $variable;\n";
116			}
117			}
118
119			# ------ Tag Routines
120
121			sub Runtime_start {
122			my $name=shift;
123			my @vars=@_;
124			my $hashref;
125
126			$hashref=$self->{switch}->SetupValueHash(\@vars);
127			$self->{switch}->checkparam($hashref,$name,'name');
128			$self->{switch}->checkparam($hashref,$name,'value');
129			if ( $self->{Arch} ) {
130			if ( $self->{Runtimecontext} == 1 ) {
131			print "No </$name> before new tag at line ".
132			$self->{switch}->line()."\n";
133			exit 1;
134			}
135			$self->{Runtimecontext}=1;
136
137			push @{$self->{'varlist'}}, $$hashref{'name'};
138			push @{$self->{'vars'}{$$hashref{'name'}}}, $$hashref{'value'};
139			if ( defined $$hashref{'type'} ) {
140			if ( ( exists $self->{'vartype'}{$$hashref{'name'}} ) &&
141			( $self->{'vartype'}{$$hashref{'name'}} ne $$hashref{'type'}) ){
142			print "Redefinition of Variable type for ".$$hashref{'name'}
143			." on line ".$self->{switch}->line();
144			}
145			$self->{'vartype'}{$$hashref{'name'}}=$$hashref{'type'};
146			if ( defined $self->{validtypes}{$$hashref{'type'}} ) {
147			print "Unknown type ".$$hashref{'type'}." on line ".
148			$self->{switch}->line()."\n";
149			exit 1;
150			}
151			}
152			else {
153			$self->{'vartype'}{$$hashref{'name'}}=undef;
154			}
155			}
156			}
157
158			sub Runtime_text {
159			my $name=shift;
160			my @vars=@_;
161
162			if ( $self->{Arch} ) {
163			my $var=$self->{varlist}[$#{$self->{varlist}}];
164			$self->{'vardoc'}{$var}=$self->{'vardoc'}{$var}.
165			(join "", @vars);
166			}
167			}
168
169			sub Runtime_end {
170			my $name=shift;
171			if ( $self->{Arch} ) {
172			$self->{Runtimecontext}=0;
173			}
174	williamc	1.1.2.1	}