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;
        $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;

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