src/BuildSystem/XMLRequirements.pm

#____________________________________________________________________ 
# File: XMLRequirements.pm
#____________________________________________________________________ 
#  
# Author: Shaun ASHBY <Shaun.Ashby@cern.ch>
# Update: 2005-07-26 14:56:23+0200
# Revision: $Id$ 
#
# Copyright: 2005 (C) Shaun ASHBY
#
#--------------------------------------------------------------------
package BuildSystem::XMLRequirements;
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";
   # Counter for downloaded tools: zero it here. It will
   # be auto-incremented as each tool is selected:
   $self->{selectcounter}=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 tools
   {
   my $self=shift;
   return @{$self->{tools}};
   }

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","select",
                   \&select_start,$self,
                   "", $self,
                   "", $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");
         # Set the config version. If there isn't a version, it means that we
         # have a stand-alone repository for the toolbox, rather than a CVS
         # one. Hence, no CVS tag (== version):
         ($switch->{configurl}->param('version') eq '') ?
            $self->configversion("STANDALONE") :
            $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->{selected});
   }

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->{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'});
      # Increment counter:
      $self->{selectcounter}++;
      $self->{selected}{$$hashref{'name'}}=$self->{selectcounter};
      }
   }

Revision:	1.1
Committed:	Tue Jul 26 15:14:00 2005 UTC (19 years, 9 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_0_3-p4, V1_0_3-p3, V1_0_3-p2, before110xmlBRmerge, V1_0_4p1, V1_0_3-p1, V1_0_3, V1_0_2, V1_0_2_p1
Branch point for:	v103_with_xml, v103_branch
Log Message:	Added XML version of ToolParser classes. Started to add support for upgrade mode of project command
#	User	Rev	Content
1	sashby	1.1	#____________________________________________________________________
2			# File: XMLRequirements.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun ASHBY <Shaun.Ashby@cern.ch>
6			# Update: 2005-07-26 14:56:23+0200
7			# Revision: $Id$
8			#
9			# Copyright: 2005 (C) Shaun ASHBY
10			#
11			#--------------------------------------------------------------------
12			package BuildSystem::XMLRequirements;
13			use ActiveDoc::ActiveDoc;
14			use Utilities::Verbose;
15
16			require 5.004;
17			@ISA=qw(Utilities::Verbose);
18
19			sub new
20			{
21			my $class=shift;
22			my $self={};
23			bless $self, $class;
24			$self->{dbstore}=shift;
25			$self->{file}=shift;
26			$self->{cache}=$self->{dbstore}->cache();
27
28			if ( @_ )
29			{
30			$self->arch(shift);
31			}
32			$self->verbose("Initialising a new Requirements Doc");
33			$self->{mydocversion}="2.0";
34			# Counter for downloaded tools: zero it here. It will
35			# be auto-incremented as each tool is selected:
36			$self->{selectcounter}=0;
37
38			$self->{Arch}=1;
39			push @{$self->{ARCHBLOCK}}, $self->{Arch};
40			$self->init($self->{file});
41			return $self;
42			}
43
44			sub toolmanager
45			{
46			my $self=shift;
47			@_ ? $self->{toolmanagerobject} = shift
48			: $self->{toolmanagerobject};
49			}
50
51			sub configversion
52			{
53			my $self=shift;
54			@_ ? $self->{configversion} = shift
55			: $self->{configversion};
56			}
57
58			sub url
59			{
60			my $self=shift;
61			if ( @_ )
62			{
63			$self->{file}=shift;
64			}
65			return $self->{file};
66			}
67
68			sub tools
69			{
70			my $self=shift;
71			return @{$self->{tools}};
72			}
73
74			sub version
75			{
76			my $self=shift;
77			my $tool=shift;
78			return $self->{'version'}{$tool};
79			}
80
81			sub toolurl
82			{
83			my $self=shift;
84			my $tool=shift;
85			return $self->{'url'}{$tool};
86			}
87
88			sub init
89			{
90			my $self=shift;
91			my $url=shift;
92
93			my $switch=ActiveDoc::ActiveDoc->new($self->{dbstore});
94			$switch->verbosity($self->verbosity());
95			$switch->url($url);
96			$switch->newparse("ordering");
97			$switch->addbasetags("ordering");
98
99			$switch->addtag("ordering","Architecture",
100			\&Arch_Start,$self,
101			"", $self,
102			\&Arch_End, $self);
103			$switch->addtag("ordering","select",
104			\&select_start,$self,
105			"", $self,
106			"", $self);
107			$switch->grouptag("Architecture","ordering");
108			$switch->addtag("ordering","require",
109			\&require_start,$self,
110			\&require_text, $self,
111			\&require_end, $self);
112
113			$self->{reqcontext}=0;
114			$self->{switch}=$switch;
115			undef $self->{restrictstack};
116			@{$self->{tools}}=();
117
118			my($doctype,$docversion)=$switch->doctype();
119			# -- for backwards compatability only parse if we have a docversion
120			# defined:
121			if ( defined $docversion )
122			{
123			if ($docversion eq $self->{mydocversion})
124			{
125			@{$self->{ArchStack}}=();
126			$self->verbose("Initial Document Parse");
127			$self->{switch}->parse("ordering");
128			# Set the config version. If there isn't a version, it means that we
129			# have a stand-alone repository for the toolbox, rather than a CVS
130			# one. Hence, no CVS tag (== version):
131			($switch->{configurl}->param('version') eq '') ?
132			$self->configversion("STANDALONE") :
133			$self->configversion($switch->{configurl}->param('version'));
134			}
135			else
136			{
137			$self->verbose("wrong doc version - not parsing");
138			}
139			}
140			else
141			{
142			$self->verbose("wrong doc type - not parsing");
143			}
144			}
145
146			sub arch
147			{
148			my $self=shift;
149			# $self->arch is the SCRAM_ARCH value:
150			if ( @_ )
151			{
152			$self->{arch}=shift;
153			}
154			else
155			{
156			if ( ! defined $self->{arch} )
157			{
158			$self->{arch}="";
159			}
160			}
161			return $self->{arch};
162			}
163
164			sub archlist
165			{
166			my $self=shift;
167			return @{$self->{ArchStack}};
168			}
169
170			sub getreqforarch
171			{
172			my $self=shift;
173			my $arch=shift;
174
175			if ( ! defined $self->{reqsforarch}{$arch} )
176			{
177			$self->{reqsforarch}{$arch}=
178			BuildSystem::Requirements->new($self->{dbstore},$self->{file},
179			$arch);
180			}
181			return $self->{reqsforarch}{$arch};
182			}
183
184			sub download
185			{
186			my $self=shift;
187			my $tool;
188			$\| = 1; # Unbuffer the output
189
190			print "Downloading tool descriptions....","\n";
191			print " ";
192			foreach $tool ( $self->tools() )
193			{
194			print "#";
195			$self->verbose("Downloading ".$self->toolurl($tool));
196			# get into the cache:
197			$self->{switch}->urlget($self->toolurl($tool));
198			}
199			print "\nDone.","\n";
200			# So now add the list of downloaded tools, and which were
201			# selected, to tool cache:
202			print "Tool info cached locally.","\n","\n";
203
204			# Now copy required info from this object to ToolManager (ToolCache):
205			$self->toolmanager()->downloadedtools($self->{tools});
206			$self->toolmanager()->defaultversions($self->{version});
207			$self->toolmanager()->toolurls($self->{url});
208			$self->toolmanager()->selected($self->{selected});
209			}
210
211			sub require_start
212			{
213			my $self=shift;
214			my $name=shift;
215			my $hashref=shift;
216
217			$self->{switch}->checktag( $name, $hashref, 'version');
218			$self->{switch}->checktag( $name, $hashref, 'name');
219			$self->{switch}->checktag( $name, $hashref, 'url');
220
221			if ( $self->{reqcontext} == 1 )
222			{
223			$self->{switch}->parseerror(
224			"Open new $name context without previous </$name>");
225			}
226			$self->{reqcontext}=1;
227			$$hashref{'name'}=~tr[A-Z][a-z];
228
229			# Add protection so that architecture tags are obeyed during download:
230			if ( $self->{Arch} )
231			{
232			# Add tool to the tool array:
233			push @{$self->{tools}}, $$hashref{'name'};
234
235			# If the tool already has an entry, modify the version string to
236			# include both versions. The versions can later be separated and
237			# parsed as normal:
238			if (defined $self->{version}{$$hashref{'name'}})
239			{
240			# Don't need an extra entry for this tool onto tool array:
241			pop @{$self->{tools}}, $$hashref{'name'};
242			# Modify the version string to append the other tool version.
243			# Separate using a colon:
244			my $newversion=$self->{version}{$$hashref{'name'}}.":".$$hashref{'version'};
245			$self->{version}{$$hashref{'name'}}=$newversion;
246			}
247			else
248			{
249			$self->{version}{$$hashref{'name'}}=$$hashref{'version'};
250			}
251			# -- make sure the full url is taken
252			my $urlobj=$self->{switch}->expandurl($$hashref{'url'});
253			$self->{url}{$$hashref{'name'}}=$urlobj->url();
254
255			$self->{creqtool}=$$hashref{'name'};
256			$self->{creqversion}=$$hashref{'version'};
257			$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}="";
258			}
259			}
260
261			sub require_text
262			{
263			my $self=shift;
264			my $name=shift;
265			my $string=shift;
266
267			chomp $string;
268			$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}=
269			$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}.
270			$string;
271			}
272
273			sub require_end
274			{
275			my $self=shift;
276			my $name=shift;
277
278			if ( $self->{reqcontext} != 1 )
279			{
280			$self->{switch}->parseerror("No matching tag for </$name>");
281			}
282			else
283			{
284			$self->{reqcontext}=0;
285			}
286			}
287
288			sub select_start
289			{
290			my $self=shift;
291			my $name=shift;
292			my $hashref=shift;
293
294			$self->{switch}->checktag( $name, $hashref, 'name');
295			$$hashref{'name'}=~tr[A-Z][a-z];
296			if ( $self->{Arch} )
297			{
298			$self->verbose("Selecting ".$$hashref{'name'});
299			# Increment counter:
300			$self->{selectcounter}++;
301			$self->{selected}{$$hashref{'name'}}=$self->{selectcounter};
302			}
303			}
304