src/BuildSystem/ToolDoc.pm

#
# ToolDoc.pm
#
# Originally Written by Christopher Williams
#
# Description
# -----------
# SimpleDoc interface to initialise Tool objects
#
# Interface
# ---------
# new()         : A new ToolDoc object
# tool(toolobj) : set the tool object for the class
# setup(file,$name,$version) : setup a tool object from the specified file
# interactive([0|1]) : set the interactive node 0=off 1=on

package BuildSystem::ToolDoc;
require 5.004;
use ActiveDoc::SimpleDoc;

sub new {
        my $class=shift;
        $self={};
        bless $self, $class;
        $self->init();
        return $self;
}

sub init {
        my $self=shift;
        $self->{switch}=ActiveDoc::SimpleDoc->new();
        $self->{switch}->newparse("setup");
        $self->{switch}->addtag("setup","Tool",\&Tool_Start, $self,     
                                                "", $self,
                                                \&Tool_End, $self);
        $self->{switch}->addtag("setup","Lib",\&Lib, $self,     
                                                "", $self,
                                                "", $self);
        $self->{switch}->addtag("setup","External",\&External_Start, $self,     
                                                "", $self,
                                                "", $self);
        $self->{switch}->addtag("setup","Client",\&Client_start, $self, 
                                                "", $self,
                                                \&Client_end, $self);
        $self->{switch}->addtag("setup","Environment",
                                                \&Environment_Start, $self,     
                                                \&Env_text, $self,
                                                \&Environment_End, $self);
        $self->{switch}->grouptag("Tool","setup");
        $self->{switch}->addtag("setup","Architecture",
                                        \&Arch_Start,$self,
                                        "", $self,
                                        \&Arch_End,$self);
        $self->{Arch}=1;
        push @{$self->{ARCHBLOCK}}, $Arch;

}

sub interactive {
        my $self=shift;
        
        @_?$self->{interactive}=shift
          :((defined $self->{interactive})?$self->{interactive}:0);
}

sub tool {
        my $self=shift;
        $self->{tool}=shift;
}

sub setup {
        my $self=shift;
        my $file=shift;
        my $name=shift;
        my $version=shift;

        $self->{ToolEnv}{'SCRAMtoolname'}=$name;
        $self->{ToolEnv}{'SCRAMtoolversion'}=$version;
        $self->{ToolEnv}{'SCRAM_ARCH'}=$ENV{'SCRAM_ARCH'};

        $name=~tr[A-Z][a-z];
        $self->{tool}->name($name);
        $self->{tool}->version($version);
        $self->{switch}->filetoparse($file);
        $self->{switch}->parse("setup");
}

sub featuretext {
        my $self=shift;
        my $feature=shift;

        if ( @_ ) {
          $self->{featuretext}{$feature}=shift;
        }
        else {
          return ($self->{featuretext}{$feature});
        }
}

sub _checkdefault {
        my $self=shift;
        my $hashref=shift;

        if ( defined $$hashref{'default'} ) { #check default
          my $default;
          foreach $default ( split /:/, $$hashref{'default'} ) {
            $default=~s/\"//;
            if ($self->_testlocation($default,
               [ $self->{tool}->getfeature($$hashref{'type'})] )) { return 1; }
          }
        }
        return 0;
}

sub _testlocation {
        my $self=shift;
        my $default=shift;
        my $testfiles=shift;
        my $OK='false';
        my $file;

        chomp $default;
        $default=$self->_expandvars($default);
        print "Trying $default .... ";
        if ( -f $default ) {
                $OK="true";
        }
        else {
          my $fh=FileHandle->new();
          opendir $fh,  $default or do { print "No \n"; return 0; };
         ($#{$testfiles}==-1) ? $OK='false' : $OK='true';
          print "\n";
          my @files=readdir $fh;
          undef $fh;
          foreach $file ( @$testfiles ) {
                print "   Checking for $file .... ";
                # now check that the required files are actually there
                if ( ( $number = grep /\Q$file\L/, @files) == 0 ) {
                   $OK='false';
                   print "not found\n";
                   last;
                }
                print "found\n";
          }
        }
        if ( $OK eq 'true' ) {
                print "Directory Check Complete\n";
                return 1
        }
        return 0
}

sub _expandvars {
        my $self=shift;
        my $string=shift;

        return "" , if ( ! defined $string );
        $string=~s{
                \$\((\w+)\)
        }{
          if (defined $self->{ToolEnv}{$1}) {
                $self->_expandvars($self->{ToolEnv}{$1});
          } else {
                "\$$1";
          }
        }egx;
        $string=~s{
                \$(\w+)
        }{
          if (defined $self->{ToolEnv}{$1}) {
                $self->_expandvars($self->{ToolEnv}{$1});
          } else {
                "\$$1";
          }
        }egx;
        return $string;
}


sub _askuser {
        my $self=shift;
        my $querystring=shift;
        my $varname=shift;

        print $self->featuretext($self->{EnvContext});
        for  ( ;; ) {
         print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
         $path=<STDIN>;
         chomp $path;
         if ( $path ne "" ) {
          if ( defined $self->{'client'}) { # must be a location
           if ( $self->_testlocation($path , "H", $Envtype{$type} )) {
             return $path;
           }
           print "Error : ".$path." does not exist.\n";
           next;
          }
         }
         else {
           return $path;
         }
        } #end for

}

# -- Tag Routines

sub Client_start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        if ( $self->{Arch} ) {
          $self->{'client'}=1;
        }
}

sub Client_end {
        my $self=shift;
        if ( $self->{Arch} ) {
        undef $self->{'client'};
        }
}
        
sub Tool_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->checktag($name, $hashref, 'name');
        $self->{switch}->checktag($name, $hashref, 'version');
        $self->{switch}->opengroup("Toolactive");

        # lower case the name
        $$hashref{'name'}=~tr[A-Z][a-z];
        # make sure we only pick up the tool requested
        if ( ( $self->{tool}->name() eq $$hashref{'name'} ) && 
                ($self->{tool}->version() eq $$hashref{'version'})) {
          $self->{switch}->
                allowgroup("Toolactive",$self->{switch}->currentparsename());
          $self->{ToolEnv}{'SCRAMtoolname'}=$$hashref{'name'};
          $self->{ToolEnv}{'SCRAMtoolversion'}=$$hashref{'version'};
        }
        else {
          $self->{switch}->disallowgroup("Toolactive",
                                $self->{switch}->currentparsename());
        }
}

sub Tool_End {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->closegroup("Toolactive");
}

sub Environment_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->checktag($name, $hashref, 'name');
        if ( $self->{Arch} ) {
          if ( defined $self->{EnvContext} ) {
            $self->parserror(" Attempted to open new <$name> context".
                        " without closing the previous one");
          }
          $self->{currentenvtext}="";
          $self->{EnvContext}=$$hashref{'name'};
          undef $self->{Envvalue};
          if ( exists $$hahsref{'type'} ) {
            $self->{tool}->type($$hashref{'name'},$$hahsref{'type'});
          }
          if ( exists $$hashref{'value'}) {
            $self->{Envvalue}=$$hashref{'value'};
          }
          elsif ( ! $self->interactive() ) {
           if ( $self->_checkdefault($hashref) ) {
            $self->{Envvalue}=$$hashref{'default'};
           }
          }
        }
}

sub Env_text {
        my $self=shift;
        my $name=shift;
        my $string=shift;

        if ( $self->{Arch} ) {
          $self->{currentenvtext}=$self->{currentenvtext}.$string;
        }
}

sub Environment_End {
        my $self=shift;
        my $name=shift;

        if ( $self->{Arch} ) {
          if ( ! defined $self->{EnvContext} ) {
            $self->parseerror("</\$name> without an opening context");
          }
          # - set the help text
          $self->featuretext($self->{EnvContext},$self->{currentenvtext});
          if ( ! defined $self->{Envvalue} ) {
            $self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
                        $self->{EnvContext});
          }
          $self->{Envvalue}=$self->_expandvars($self->{Envvalue});
          $self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
          $self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
          undef $self->{EnvContext};
          undef $self->{Envvalue};
        }
}

sub Lib {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->checktag($name, $hashref, 'name');
        if ( $self->{Arch} ) {
          $self->{tool}->addfeature("lib",$$hashref{'name'});
        }
}

sub External_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->checktag($name, $hashref,'ref');
        if ( $self->{Arch} ) {
          $self->{tool}->addfeature("_externals",$$hashref{'ref'});
        }
}

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.2
Committed:	Tue Apr 18 09:18:59 2000 UTC (25 years ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
CVS Tags:	V0_11_4, V0_11_3
Changes since 1.1.2.1:	+1 -1 lines
Log Message:	fixed external tag
#	User	Rev	Content
1	williamc	1.1.2.1	#
2			# ToolDoc.pm
3			#
4			# Originally Written by Christopher Williams
5			#
6			# Description
7			# -----------
8			# SimpleDoc interface to initialise Tool objects
9			#
10			# Interface
11			# ---------
12			# new() : A new ToolDoc object
13			# tool(toolobj) : set the tool object for the class
14			# setup(file,$name,$version) : setup a tool object from the specified file
15			# interactive([0\|1]) : set the interactive node 0=off 1=on
16
17			package BuildSystem::ToolDoc;
18			require 5.004;
19			use ActiveDoc::SimpleDoc;
20
21			sub new {
22			my $class=shift;
23			$self={};
24			bless $self, $class;
25			$self->init();
26			return $self;
27			}
28
29			sub init {
30			my $self=shift;
31			$self->{switch}=ActiveDoc::SimpleDoc->new();
32			$self->{switch}->newparse("setup");
33			$self->{switch}->addtag("setup","Tool",\&Tool_Start, $self,
34			"", $self,
35			\&Tool_End, $self);
36			$self->{switch}->addtag("setup","Lib",\&Lib, $self,
37			"", $self,
38			"", $self);
39			$self->{switch}->addtag("setup","External",\&External_Start, $self,
40			"", $self,
41			"", $self);
42			$self->{switch}->addtag("setup","Client",\&Client_start, $self,
43			"", $self,
44			\&Client_end, $self);
45			$self->{switch}->addtag("setup","Environment",
46			\&Environment_Start, $self,
47			\&Env_text, $self,
48			\&Environment_End, $self);
49			$self->{switch}->grouptag("Tool","setup");
50			$self->{switch}->addtag("setup","Architecture",
51			\&Arch_Start,$self,
52			"", $self,
53			\&Arch_End,$self);
54			$self->{Arch}=1;
55			push @{$self->{ARCHBLOCK}}, $Arch;
56
57			}
58
59			sub interactive {
60			my $self=shift;
61
62			@_?$self->{interactive}=shift
63			:((defined $self->{interactive})?$self->{interactive}:0);
64			}
65
66			sub tool {
67			my $self=shift;
68			$self->{tool}=shift;
69			}
70
71			sub setup {
72			my $self=shift;
73			my $file=shift;
74			my $name=shift;
75			my $version=shift;
76
77			$self->{ToolEnv}{'SCRAMtoolname'}=$name;
78			$self->{ToolEnv}{'SCRAMtoolversion'}=$version;
79			$self->{ToolEnv}{'SCRAM_ARCH'}=$ENV{'SCRAM_ARCH'};
80
81			$name=~tr[A-Z][a-z];
82			$self->{tool}->name($name);
83			$self->{tool}->version($version);
84			$self->{switch}->filetoparse($file);
85			$self->{switch}->parse("setup");
86			}
87
88			sub featuretext {
89			my $self=shift;
90			my $feature=shift;
91
92			if ( @_ ) {
93			$self->{featuretext}{$feature}=shift;
94			}
95			else {
96			return ($self->{featuretext}{$feature});
97			}
98			}
99
100			sub _checkdefault {
101			my $self=shift;
102			my $hashref=shift;
103
104			if ( defined $$hashref{'default'} ) { #check default
105			my $default;
106			foreach $default ( split /:/, $$hashref{'default'} ) {
107			$default=~s/\"//;
108			if ($self->_testlocation($default,
109			[ $self->{tool}->getfeature($$hashref{'type'})] )) { return 1; }
110			}
111			}
112			return 0;
113			}
114
115			sub _testlocation {
116			my $self=shift;
117			my $default=shift;
118			my $testfiles=shift;
119			my $OK='false';
120			my $file;
121
122			chomp $default;
123			$default=$self->_expandvars($default);
124			print "Trying $default .... ";
125			if ( -f $default ) {
126			$OK="true";
127			}
128			else {
129			my $fh=FileHandle->new();
130			opendir $fh, $default or do { print "No \n"; return 0; };
131			($#{$testfiles}==-1) ? $OK='false' : $OK='true';
132			print "\n";
133			my @files=readdir $fh;
134			undef $fh;
135			foreach $file ( @$testfiles ) {
136			print " Checking for $file .... ";
137			# now check that the required files are actually there
138			if ( ( $number = grep /\Q$file\L/, @files) == 0 ) {
139			$OK='false';
140			print "not found\n";
141			last;
142			}
143			print "found\n";
144			}
145			}
146			if ( $OK eq 'true' ) {
147			print "Directory Check Complete\n";
148			return 1
149			}
150			return 0
151			}
152
153			sub _expandvars {
154			my $self=shift;
155			my $string=shift;
156
157			return "" , if ( ! defined $string );
158			$string=~s{
159			\$\((\w+)\)
160			}{
161			if (defined $self->{ToolEnv}{$1}) {
162			$self->_expandvars($self->{ToolEnv}{$1});
163			} else {
164			"\$$1";
165			}
166			}egx;
167			$string=~s{
168			\$(\w+)
169			}{
170			if (defined $self->{ToolEnv}{$1}) {
171			$self->_expandvars($self->{ToolEnv}{$1});
172			} else {
173			"\$$1";
174			}
175			}egx;
176			return $string;
177			}
178
179
180			sub _askuser {
181			my $self=shift;
182			my $querystring=shift;
183			my $varname=shift;
184
185			print $self->featuretext($self->{EnvContext});
186			for ( ;; ) {
187			print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
188			$path=<STDIN>;
189			chomp $path;
190			if ( $path ne "" ) {
191			if ( defined $self->{'client'}) { # must be a location
192			if ( $self->_testlocation($path , "H", $Envtype{$type} )) {
193			return $path;
194			}
195			print "Error : ".$path." does not exist.\n";
196			next;
197			}
198			}
199			else {
200			return $path;
201			}
202			} #end for
203
204			}
205
206			# -- Tag Routines
207
208			sub Client_start {
209			my $self=shift;
210			my $name=shift;
211			my $hashref=shift;
212
213			if ( $self->{Arch} ) {
214			$self->{'client'}=1;
215			}
216			}
217
218			sub Client_end {
219			my $self=shift;
220			if ( $self->{Arch} ) {
221			undef $self->{'client'};
222			}
223			}
224
225			sub Tool_Start {
226			my $self=shift;
227			my $name=shift;
228			my $hashref=shift;
229
230			$self->{switch}->checktag($name, $hashref, 'name');
231			$self->{switch}->checktag($name, $hashref, 'version');
232			$self->{switch}->opengroup("Toolactive");
233
234			# lower case the name
235			$$hashref{'name'}=~tr[A-Z][a-z];
236			# make sure we only pick up the tool requested
237			if ( ( $self->{tool}->name() eq $$hashref{'name'} ) &&
238			($self->{tool}->version() eq $$hashref{'version'})) {
239			$self->{switch}->
240			allowgroup("Toolactive",$self->{switch}->currentparsename());
241			$self->{ToolEnv}{'SCRAMtoolname'}=$$hashref{'name'};
242			$self->{ToolEnv}{'SCRAMtoolversion'}=$$hashref{'version'};
243			}
244			else {
245			$self->{switch}->disallowgroup("Toolactive",
246			$self->{switch}->currentparsename());
247			}
248			}
249
250			sub Tool_End {
251			my $self=shift;
252			my $name=shift;
253			my $hashref=shift;
254
255			$self->{switch}->closegroup("Toolactive");
256			}
257
258			sub Environment_Start {
259			my $self=shift;
260			my $name=shift;
261			my $hashref=shift;
262
263			$self->{switch}->checktag($name, $hashref, 'name');
264			if ( $self->{Arch} ) {
265			if ( defined $self->{EnvContext} ) {
266			$self->parserror(" Attempted to open new <$name> context".
267			" without closing the previous one");
268			}
269			$self->{currentenvtext}="";
270			$self->{EnvContext}=$$hashref{'name'};
271			undef $self->{Envvalue};
272			if ( exists $$hahsref{'type'} ) {
273			$self->{tool}->type($$hashref{'name'},$$hahsref{'type'});
274			}
275			if ( exists $$hashref{'value'}) {
276			$self->{Envvalue}=$$hashref{'value'};
277			}
278			elsif ( ! $self->interactive() ) {
279			if ( $self->_checkdefault($hashref) ) {
280			$self->{Envvalue}=$$hashref{'default'};
281			}
282			}
283			}
284			}
285
286			sub Env_text {
287			my $self=shift;
288			my $name=shift;
289			my $string=shift;
290
291			if ( $self->{Arch} ) {
292			$self->{currentenvtext}=$self->{currentenvtext}.$string;
293			}
294			}
295
296			sub Environment_End {
297			my $self=shift;
298			my $name=shift;
299
300			if ( $self->{Arch} ) {
301			if ( ! defined $self->{EnvContext} ) {
302			$self->parseerror("</\$name> without an opening context");
303			}
304			# - set the help text
305			$self->featuretext($self->{EnvContext},$self->{currentenvtext});
306			if ( ! defined $self->{Envvalue} ) {
307			$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
308			$self->{EnvContext});
309			}
310			$self->{Envvalue}=$self->_expandvars($self->{Envvalue});
311			$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
312			$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
313			undef $self->{EnvContext};
314			undef $self->{Envvalue};
315			}
316			}
317
318			sub Lib {
319			my $self=shift;
320			my $name=shift;
321			my $hashref=shift;
322
323			$self->{switch}->checktag($name, $hashref, 'name');
324			if ( $self->{Arch} ) {
325			$self->{tool}->addfeature("lib",$$hashref{'name'});
326			}
327			}
328
329			sub External_Start {
330			my $self=shift;
331			my $name=shift;
332			my $hashref=shift;
333
334			$self->{switch}->checktag($name, $hashref,'ref');
335			if ( $self->{Arch} ) {
336	williamc	1.1.2.2	$self->{tool}->addfeature("_externals",$$hashref{'ref'});
337	williamc	1.1.2.1	}
338			}
339
340			sub Arch_Start {
341			my $self=shift;
342			my $name=shift;
343			my $hashref=shift;
344
345			$toolswitch->checktag($name, $hashref,'name');
346			( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
347			: ($self->{Arch}=0);
348			push @{$self->{ARCHBLOCK}}, $self->{Arch};
349			}
350
351			sub Arch_End {
352			my $self=shift;
353			my $name=shift;
354
355			pop @{$self->{ARCHBLOCK}};
356			$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
357			}
358
359