src/BuildSystem/Requirements.pm

# Requirements Doc - just to get ordering info
#
# Interface
# ---------
# new(ActiveStore,url[,arch])     : new requirements doc
# setup(toolbox): set up the requirements into the specified toolbox object
# download(toolbox)    : download description files (into toolbox cache)
# tools()       : Return list of ALL requirements (ordered)
# selectedtools() : Return list of only those tools selected
# version(tool) : return the version of a given tool
# toolurl(tool)     : return the url of a given tool
# getreqforarch(arch) : Return a RequirementsObject corresponding to the
#                       specified architecture
# toolcomment(tool,version) : return the comment string for the specified tool
# distributionurl(tool,version) : return the dist info url for the tool

package BuildSystem::Requirements;
use ActiveDoc::ActiveDoc;
use Utilities::Verbose;

require 5.004;
@ISA=qw(Utilities::Verbose);

sub new {
        my $class=shift;
        my $self={};
        bless $self, $class;
        $self->{dbstore}=shift;
        $self->{file}=shift;
        $self->{cache}=$self->{dbstore}->cache();
        if ( @_ ) {
          $self->arch(shift);
        }
        $self->verbose("Initialising a new Requirements Doc");
        $self->{mydocversion}="2.0";
        $self->{Arch}=1;
        push @{$self->{ARCHBLOCK}}, $self->{Arch};
        $self->init($self->{file});
        return $self;
}

sub url {
        my $self=shift;
        if ( @_ ) {
          $self->{file}=shift;
        }
        return $self->{file}
}

sub setup
   {
   my $self=shift;
   my $toolbox=shift;
   my $tool;

   foreach $tool ( $self->selectedtools() )
      {
      $self->verbose("Setting Up Tool $tool");
      $toolbox->toolsetup($tool, $self->version($tool), $self->toolurl($tool));
      }
   }

sub tools {
        my $self=shift;
        return @{$self->{tools}};
}


sub selectedtools
   {
   ###############################################################
   # selectedtools()                                             #
   ###############################################################
   # modified : Wed Dec  5 15:39:39 2001 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   #          :                                                  #
   #          :                                                  #
   # function : New version of routine. Return a list of tools   #
   #          : that were selected after parsing RequirementsDoc #
   #          :                                                  #
   #          :                                                  #
   ###############################################################
   my $self=shift;
   my @toolarray = ();
   
   # Grab the arrays of tools:
   my ($toolref,$deseltoolref,$unseltoolref) = $self->grabtools();
   
   my @tools = @{$toolref};
   my @deseltools = @{$deseltoolref};
   my @unseltools = @{$unseltoolref};
   
   if ($#tools == -1)
      {
      $self->verbose(">> No tools SELECTED. Checking for DESELECTED tools");
      
      # No tools "SELECTED". We return the tools that were "UNSELECTED"
      # (these are the tools that remain after unwanted tools are deselected):
      if ($#unseltools != -1)
         {
         $self->verbose(">> Using the tools remaining after DESELECTION ops");
         # The array has elements:
         return @unseltools;
         }
      else
         {
         $self->verbose(">> No UNSELECTED tools.....");
         }
      }
   else
      {
      # We will return the selected tools but only after checking
      # for subsequently deselected tools (unlikely but...):
      foreach $selected (@tools)
         {
         # If the tool exists in the deselected tool array, pass.
         if ( ! grep /$selected/, @deseltools)
            {
            push @toolarray, $selected;  
            }
         else
            {
            $self->verbose(">> Tool $selected was subsequently deselected.");
            }
         }
      }
   return @toolarray;
   }


sub grabtools
   {
   ###############################################################
   # grabtools()                                                 #
   ###############################################################
   # modified : Wed Dec  5 14:41:56 2001 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   #          :                                                  #
   #          :                                                  #
   # function : Loop over the tools read from RequirementsDoc    #
   #          : and fill arrays for selected, deselected and     #
   #          : unselected tools.                                #
   #          :                                                  #
   ###############################################################
   my $self=shift;
   my @toollist=();
   my @deseltoollist=();
   my @unseltoollist=();
   
   foreach $tool (  @{$self->{tools}} )
      {
      if ( $self->{selected}{$tool} eq "SELECTED" )
         {
         push @toollist, $tool;
         }
      elsif ( $self->{selected}{$tool} eq "DESELECTED" )
         {
         push @deseltoollist, $tool;
         }
      elsif ( $self->{selected}{$tool} eq "UNSELECTED" )
         {
         push @unseltoollist, $tool;
         }
      else
         {
         $self->verbose(">> Looks like an unknown sel flag for tool ".$tool." ");
         }
      }
   return \(@toollist, @deseltoollist, @unseltoollist);
   }


sub toolcomment {
        my $self=shift;
        my $tool=shift;
        my $version=shift;

        return $self->{reqtext}{$tool}{$version};
}

sub distributionurl {
        my $self=shift;
        my $tool=shift;
        my $version=shift;

        return ( defined $self->{dist}{$tool}{$version})?
                        $self->{dist}{$tool}{$version}:undef;
}

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

sub toolurl {
        my $self=shift;
        my $tool=shift;
        return $self->{'url'}{$tool};
}

sub init {
        my $self=shift;
        my $url=shift;

        my $switch=ActiveDoc::ActiveDoc->new($self->{dbstore});
        $switch->verbosity($self->verbosity());
        $switch->url($url);
        $switch->newparse("ordering");
        $switch->addbasetags("ordering");
        $switch->addtag("ordering","Architecture",
                                        \&Arch_Start,$self,
                                        "", $self,
                                        \&Arch_End, $self);
        $switch->addtag("ordering","Restrict",
                                        \&Restrict_start,$self,
                                        "", $self,
                                        \&Restrict_end, $self);
        $switch->addtag("ordering","deselect",
                                        \&deselect_start,$self,
                                        "", $self,
                                        "", $self);
        $switch->addtag("ordering","select",
                                        \&select_start,$self,
                                        "", $self,
                                        "", $self);
        $switch->addtag("ordering","distribution",
                                        \&disttag,$self);
        $switch->grouptag("Architecture","ordering");
        $switch->addtag("ordering","require",
                                        \&require_start,$self,
                                        \&require_text, $self,
                                        \&require_end, $self);

        $self->{reqcontext}=0;
        $self->{switch}=$switch;
        undef $self->{restrictstack};
        @{$self->{tools}}=();
        
        my($doctype,$docversion)=$switch->doctype();
        # -- for backwards compatability only parse if we have a docversion
        #    defined
        if ( defined $docversion ) { 
          if ( $docversion eq $self->{mydocversion} ) {
            @{$self->{ArchStack}}=();
            $self->verbose("Initial Document Parse");
            $self->{switch}->parse("ordering");
          }
          else {
            $self->verbose("wrong doc version - not parsing");
          }
        }
        else {
          $self->verbose("wrong doc type - not parsing");
        }
}

sub arch {
        my $self=shift;
        # $self->arch is the SCRAM_ARCH value:
        if ( @_ ) {
          $self->{arch}=shift
        }
        else {
          if ( ! defined $self->{arch} ) {
            $self->{arch}="";
          }
        }
        return $self->{arch};
}

sub archlist {
        my $self=shift;
        return @{$self->{ArchStack}};
}

sub getreqforarch {
        my $self=shift;
        my $arch=shift;

        if ( ! defined $self->{reqsforarch}{$arch} ) {
          $self->{reqsforarch}{$arch}=
                BuildSystem::Requirements->new($self->{dbstore},$self->{file},
                                                $arch);
        }
        return $self->{reqsforarch}{$arch};
}


sub download
   {
   my $self=shift;
   my $tool;
   $| = 1; # Unbuffer the output

   print  "Downloading tool descriptions....","\n";
   print  " ";
   foreach $tool ( $self->tools() )
      {
      print "#";
      $self->verbose("Downloading ".$self->toolurl($tool));
      # get into the cache
      $self->{switch}->urlget($self->toolurl($tool));
      }
   print "\nDone.","\n","\n";
   }

sub _autoselect {
        my $self=shift;
        if ( @_ ) {
          $self->{autoselect}=shift;
        }
        # -- default is true
        return ((defined $self->{autoselect})?$self->{autoselect}:1);
}

# ---- Tag routines 

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

        $self->{switch}->checktag( $name, $hashref, 'autoselect');
        if ( $self->{Arch} ) {
        # -- create selection state stack
        push @{$self->{restrictstack}}, $self->_autoselect();
        $self->_autoselect(
                (($$hashref{'autoselect'}=~/true/i)?1:0));
        }
}

sub Restrict_end {
        my $self=shift;
        my $name=shift;
        
        if ( $self->{Arch} ) {
        if ( $#{$self->{restrictstack}} >= 0 ) {
          $self->_autoselect(pop @{$self->{restrictstack}});
        }
        else {
          $self->{switch}->parseerror("Unmatched </$name>");
        }
        }
}

sub require_start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;
        
        $self->{switch}->checktag( $name, $hashref, 'version');
        $self->{switch}->checktag( $name, $hashref, 'name');
        $self->{switch}->checktag( $name, $hashref, 'url');
        
        if ( $self->{reqcontext} == 1 ) {
          $self->{switch}->parseerror(
                "Open new $name context without previous </$name>");
        }
        $self->{reqcontext}=1;
        $$hashref{'name'}=~tr[A-Z][a-z];
        print "Adding ",$$hashref{'name'}," to the tool stack","\n";
        push @{$self->{tools}}, $$hashref{'name'};
        $self->{version}{$$hashref{'name'}}=$$hashref{'version'};
        print "       version: ",$self->{version}{$$hashref{'name'}},"\n";
        # -- make sure the full url is taken
        my $urlobj=$self->{switch}->expandurl($$hashref{'url'});
        $self->{url}{$$hashref{'name'}}=$urlobj->url();

        # Disable the auto select mechanism. Now, we start with
        # all tools having a flag "UNSELECTED". Then we choose
        # which we wish to select:
        if ( $self->{Arch} )
           {
            $self->{selected}{$$hashref{'name'}}="UNSELECTED";
           }
        # Output the tool name here with the value
        # of its' select flag:
        $self->verbose(">> Tool name: ".$$hashref{'name'}." sel/desel flag value: ".
                       $self->{selected}{$$hashref{'name'}} ." ");

        $self->{creqtool}=$$hashref{'name'};
        $self->{creqversion}=$$hashref{'version'};
        $self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}="";
}

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

        chomp $string;
        $self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}=
                $self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}.
                $string;
                
}

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

        if ( $self->{reqcontext} != 1 ) {
          $self->{switch}->parseerror("No matching tag for </$name>");
        }
        else {
          $self->{reqcontext}=0;
        }
}

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

   $self->{switch}->checktag( $name, $hashref, 'name');
   $$hashref{'name'}=~tr[A-Z][a-z];
   if ( $self->{Arch} )
      {
      $self->verbose("Selecting ".$$hashref{'name'});
      $self->{selected}{$$hashref{'name'}} = "SELECTED";
      $self->verbose(">> Tool select flag = ".$self->{selected}{$$hashref{'name'}}."\n");
      }
   }

sub deselect_start
   {
   my $self=shift;
   my $name=shift;
   my $hashref=shift;
   
   $self->{switch}->checktag( $name, $hashref, 'name');
   $$hashref{'name'}=~tr[A-Z][a-z];
   if ( $self->{Arch} )
      {
      $self->verbose("Deselecting ".$$hashref{'name'});
      $self->{selected}{$$hashref{'name'}} = "DESELECTED";
      $self->verbose(">> Tool select flag = ".$self->{selected}{$$hashref{'name'}}."\n");
      }
   }

sub Arch_Start
   {
   my $self=shift;
   my $name=shift;
   my $hashref=shift;
   # Check the architecture tag:
   $self->{switch}->checktag($name, $hashref,'name');
   # Look for a match between the architecture flag read
   # from the RequirementsDoc ($$hashref{name}) and scram arch:
   #if ($self->arch() =~ /$$hashref{name}.*/)
   #   {
      
    #  }
   #elsif ($self->arch() =~ /$$hashref{name}/)
   #   {
   #   }
   #else
   #   {
   #   } 
   ( ($self->arch()=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
      : ($self->{Arch}=0);
#   ( ($self->arch()=~/$$hashref{name}[BLAH]/) )? ($self->{Arch}=1)
#      : ($self->{Arch}=0);

   
   $self->verbose(($self->{Arch}?"OK":"skipping")." ".$$hashref{name});
   push @{$self->{ARCHBLOCK}}, $self->{Arch};
   push @{$self->{ArchStack}}, $$hashref{'name'};
   }

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

        pop @{$self->{ARCHBLOCK}};
        $self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
}

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

        if ( exists $$hashref{'url'} ) {
          $self->{dist}{$self->{creqtool}}{$self->{creqversion}}=
                                                        $$hashref{'url'};
        }
}
Revision:	1.14
Committed:	Fri Oct 11 14:23:24 2002 UTC (22 years, 7 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
Changes since 1.13:	+31 -13 lines
Log Message:	Added -debug flag to turn on full verbosity. Some trials with a CompilerMap tag.
#	User	Rev	Content
1	williamc	1.2	# Requirements Doc - just to get ordering info
2			#
3			# Interface
4			# ---------
5			# new(ActiveStore,url[,arch]) : new requirements doc
6			# setup(toolbox): set up the requirements into the specified toolbox object
7			# download(toolbox) : download description files (into toolbox cache)
8			# tools() : Return list of ALL requirements (ordered)
9			# selectedtools() : Return list of only those tools selected
10			# version(tool) : return the version of a given tool
11			# toolurl(tool) : return the url of a given tool
12			# getreqforarch(arch) : Return a RequirementsObject corresponding to the
13			# specified architecture
14			# toolcomment(tool,version) : return the comment string for the specified tool
15			# distributionurl(tool,version) : return the dist info url for the tool
16
17			package BuildSystem::Requirements;
18			use ActiveDoc::ActiveDoc;
19			use Utilities::Verbose;
20
21			require 5.004;
22			@ISA=qw(Utilities::Verbose);
23
24			sub new {
25			my $class=shift;
26			my $self={};
27			bless $self, $class;
28			$self->{dbstore}=shift;
29			$self->{file}=shift;
30			$self->{cache}=$self->{dbstore}->cache();
31			if ( @_ ) {
32			$self->arch(shift);
33			}
34	williamc	1.3	$self->verbose("Initialising a new Requirements Doc");
35	williamc	1.2	$self->{mydocversion}="2.0";
36			$self->{Arch}=1;
37			push @{$self->{ARCHBLOCK}}, $self->{Arch};
38			$self->init($self->{file});
39			return $self;
40			}
41
42			sub url {
43			my $self=shift;
44			if ( @_ ) {
45			$self->{file}=shift;
46			}
47			return $self->{file}
48			}
49
50	sashby	1.7	sub setup
51			{
52			my $self=shift;
53			my $toolbox=shift;
54			my $tool;
55
56			foreach $tool ( $self->selectedtools() )
57			{
58			$self->verbose("Setting Up Tool $tool");
59			$toolbox->toolsetup($tool, $self->version($tool), $self->toolurl($tool));
60			}
61			}
62	williamc	1.2
63			sub tools {
64			my $self=shift;
65			return @{$self->{tools}};
66			}
67
68	sashby	1.11
69	sashby	1.8	sub selectedtools
70			{
71	sashby	1.11	###############################################################
72			# selectedtools() #
73			###############################################################
74			# modified : Wed Dec 5 15:39:39 2001 / SFA #
75			# params : #
76			# : #
77			# : #
78			# : #
79			# function : New version of routine. Return a list of tools #
80			# : that were selected after parsing RequirementsDoc #
81			# : #
82			# : #
83			###############################################################
84			my $self=shift;
85			my @toolarray = ();
86
87			# Grab the arrays of tools:
88			my ($toolref,$deseltoolref,$unseltoolref) = $self->grabtools();
89
90			my @tools = @{$toolref};
91			my @deseltools = @{$deseltoolref};
92			my @unseltools = @{$unseltoolref};
93
94			if ($#tools == -1)
95			{
96			$self->verbose(">> No tools SELECTED. Checking for DESELECTED tools");
97
98			# No tools "SELECTED". We return the tools that were "UNSELECTED"
99			# (these are the tools that remain after unwanted tools are deselected):
100			if ($#unseltools != -1)
101			{
102			$self->verbose(">> Using the tools remaining after DESELECTION ops");
103			# The array has elements:
104			return @unseltools;
105			}
106			else
107			{
108			$self->verbose(">> No UNSELECTED tools.....");
109			}
110			}
111			else
112			{
113			# We will return the selected tools but only after checking
114			# for subsequently deselected tools (unlikely but...):
115			foreach $selected (@tools)
116			{
117			# If the tool exists in the deselected tool array, pass.
118			if ( ! grep /$selected/, @deseltools)
119			{
120			push @toolarray, $selected;
121			}
122			else
123			{
124			$self->verbose(">> Tool $selected was subsequently deselected.");
125			}
126			}
127			}
128			return @toolarray;
129			}
130
131
132			sub grabtools
133			{
134			###############################################################
135			# grabtools() #
136			###############################################################
137			# modified : Wed Dec 5 14:41:56 2001 / SFA #
138			# params : #
139			# : #
140			# : #
141			# : #
142			# function : Loop over the tools read from RequirementsDoc #
143			# : and fill arrays for selected, deselected and #
144			# : unselected tools. #
145			# : #
146			###############################################################
147	sashby	1.8	my $self=shift;
148			my @toollist=();
149	sashby	1.11	my @deseltoollist=();
150			my @unseltoollist=();
151
152	sashby	1.8	foreach $tool ( @{$self->{tools}} )
153			{
154			if ( $self->{selected}{$tool} eq "SELECTED" )
155			{
156			push @toollist, $tool;
157			}
158	sashby	1.11	elsif ( $self->{selected}{$tool} eq "DESELECTED" )
159			{
160			push @deseltoollist, $tool;
161			}
162			elsif ( $self->{selected}{$tool} eq "UNSELECTED" )
163			{
164			push @unseltoollist, $tool;
165			}
166			else
167			{
168			$self->verbose(">> Looks like an unknown sel flag for tool ".$tool." ");
169			}
170	sashby	1.8	}
171	sashby	1.11	return \(@toollist, @deseltoollist, @unseltoollist);
172	sashby	1.8	}
173	sashby	1.11
174	williamc	1.2
175			sub toolcomment {
176			my $self=shift;
177			my $tool=shift;
178			my $version=shift;
179
180			return $self->{reqtext}{$tool}{$version};
181			}
182
183			sub distributionurl {
184			my $self=shift;
185			my $tool=shift;
186			my $version=shift;
187
188			return ( defined $self->{dist}{$tool}{$version})?
189			$self->{dist}{$tool}{$version}:undef;
190			}
191
192			sub version {
193			my $self=shift;
194			my $tool=shift;
195			return $self->{'version'}{$tool};
196			}
197
198			sub toolurl {
199			my $self=shift;
200			my $tool=shift;
201			return $self->{'url'}{$tool};
202			}
203
204			sub init {
205			my $self=shift;
206			my $url=shift;
207
208			my $switch=ActiveDoc::ActiveDoc->new($self->{dbstore});
209			$switch->verbosity($self->verbosity());
210			$switch->url($url);
211			$switch->newparse("ordering");
212			$switch->addbasetags("ordering");
213			$switch->addtag("ordering","Architecture",
214			\&Arch_Start,$self,
215			"", $self,
216			\&Arch_End, $self);
217			$switch->addtag("ordering","Restrict",
218			\&Restrict_start,$self,
219			"", $self,
220			\&Restrict_end, $self);
221			$switch->addtag("ordering","deselect",
222			\&deselect_start,$self,
223			"", $self,
224			"", $self);
225			$switch->addtag("ordering","select",
226			\&select_start,$self,
227			"", $self,
228			"", $self);
229			$switch->addtag("ordering","distribution",
230			\&disttag,$self);
231			$switch->grouptag("Architecture","ordering");
232			$switch->addtag("ordering","require",
233			\&require_start,$self,
234			\&require_text, $self,
235			\&require_end, $self);
236
237			$self->{reqcontext}=0;
238			$self->{switch}=$switch;
239			undef $self->{restrictstack};
240			@{$self->{tools}}=();
241
242			my($doctype,$docversion)=$switch->doctype();
243			# -- for backwards compatability only parse if we have a docversion
244			# defined
245			if ( defined $docversion ) {
246			if ( $docversion eq $self->{mydocversion} ) {
247			@{$self->{ArchStack}}=();
248	williamc	1.3	$self->verbose("Initial Document Parse");
249	williamc	1.2	$self->{switch}->parse("ordering");
250			}
251	williamc	1.3	else {
252			$self->verbose("wrong doc version - not parsing");
253			}
254	williamc	1.2	}
255			else {
256	williamc	1.3	$self->verbose("wrong doc type - not parsing");
257	williamc	1.2	}
258			}
259
260			sub arch {
261			my $self=shift;
262	sashby	1.14	# $self->arch is the SCRAM_ARCH value:
263	williamc	1.2	if ( @_ ) {
264			$self->{arch}=shift
265			}
266			else {
267			if ( ! defined $self->{arch} ) {
268			$self->{arch}="";
269			}
270			}
271			return $self->{arch};
272			}
273
274			sub archlist {
275			my $self=shift;
276			return @{$self->{ArchStack}};
277			}
278
279			sub getreqforarch {
280			my $self=shift;
281			my $arch=shift;
282
283			if ( ! defined $self->{reqsforarch}{$arch} ) {
284			$self->{reqsforarch}{$arch}=
285			BuildSystem::Requirements->new($self->{dbstore},$self->{file},
286			$arch);
287			}
288			return $self->{reqsforarch}{$arch};
289			}
290
291
292	sashby	1.13	sub download
293			{
294			my $self=shift;
295			my $tool;
296			$\| = 1; # Unbuffer the output
297
298			print "Downloading tool descriptions....","\n";
299			print " ";
300			foreach $tool ( $self->tools() )
301			{
302			print "#";
303			$self->verbose("Downloading ".$self->toolurl($tool));
304			# get into the cache
305			$self->{switch}->urlget($self->toolurl($tool));
306			}
307			print "\nDone.","\n","\n";
308			}
309	williamc	1.2
310			sub _autoselect {
311			my $self=shift;
312			if ( @_ ) {
313			$self->{autoselect}=shift;
314			}
315			# -- default is true
316			return ((defined $self->{autoselect})?$self->{autoselect}:1);
317			}
318
319			# ---- Tag routines
320
321			sub Restrict_start {
322			my $self=shift;
323			my $name=shift;
324			my $hashref=shift;
325
326			$self->{switch}->checktag( $name, $hashref, 'autoselect');
327			if ( $self->{Arch} ) {
328			# -- create selection state stack
329			push @{$self->{restrictstack}}, $self->_autoselect();
330			$self->_autoselect(
331			(($$hashref{'autoselect'}=~/true/i)?1:0));
332			}
333			}
334
335			sub Restrict_end {
336			my $self=shift;
337			my $name=shift;
338	sashby	1.10
339	williamc	1.2	if ( $self->{Arch} ) {
340			if ( $#{$self->{restrictstack}} >= 0 ) {
341			$self->_autoselect(pop @{$self->{restrictstack}});
342			}
343			else {
344			$self->{switch}->parseerror("Unmatched </$name>");
345			}
346			}
347			}
348
349			sub require_start {
350			my $self=shift;
351			my $name=shift;
352			my $hashref=shift;
353
354			$self->{switch}->checktag( $name, $hashref, 'version');
355			$self->{switch}->checktag( $name, $hashref, 'name');
356			$self->{switch}->checktag( $name, $hashref, 'url');
357	sashby	1.10
358	williamc	1.2	if ( $self->{reqcontext} == 1 ) {
359			$self->{switch}->parseerror(
360	sashby	1.10	"Open new $name context without previous </$name>");
361	williamc	1.2	}
362			$self->{reqcontext}=1;
363			$$hashref{'name'}=~tr[A-Z][a-z];
364	sashby	1.14	print "Adding ",$$hashref{'name'}," to the tool stack","\n";
365	williamc	1.2	push @{$self->{tools}}, $$hashref{'name'};
366			$self->{version}{$$hashref{'name'}}=$$hashref{'version'};
367	sashby	1.14	print " version: ",$self->{version}{$$hashref{'name'}},"\n";
368	williamc	1.2	# -- make sure the full url is taken
369			my $urlobj=$self->{switch}->expandurl($$hashref{'url'});
370			$self->{url}{$$hashref{'name'}}=$urlobj->url();
371
372	sashby	1.10	# Disable the auto select mechanism. Now, we start with
373			# all tools having a flag "UNSELECTED". Then we choose
374			# which we wish to select:
375			if ( $self->{Arch} )
376			{
377			$self->{selected}{$$hashref{'name'}}="UNSELECTED";
378			}
379			# Output the tool name here with the value
380			# of its' select flag:
381			$self->verbose(">> Tool name: ".$$hashref{'name'}." sel/desel flag value: ".
382			$self->{selected}{$$hashref{'name'}} ." ");
383
384	williamc	1.2	$self->{creqtool}=$$hashref{'name'};
385			$self->{creqversion}=$$hashref{'version'};
386			$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}="";
387			}
388
389			sub require_text {
390			my $self=shift;
391			my $name=shift;
392			my $string=shift;
393
394			chomp $string;
395			$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}=
396			$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}.
397			$string;
398
399			}
400
401			sub require_end {
402			my $self=shift;
403			my $name=shift;
404
405			if ( $self->{reqcontext} != 1 ) {
406			$self->{switch}->parseerror("No matching tag for </$name>");
407			}
408			else {
409			$self->{reqcontext}=0;
410			}
411			}
412
413	sashby	1.8	sub select_start
414			{
415			my $self=shift;
416			my $name=shift;
417			my $hashref=shift;
418
419			$self->{switch}->checktag( $name, $hashref, 'name');
420			$$hashref{'name'}=~tr[A-Z][a-z];
421			if ( $self->{Arch} )
422			{
423			$self->verbose("Selecting ".$$hashref{'name'});
424			$self->{selected}{$$hashref{'name'}} = "SELECTED";
425			$self->verbose(">> Tool select flag = ".$self->{selected}{$$hashref{'name'}}."\n");
426			}
427			}
428
429			sub deselect_start
430			{
431			my $self=shift;
432			my $name=shift;
433			my $hashref=shift;
434
435			$self->{switch}->checktag( $name, $hashref, 'name');
436			$$hashref{'name'}=~tr[A-Z][a-z];
437			if ( $self->{Arch} )
438			{
439			$self->verbose("Deselecting ".$$hashref{'name'});
440			$self->{selected}{$$hashref{'name'}} = "DESELECTED";
441			$self->verbose(">> Tool select flag = ".$self->{selected}{$$hashref{'name'}}."\n");
442			}
443			}
444	williamc	1.2
445	sashby	1.14	sub Arch_Start
446			{
447			my $self=shift;
448			my $name=shift;
449			my $hashref=shift;
450			# Check the architecture tag:
451			$self->{switch}->checktag($name, $hashref,'name');
452			# Look for a match between the architecture flag read
453			# from the RequirementsDoc ($$hashref{name}) and scram arch:
454			#if ($self->arch() =~ /$$hashref{name}.*/)
455			# {
456
457			# }
458			#elsif ($self->arch() =~ /$$hashref{name}/)
459			# {
460			# }
461			#else
462			# {
463			# }
464			( ($self->arch()=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
465			: ($self->{Arch}=0);
466			# ( ($self->arch()=~/$$hashref{name}[BLAH]/) )? ($self->{Arch}=1)
467			# : ($self->{Arch}=0);
468	williamc	1.2
469	sashby	1.14
470			$self->verbose(($self->{Arch}?"OK":"skipping")." ".$$hashref{name});
471			push @{$self->{ARCHBLOCK}}, $self->{Arch};
472			push @{$self->{ArchStack}}, $$hashref{'name'};
473			}
474	williamc	1.2
475			sub Arch_End {
476			my $self=shift;
477			my $name=shift;
478
479			pop @{$self->{ARCHBLOCK}};
480			$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
481			}
482
483			sub disttag {
484			my $self=shift;
485			my $name=shift;
486			my $hashref=shift;
487
488			if ( exists $$hashref{'url'} ) {
489			$self->{dist}{$self->{creqtool}}{$self->{creqversion}}=
490			$$hashref{'url'};
491			}
492			}