ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/BuildSystem/Requirements.pm
(Generate patch)

Comparing COMP/SCRAM/src/BuildSystem/Requirements.pm (file contents):
Revision 1.5 by sashby, Mon Oct 1 16:11:07 2001 UTC vs.
Revision 1.22 by sashby, Wed Feb 15 17:14:17 2006 UTC

# Line 21 | Line 21 | use Utilities::Verbose;
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 <        $self->verbose("Initialising a new Requirements Doc");
35 <        $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 < sub setup {
51 <        my $self=shift;
52 <        my $toolbox=shift;
53 <
54 <        my $tool;
55 <        foreach $tool ( $self->selectedtools() )
56 <           {
57 <           $self->verbose("Setting Up Tool $tool");
58 <           $toolbox->toolsetup($tool, $self->version($tool), $self->toolurl($tool));
59 <           }
60 < }
61 <
62 < sub tools {
63 <        my $self=shift;
64 <        return @{$self->{tools}};
65 < }
66 <
67 < sub selectedtools {
68 <        my $self=shift;
69 <        my @toollist=();
70 <        foreach $tool (  @{$self->{tools}} ) {
71 <          if ( $self->{selected}{$tool} == 1 ) {
72 <                push @toollist, $tool;
73 <          }
74 <        }
75 <        return @toollist;
76 < }
77 <
78 < sub toolcomment {
79 <        my $self=shift;
80 <        my $tool=shift;
81 <        my $version=shift;
82 <
83 <        return $self->{reqtext}{$tool}{$version};
84 < }
85 <
86 < sub distributionurl {
87 <        my $self=shift;
88 <        my $tool=shift;
89 <        my $version=shift;
90 <
91 <        return ( defined $self->{dist}{$tool}{$version})?
92 <                        $self->{dist}{$tool}{$version}:undef;
93 < }
94 <
95 < sub version {
96 <        my $self=shift;
97 <        my $tool=shift;
98 <        return $self->{'version'}{$tool};
99 < }
100 <
101 < sub toolurl {
102 <        my $self=shift;
103 <        my $tool=shift;
104 <        return $self->{'url'}{$tool};
105 < }
106 <
107 < sub init {
108 <        my $self=shift;
109 <        my $url=shift;
110 <
111 <        my $switch=ActiveDoc::ActiveDoc->new($self->{dbstore});
112 <        $switch->verbosity($self->verbosity());
113 <        $switch->url($url);
114 <        $switch->newparse("ordering");
115 <        $switch->addbasetags("ordering");
116 <        $switch->addtag("ordering","Architecture",
117 <                                        \&Arch_Start,$self,
118 <                                        "", $self,
119 <                                        \&Arch_End, $self);
120 <        $switch->addtag("ordering","Restrict",
121 <                                        \&Restrict_start,$self,
122 <                                        "", $self,
123 <                                        \&Restrict_end, $self);
124 <        $switch->addtag("ordering","deselect",
125 <                                        \&deselect_start,$self,
126 <                                        "", $self,
127 <                                        "", $self);
128 <        $switch->addtag("ordering","select",
129 <                                        \&select_start,$self,
130 <                                        "", $self,
131 <                                        "", $self);
132 <        $switch->addtag("ordering","distribution",
133 <                                        \&disttag,$self);
134 <        $switch->grouptag("Architecture","ordering");
135 <        $switch->addtag("ordering","require",
136 <                                        \&require_start,$self,
137 <                                        \&require_text, $self,
138 <                                        \&require_end, $self);
139 <
140 <        $self->{reqcontext}=0;
141 <        $self->{switch}=$switch;
142 <        undef $self->{restrictstack};
143 <        @{$self->{tools}}=();
144 <        
145 <        my($doctype,$docversion)=$switch->doctype();
146 <        # -- for backwards compatability only parse if we have a docversion
147 <        #    defined
148 <        if ( defined $docversion ) {
149 <          if ( $docversion eq $self->{mydocversion} ) {
150 <            @{$self->{ArchStack}}=();
151 <            $self->verbose("Initial Document Parse");
152 <            $self->{switch}->parse("ordering");
153 <          }
154 <          else {
155 <            $self->verbose("wrong doc version - not parsing");
156 <          }
157 <        }
158 <        else {
159 <          $self->verbose("wrong doc type - not parsing");
160 <        }
161 < }
162 <
163 < sub arch {
164 <        my $self=shift;
165 <        if ( @_ ) {
166 <          $self->{arch}=shift
167 <        }
168 <        else {
169 <          if ( ! defined $self->{arch} ) {
170 <            $self->{arch}="";
171 <          }
172 <        }
173 <        return $self->{arch};
174 < }
175 <
176 < sub archlist {
177 <        my $self=shift;
178 <        return @{$self->{ArchStack}};
179 < }
180 <
181 < sub getreqforarch {
182 <        my $self=shift;
183 <        my $arch=shift;
184 <
185 <        if ( ! defined $self->{reqsforarch}{$arch} ) {
186 <          $self->{reqsforarch}{$arch}=
187 <                BuildSystem::Requirements->new($self->{dbstore},$self->{file},
188 <                                                $arch);
189 <        }
190 <        return $self->{reqsforarch}{$arch};
191 < }
192 <
193 <
194 < sub download {
195 <        my $self=shift;
196 <
197 <        my $tool;
198 <        foreach $tool ( $self->tools() ) {
199 <          $self->verbose("Downloading ".$self->toolurl($tool));
200 <          # get into the cache
201 <          $self->{switch}->urlget($self->toolurl($tool));
202 <        }
203 < }
204 <
205 < sub _autoselect {
206 <        my $self=shift;
207 <        if ( @_ ) {
208 <          $self->{autoselect}=shift;
209 <        }
210 <        # -- default is true
211 <        return ((defined $self->{autoselect})?$self->{autoselect}:1);
212 < }
213 <
214 < # ---- Tag routines
215 <
216 < sub Restrict_start {
217 <        my $self=shift;
218 <        my $name=shift;
219 <        my $hashref=shift;
220 <
221 <        $self->{switch}->checktag( $name, $hashref, 'autoselect');
222 <        if ( $self->{Arch} ) {
223 <        # -- create selection state stack
224 <        push @{$self->{restrictstack}}, $self->_autoselect();
225 <        $self->_autoselect(
226 <                (($$hashref{'autoselect'}=~/true/i)?1:0));
227 <        }
228 < }
229 <
230 < sub Restrict_end {
231 <        my $self=shift;
232 <        my $name=shift;
233 <
234 <        if ( $self->{Arch} ) {
235 <        if ( $#{$self->{restrictstack}} >= 0 ) {
236 <          $self->_autoselect(pop @{$self->{restrictstack}});
237 <        }
238 <        else {
239 <          $self->{switch}->parseerror("Unmatched </$name>");
240 <        }
241 <        }
242 < }
243 <
244 < sub require_start {
245 <        my $self=shift;
246 <        my $name=shift;
247 <        my $hashref=shift;
248 <        
249 <        $self->{switch}->checktag( $name, $hashref, 'version');
250 <        $self->{switch}->checktag( $name, $hashref, 'name');
251 <        $self->{switch}->checktag( $name, $hashref, 'url');
252 <
253 <        if ( $self->{reqcontext} == 1 ) {
254 <          $self->{switch}->parseerror(
255 <                "Open new $name conext without previous </$name>");
256 <        }
257 <        $self->{reqcontext}=1;
258 <        $$hashref{'name'}=~tr[A-Z][a-z];
259 <        push @{$self->{tools}}, $$hashref{'name'};
260 <        $self->{version}{$$hashref{'name'}}=$$hashref{'version'};
261 <        # -- make sure the full url is taken
262 <        my $urlobj=$self->{switch}->expandurl($$hashref{'url'});
263 <        $self->{url}{$$hashref{'name'}}=$urlobj->url();
264 <
265 <        # -- selection
266 <        if ( $self->{Arch} ) {
267 <          if ( $self->_autoselect() ) {
268 <             $self->{selected}{$$hashref{'name'}}=1;
269 <          }
270 <          else {
271 <             $self->{selected}{$$hashref{'name'}}=0;
272 <          }
273 <        }
274 <        $self->{creqtool}=$$hashref{'name'};
275 <        $self->{creqversion}=$$hashref{'version'};
276 <        $self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}="";
277 < }
278 <
279 < sub require_text {
280 <        my $self=shift;
281 <        my $name=shift;
282 <        my $string=shift;
283 <
284 <        chomp $string;
285 <        $self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}=
286 <                $self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}.
287 <                $string;
288 <                
289 < }
290 <
291 < sub require_end {
292 <        my $self=shift;
293 <        my $name=shift;
294 <
295 <        if ( $self->{reqcontext} != 1 ) {
296 <          $self->{switch}->parseerror("No matching tag for </$name>");
297 <        }
298 <        else {
299 <          $self->{reqcontext}=0;
300 <        }
301 < }
302 <
303 < sub select_start {
304 <        my $self=shift;
305 <        my $name=shift;
306 <        my $hashref=shift;
307 <
308 <        $self->{switch}->checktag( $name, $hashref, 'name');
309 <        $$hashref{'name'}=~tr[A-Z][a-z];
310 <        if ( $self->{Arch} ) {
311 <           $self->verbose("Selecting ".$$hashref{'name'});
312 <           $self->{selected}{$$hashref{'name'}}=1;
313 <        }
314 < }
315 <
316 < sub deselect_start {
317 <        my $self=shift;
318 <        my $name=shift;
319 <        my $hashref=shift;
320 <
321 <        $self->{switch}->checktag( $name, $hashref, 'name');
322 <        $$hashref{'name'}=~tr[A-Z][a-z];
323 <        if ( $self->{Arch} ) {
324 <           $self->verbose("Deselecting ".$$hashref{'name'});
325 <           $self->{selected}{$$hashref{'name'}}=0;
326 <        }
327 < }
328 <
329 < sub Arch_Start {
330 <        my $self=shift;
331 <        my $name=shift;
332 <        my $hashref=shift;
333 <
334 <        $self->{switch}->checktag($name, $hashref,'name');
335 <        
336 <        ( ($self->arch()=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
337 <                                                : ($self->{Arch}=0);
338 <        $self->verbose(($self->{Arch}?"OK":"skipping")." ".$$hashref{name});
339 <        push @{$self->{ARCHBLOCK}}, $self->{Arch};
340 <        push @{$self->{ArchStack}}, $$hashref{'name'};
341 < }
342 <
343 < sub Arch_End {
344 <        my $self=shift;
345 <        my $name=shift;
346 <
347 <        pop @{$self->{ARCHBLOCK}};
348 <        $self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
349 < }
350 <
351 < sub disttag {
352 <        my $self=shift;
353 <        my $name=shift;
354 <        my $hashref=shift;
355 <
356 <        if ( exists $$hashref{'url'} ) {
357 <          $self->{dist}{$self->{creqtool}}{$self->{creqversion}}=
358 <                                                        $$hashref{'url'};
359 <        }
360 < }
24 > sub new
25 >   {
26 >   my $class=shift;
27 >   my $self={};
28 >   bless $self, $class;
29 >   $self->{dbstore}=shift;
30 >   $self->{file}=shift;
31 >   $self->{cache}=$self->{dbstore}->cache();
32 >
33 >   if ( @_ )
34 >      {
35 >      $self->arch(shift);
36 >      }
37 >   $self->verbose("Initialising a new Requirements Doc");
38 >   $self->{mydocversion}="2.0";
39 >   # Counter for downloaded tools: zero it here. It will
40 >   # be auto-incremented as each tool is selected:
41 >   $self->{selectcounter}=0;
42 >  
43 >   $self->{Arch}=1;
44 >   push @{$self->{ARCHBLOCK}}, $self->{Arch};
45 >   $self->init($self->{file});
46 >   return $self;
47 >   }
48 >
49 > sub toolmanager
50 >   {
51 >   my $self=shift;
52 >  
53 >   @_ ? $self->{toolmanagerobject} = shift
54 >      : $self->{toolmanagerobject};
55 >  
56 >   }
57 >
58 > sub configversion
59 >   {
60 >   my $self=shift;
61 >   @_ ? $self->{configversion} = shift
62 >      : $self->{configversion};
63 >   }
64 >
65 > sub url
66 >   {
67 >   my $self=shift;
68 >  
69 >   if ( @_ )
70 >      {
71 >      $self->{file}=shift;
72 >      }
73 >   return $self->{file};
74 >   }
75 >
76 > sub tools
77 >   {
78 >   my $self=shift;
79 >   return @{$self->{tools}};
80 >   }
81 >
82 > sub toolcomment
83 >   {
84 >   my $self=shift;
85 >   my $tool=shift;
86 >   my $version=shift;
87 >  
88 >   return $self->{reqtext}{$tool}{$version};
89 >   }
90 >
91 > sub distributionurl
92 >   {
93 >   my $self=shift;
94 >   my $tool=shift;
95 >   my $version=shift;
96 >  
97 >   return ( defined $self->{dist}{$tool}{$version})?
98 >      $self->{dist}{$tool}{$version}:undef;
99 >   }
100 >
101 > sub version
102 >   {
103 >   my $self=shift;
104 >   my $tool=shift;
105 >   return $self->{'version'}{$tool};
106 >   }
107 >
108 > sub toolurl
109 >   {
110 >   my $self=shift;
111 >   my $tool=shift;
112 >   return $self->{'url'}{$tool};
113 >   }
114 >
115 > sub init
116 >   {
117 >   my $self=shift;
118 >   my $url=shift;
119 >  
120 >   my $switch=ActiveDoc::ActiveDoc->new($self->{dbstore});
121 >   $switch->verbosity($self->verbosity());
122 >   $switch->url($url);
123 >   $switch->newparse("ordering");
124 >   $switch->addbasetags("ordering");
125 >  
126 >   $switch->addtag("ordering","Architecture",
127 >                   \&Arch_Start,$self,
128 >                   "", $self,
129 >                   \&Arch_End, $self);
130 >   $switch->addtag("ordering","select",
131 >                   \&select_start,$self,
132 >                   "", $self,
133 >                   "", $self);
134 >   $switch->grouptag("Architecture","ordering");
135 >   $switch->addtag("ordering","require",
136 >                   \&require_start,$self,
137 >                   \&require_text, $self,
138 >                   \&require_end, $self);
139 >  
140 >   $self->{reqcontext}=0;
141 >   $self->{switch}=$switch;
142 >   undef $self->{restrictstack};
143 >   @{$self->{tools}}=();
144 >  
145 >   my($doctype,$docversion)=$switch->doctype();
146 >   # -- for backwards compatability only parse if we have a docversion
147 >   #    defined:
148 >   if ( defined $docversion )
149 >      {
150 >      if ($docversion eq $self->{mydocversion})
151 >         {
152 >         @{$self->{ArchStack}}=();
153 >         $self->verbose("Initial Document Parse");
154 >         $self->{switch}->parse("ordering");
155 >         # Set the config version. If there isn't a version, it means that we
156 >         # have a stand-alone repository for the toolbox, rather than a CVS
157 >         # one. Hence, no CVS tag (== version):
158 >         ($switch->{configurl}->param('version') eq '') ?
159 >            $self->configversion("STANDALONE") :
160 >            $self->configversion($switch->{configurl}->param('version'));
161 >         }
162 >      else
163 >         {
164 >         $self->verbose("wrong doc version - not parsing");
165 >         }
166 >      }
167 >   else
168 >      {
169 >      $self->verbose("wrong doc type - not parsing");
170 >      }
171 >   }
172 >
173 > sub arch
174 >   {
175 >   my $self=shift;
176 >   # $self->arch is the SCRAM_ARCH value:
177 >   if ( @_ )
178 >      {
179 >      $self->{arch}=shift;
180 >      }
181 >   else
182 >      {
183 >      if ( ! defined $self->{arch} )
184 >         {
185 >         $self->{arch}="";
186 >         }
187 >      }
188 >   return $self->{arch};
189 >   }
190 >
191 > sub archlist
192 >   {
193 >   my $self=shift;
194 >   return @{$self->{ArchStack}};
195 >   }
196 >
197 > sub getreqforarch
198 >   {
199 >   my $self=shift;
200 >   my $arch=shift;
201 >  
202 >   if ( ! defined $self->{reqsforarch}{$arch} )
203 >      {
204 >      $self->{reqsforarch}{$arch}=
205 >         BuildSystem::Requirements->new($self->{dbstore},$self->{file},
206 >                                        $arch);
207 >      }
208 >   return $self->{reqsforarch}{$arch};
209 >   }
210 >
211 > sub download
212 >   {
213 >   my $self=shift;
214 >   my $tool;
215 >   $| = 1; # Unbuffer the output
216 >
217 >   print  "Downloading tool descriptions....","\n";
218 >   print  " ";
219 >   foreach $tool ( $self->tools() )
220 >      {
221 >      print "#";
222 >      $self->verbose("Downloading ".$self->toolurl($tool));
223 >      # get into the cache:
224 >      $self->{switch}->urlget($self->toolurl($tool));
225 >      }
226 >   print "\nDone.","\n";
227 >   # So now add the list of downloaded tools, and which were
228 >   # selected, to tool cache:
229 >   print "Tool info cached locally.","\n","\n";
230 >
231 >   # Now copy required info from this object to ToolManager (ToolCache):
232 >   $self->toolmanager()->downloadedtools($self->{tools});
233 >   $self->toolmanager()->defaultversions($self->{version});
234 >   $self->toolmanager()->toolurls($self->{url});
235 >   $self->toolmanager()->selected($self->{selected});
236 >   }
237 >
238 > sub _autoselect
239 >   {
240 >   my $self=shift;
241 >   if ( @_ )
242 >      {
243 >      $self->{autoselect}=shift;
244 >      }
245 >   # -- default is true
246 >   return ((defined $self->{autoselect})?$self->{autoselect}:1);
247 >   }
248 >
249 > sub require_start
250 >   {
251 >   my $self=shift;
252 >   my $name=shift;
253 >   my $hashref=shift;
254 >  
255 >   $self->{switch}->checktag( $name, $hashref, 'version');
256 >   $self->{switch}->checktag( $name, $hashref, 'name');
257 >   $self->{switch}->checktag( $name, $hashref, 'url');
258 >  
259 >   if ( $self->{reqcontext} == 1 )
260 >      {
261 >      $self->{switch}->parseerror(
262 >                                  "Open new $name context without previous </$name>");
263 >      }
264 >   $self->{reqcontext}=1;
265 >   $$hashref{'name'}=~tr[A-Z][a-z];
266 >  
267 >   # Add protection so that architecture tags are obeyed during download:
268 >   if ( $self->{Arch} )
269 >      {
270 >      # Add tool to the tool array:
271 >      push @{$self->{tools}}, $$hashref{'name'};
272 >      
273 >      # If the tool already has an entry, modify the version string to
274 >      # include both versions. The versions can later be separated and
275 >      # parsed as normal:
276 >      if (defined $self->{version}{$$hashref{'name'}})
277 >         {
278 >         # Don't need an extra entry for this tool onto tool array:
279 >         pop @{$self->{tools}}, $$hashref{'name'};
280 >         # Modify the version string to append the other tool version.
281 >         # Separate using a colon:
282 >         my $newversion=$self->{version}{$$hashref{'name'}}.":".$$hashref{'version'};
283 >         $self->{version}{$$hashref{'name'}}=$newversion;
284 >         }
285 >      else
286 >         {
287 >         $self->{version}{$$hashref{'name'}}=$$hashref{'version'};
288 >         }
289 >      # -- make sure the full url is taken
290 >      my $urlobj=$self->{switch}->expandurl($$hashref{'url'});
291 >
292 >      $self->{url}{$$hashref{'name'}}=$urlobj->url();
293 >
294 >      $self->{creqtool}=$$hashref{'name'};
295 >      $self->{creqversion}=$$hashref{'version'};
296 >      $self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}="";
297 >      }
298 >   }
299 >
300 > sub require_text
301 >   {
302 >   my $self=shift;
303 >   my $name=shift;
304 >   my $string=shift;
305 >  
306 >   chomp $string;
307 >   $self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}=
308 >      $self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}.
309 >      $string;  
310 >   }
311 >
312 > sub require_end
313 >   {
314 >   my $self=shift;
315 >   my $name=shift;
316 >  
317 >   if ( $self->{reqcontext} != 1 )
318 >      {
319 >      $self->{switch}->parseerror("No matching tag for </$name>");
320 >      }
321 >   else
322 >      {
323 >      $self->{reqcontext}=0;
324 >      }
325 >   }
326 >
327 > sub select_start
328 >   {
329 >   my $self=shift;
330 >   my $name=shift;
331 >   my $hashref=shift;
332 >
333 >   $self->{switch}->checktag( $name, $hashref, 'name');
334 >   $$hashref{'name'}=~tr[A-Z][a-z];
335 >   if ( $self->{Arch} )
336 >      {
337 >      $self->verbose("Selecting ".$$hashref{'name'});
338 >      # Increment counter:
339 >      $self->{selectcounter}++;
340 >      $self->{selected}{$$hashref{'name'}}=$self->{selectcounter};
341 >      }
342 >   }
343 >
344 > sub Arch_Start
345 >   {
346 >   my $self=shift;
347 >   my $name=shift;
348 >   my $hashref=shift;
349 >  
350 >   # Check the architecture tag:
351 >   $self->{switch}->checktag($name, $hashref,'name');  
352 >   ( ($self->arch()=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
353 >      : ($self->{Arch}=0);
354 >  
355 >   $self->verbose(($self->{Arch}?"OK":"skipping")." ".$$hashref{name});
356 >   push @{$self->{ARCHBLOCK}}, $self->{Arch};
357 >   push @{$self->{ArchStack}}, $$hashref{'name'};
358 >   }
359 >
360 > sub Arch_End
361 >   {
362 >   my $self=shift;
363 >   my $name=shift;
364 >   pop @{$self->{ARCHBLOCK}};
365 >   $self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
366 >   }
367 >
368 > sub disttag
369 >   {
370 >   my $self=shift;
371 >   my $name=shift;
372 >   my $hashref=shift;
373 >  
374 >   if ( exists $$hashref{'url'} )
375 >      {
376 >      $self->{dist}{$self->{creqtool}}{$self->{creqversion}}=
377 >         $$hashref{'url'};
378 >      }
379 >   }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines