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->{switch}->addparam("_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.1
Committed:	Tue Apr 18 09:09:57 2000 UTC (25 years ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
Changes since 1.1:	+359 -0 lines
Log Message:	first draft
#	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	# 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	$self->{switch}->addparam("_externals",$$hashref{'ref'});
337	}
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