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;

   # Only for arch of interest:
   if ($self->{Arch})
      {
      # Loop over selected tools:
      foreach $tool ( $self->selectedtools() )
         {
         $self->verbose("Setting Up Tool $tool");
         # Check to see if we have multiple versions of
         # this tool (e.g. compilers)-just look for a colon
         # which is used to separate the version entries:      
         if ( $self->version($tool) =~ /.*:.*$/)
            {
            # If so, extract versions:
            my @versions=split /:/,$self->version($tool);
            # Loop over versions of this tool and configure them:
            foreach my $tversion (@versions)
               {
               $self->verbose(">> Treating multiple versions of tool $tool: $tversion <<");
               $toolbox->toolsetup($tool, $tversion, $self->toolurl($tool));
               }
            }
         else
            {
            $toolbox->toolsetup($tool, $self->version($tool), $self->toolurl($tool));
            }
         }
      }
   else
      {
      print "No tools defined for this arch.","\n";
      return;
      }
   }

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