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
#                               return 0 for OK 1 for cancel
# 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}}, $self->{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->{tool}->url($file);
        $self->{switch}->filetoparse($file);
        $self->{toolfound}=1;
        $self->{switch}->parse("setup");
        return $self->{toolfound};
}

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'};
          $self->{toolfound}=0;
        }
        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() ) {
           # check the environment
           if ( defined $ENV{$$hashref{'name'}} ) {
            $self->{Envvalue}=$ENV{$$hashref{'name'}};
           }
           elsif ( $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->{switch}->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;

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