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
#	Content
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