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 toolmanager
   {
   my $self=shift;
   
   @_ ? $self->{toolmanagerobject} = shift # 
      : $self->{toolmanagerobject};

   }

sub configversion
   {
   my $self=shift;
   @_ ? $self->{configversion} = shift # 
      : $self->{configversion};
   }

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");
            $self->configversion($switch->{configurl}->param('version'));
          }
          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";
   # So now add the list of downloaded tools, and which were
   # selected, to tool cache:
   print "Tool info cached locally.","\n","\n";

   # Now copy required info from this object to ToolManager (ToolCache):
   $self->toolmanager()->downloadedtools($self->{tools});
   $self->toolmanager()->defaultversions($self->{version});
   $self->toolmanager()->toolurls($self->{url});
   $self->toolmanager()->selected($self->selectedtools());
   }

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