ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/clientfile.pm
Revision: 1.11
Committed: Wed Mar 31 11:47:39 1999 UTC (26 years, 1 month ago) by williamc
Content type: text/plain
Branch: MAIN
CVS Tags: ProtoEnd, V0_9_1, V0_9, V0_8, V0_7, V0_6
Branch point for: V0_9branch
Changes since 1.10: +7 -2 lines
Log Message:
Add Architecture flag for Requirements doc

File Contents

# Content
1 # Make a client specific file for external products
2 #
3 #
4
5 package clientfile;
6 require 5.001;
7 require Exporter;
8 @ISA = qw(Exporter);
9 @EXPORT = qw(BuildClientFile);
10
11 $scramdir="$ENV{INTwork}/SCRAM";
12 $Arch=1;
13 push @ARCHBLOCK, $Arch;
14
15 sub BuildClientFile {
16 my $projectfile=shift;
17 use ToolBox;
18
19 openclientfile('new') and return;
20 $toolbox=ToolBox->new();
21 print CLIENT "# Machine Generated File - do not edit\n";
22 _ParseProjectReqs($projectfile);
23 &closeclientfile;
24 }
25
26 sub closeclientfile {
27 close INSTALLLOG;
28 close CLIENT;
29 close CLIENT2;
30 }
31
32 sub openclientfile {
33 my $action=shift;
34 my $archdir=".SCRAM/$ENV{SCRAM_ARCH}";
35 my $clientfile="$archdir/clientsettings";
36 use Utilities::AddDir;
37
38 AddDir::adddir($archdir);
39 if ( $action=~/add/i ) {
40 $actionop='>>';
41 initialiseclient($clientfile);
42 }
43 else { #default is new
44 $actionop='>';
45 initialiseclient($clientfile) or return 1; # get out if it already exists
46 }
47 open ( CLIENT, "$actionop$ENV{LOCALTOP}/$clientfile" ) ||
48 die "clientfile: Cannot open clientsettings file "
49 ."$clientfile $!\n";
50 open ( CLIENT2, "$actionop$ENV{LOCALTOP}/".$clientfile."_reqs" ) ||
51 die "clientfile: Cannot open clientsettings file "
52 ."$clientfile $!\n";
53 open (INSTALLLOG, "$actionop$archdir/installation_log")
54 || die "clientfile: Cannot open log file $!\n";
55 return 0;
56 }
57
58 sub _ParseProjectReqs {
59 my $reqfile=shift;
60 use Utilities::Switcher;
61
62 $taglist={
63 'require' => 'none',
64 'require_starttag' => \&Require_start,
65 'Architecture_StartTag' => \&Arch_Start,
66 'Architecture_EndTag' => \&Arch_End,
67 'Architecture' => 'none'
68 };
69
70 $switch=Switcher->new($taglist,"$reqfile");
71 $switch->parse();
72 }
73
74 sub Require_start {
75 my $name=shift;
76 my @vars=@_;
77 my $hashref;
78
79 $hashref=$switch->SetupValueHash(\@vars);
80
81 if ( $Arch ) {
82 push @toollist, $$hashref{'name'};
83 if ( ! ( defined $$hashref{'version'} ) ) {
84 print INSTALLLOG "Error : Undefined version for $$hashref{'name'}\n";
85 exit;
86 }
87 if ( ! ( defined $$hashref{'url'} ) ) { #must be local if not defined
88 $$hashref{'url'}="file:$$hashref{'name'}";
89 }
90 _tool($$hashref{'url'});
91 }
92 }
93
94
95 #---------------------------------------------------------------------------
96 # ToolFile Parsing
97 #
98 #---------------------------------------------------------------------------
99
100 sub _gettool {
101 # set the $toolfile variable
102 my $toolurl=shift;
103 my @toolpath= split /:/, $ENV{SCRAM_BootStrapFiles};
104 my $method;
105 my $tool;
106
107 ( $method, $tool )=split /:/, $toolurl;
108 # file method - refers to a file in a PATH type variable
109 if ( $method=~/file/i ) {
110 foreach $path ( @toolpath ) {
111 if ( -e $path."/".$tool ) {
112 $toolfile=$path."/".$tool;
113 return 0;
114 }
115 }
116 return 1;
117 }
118 else {
119 print "Only 'file:' method supported in this version\n";
120 return 1;
121 }
122 }
123
124 # process the tool files
125 # Assume a libtool context for now - i.e Compiler Implied
126 sub _tool {
127 my $name=shift;
128 my $toollist;
129
130 if ( (_gettool($name))) {
131 die "Warning : Could not locate $name description file\n";
132 return;
133 }
134 $toollist={
135 'Tool_StartTag' => \&_toolsetting,
136 'Tool_EndTag' => \&_toolunset,
137 'Tool' => 'none',
138 'Environment' => \&Env,
139 'Environment_StartTag' => \&Env_start,
140 'Environment_EndTag' => \&Env_finish,
141 'Type' => 'none',
142 'Type_StartTag' => \&type_start,
143 'Type_EndTag' => \&type_end,
144 'System' => \&system_body,
145 'Splice' => 'none',
146 'Splice_starttag' => \&splice_start,
147 'Client' => 'none',
148 'LIB' => 'none',
149 'LIB_StartTag' => \&lib_start,
150 'Architecture_StartTag' => \&Arch_Start,
151 'Architecture_EndTag' => \&Arch_End,
152 'Architecture' => 'none',
153 'Function' => 'none',
154 'Function_StartTag' => \&Function_start,
155 'Function_EndTag' => \&Function_end,
156 'External' => 'none',
157 'External_StartTag' => \&External_client,
158 };
159 # 'INCLUDE_StartTag' => \&INCLUDE_start ,
160
161 use Utilities::Switcher;
162 $toolswitch=Switcher->new($toollist,$toolfile);
163 $toolswitch->parse();
164
165
166 }
167
168 # If weve got an include and we are in client context
169 # then search for the string
170 # multiple defaults can be specified > colon seperated
171 #
172
173 sub External_client {
174 my $name=shift;
175 my @vars=@_;
176 my $hashref;
177
178 $hashref=$toolswitch->SetupValueHash( \@vars );
179 $toolswitch->checkparam( $hashref, $name, 'ref' );
180 $$hashref{ref}=~tr[A-Z][a-z];
181 print CLIENT2 <<ENDTEXT;
182 ifdef $toolname
183 $$hashref{ref}=true
184 endif
185 ENDTEXT
186 }
187
188 sub Arch_Start {
189 my $name=shift;
190 my @vars=@_;
191 my $hashref;
192
193 $hashref=$toolswitch->SetupValueHash( \@vars );
194 $toolswitch->checkparam($hashref, $name, 'name');
195 #( ($$hashref{name}=~/$ENV{SCRAM_ARCH}/) )?$Arch=1:$Arch=0;
196 ( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($Arch=1) : ($Arch=0);
197 push @ARCHBLOCK, $Arch;
198 }
199 sub Arch_End {
200 my $name=shift;
201 my @vars=@_;
202
203 pop @ARCHBLOCK;
204 $Arch=$ARCHBLOCK[$#ARCHBLOCK];
205 }
206
207 sub lib_start {
208 my $name=shift;
209 my @vars=@_;
210 my $hashref;
211
212 $hashref=$toolswitch->SetupValueHash( \@vars );
213 $toolswitch->checkparam($hashref, $name, 'name');
214 if ( $Arch ) {
215 push @{$Envtype{lib}}, $$hashref{'name'};
216 outclient($name,$$hashref{'name'},"D");
217 }
218 }
219
220 sub Env_start {
221 my $name=shift;
222 my @vars=@_;
223 $Envhashref;
224
225 if ( $toolswitch->context("environment") ) {
226 print "clientfile Error: Missing </environment> tag on line ".
227 "$toolswitch->{linecount} in file $toolswitch->{filename}\n";
228 exit 1;
229 }
230 if ( $Arch ) {
231 $Envhashref=$toolswitch->SetupValueHash( \@vars );
232 $toolswitch->checkparam($Envhashref, $name, 'name');
233 if ( $$Envhashref{'value'} eq "" ) {
234 SWITCH: {
235 #try and get from the environment
236 if ( defined $ENV{$$Envhashref{'name'}} ) {
237 $$Envhashref{'value'}=$ENV{$$Envhashref{'name'}};
238 outclient( $$Envhashref{'name'}, $$Envhashref{'value'}, "E");
239 last SWITCH;
240 }
241 # try the default locations specified by default flag
242 if ( (&checkdefault($Envhashref))) {
243 $$Envhashref{'value'}=$$Envhashref{'default'};
244 outclient( $$Envhashref{'name'}, $$Envhashref{'default'}, "D");
245 last SWITCH;
246 }
247 print "\nCannot Determine value $$Envhashref{'name'} :\n";
248 } #end SWITCH
249 }
250 else {
251 $$Envhashref{'value'}=&expandvars($$Envhashref{'value'});
252 outclient( $$Envhashref{'name'}, $$Envhashref{'value'}, "D" );
253 }
254 }
255 }
256
257 sub Env {
258 my $name=shift;
259 my @vars=@_;
260
261 if ( $Arch ) {
262 if ( $$Envhashref{'value'} eq "" ) {
263 print @vars;
264 }
265 }
266
267 }
268 sub Env_finish {
269 my $name=shift;
270 my @vars=@_;
271 my $hashref;
272
273 if ( $Arch ) {
274 $testarrayref=undef;
275 if ( $$Envhashref{'value'} eq "" ) {
276 $$Envhashref{'value'} = &askuser("Please Enter the Value Below:",
277 $$Envhashref{'name'}, $Envhashref);
278 }
279 $ToolEnv{$$Envhashref{'name'}}=$$Envhashref{'value'};
280 }
281 }
282
283 #
284 # Ask User for a specific value
285 #
286
287 sub askuser {
288 my $querystring=shift;
289 my $varname=shift;
290 my $hashref=shift;
291 my $path;
292
293 for ( ;; ) {
294 print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
295 $path=<STDIN>;
296 chomp $path;
297 if ( $path ne "" ) {
298 if ( $toolswitch->context('client')) { # must be a location
299 if ( &_testlocation($path , "H", $hashref) ) {
300 return $path;
301 }
302 print "Error : ".$path." does not exist.\n";
303 next;
304 }
305 else {
306 outclient($varname, $path, "H");
307 return $path;
308 }
309 }
310 else {
311 print INSTALLLOG "Warning: Missing $varname for $toolname\n";
312 outclient($varname, "UNDEFINED", "U");
313 return;
314 }
315 } #end while
316 }
317
318 #
319 # Output to Screen and Install Log
320 #
321
322 sub outclient {
323 my $name=shift;
324 my $value=shift;
325 my $tag=shift;
326
327 print CLIENT $toolkey."::$name:".expandvars($value).":$tag\n";
328 print INSTALLLOG "$name set to $value\n";
329 }
330
331 #
332 #
333 #
334
335 sub checkdefault {
336 my $hashref=shift;
337
338 if ( defined $$hashref{'default'} ) { #check default
339 my $default;
340 foreach $default ( split /:/, $$hashref{'default'} ) {
341 $default=~s/\"//;
342 if ( _testlocation($default,
343 $Envtype{$$hashref{'type'}})) { return 1; }
344 }
345 }
346 return 0;
347 }
348
349 #
350 #
351 #
352 sub _dirchecktest {
353 $var=shift;
354 my @vars=@_;
355 my $hashref;
356 my $key;
357
358 if ( $Arch ) {
359 $hashref=$toolswitch->SetupValueHash( \@vars );
360 if ( $toolswitch->context('client')=='0' ) {
361 # outside client context - abort for now
362 print "Error :- $var outside of CLIENT\n";
363 exit
364 }
365 # In client context we need to setup the client file
366 testblock: {
367 if ( defined $site{$toolkey.":".$var} ) {
368 last testblock
369 if _testlocation($site{$toolkey.":".$var}, undef);
370 }
371 print "Searching for $var relating to $toolname $toolversion\n";
372 #
373 # Check Base Release
374 #
375 #
376 # Check The Default Location
377 #
378 if ( defined $$hashref{'default'} ) { #check default
379 my $default;
380 foreach $default ( split /:/, $$hashref{'default'} ) {
381 $default=~s/\"//;
382 last testblock if _testlocation($default, undef);
383 }
384 }
385 #
386 # last resort - ask the user
387 #
388 print "Unable to find $var for $toolname\n";
389 askuser("Please Enter the $var path", $var, $hashref);
390 } # end testblock
391 }
392 }
393
394 #
395 #
396 #
397 sub _toolsetting {
398 my $var=shift;
399 my @vars=@_;
400 my $hashref;
401
402 $hashref=$toolswitch->SetupValueHash( \@vars );
403 $toolswitch->checkparam($hashref, $var, 'name');
404 $toolname=$$hashref{'name'};
405 $toolversion=$$hashref{'version'};
406 $toolkey=$toolname.":".$toolversion;
407 $ToolEnv{'SCRAMtoolname'}=$toolname;
408 $ToolEnv{'SCRAMtoolversion'}=$toolversion;
409 %Envtype=(); # reset file types hash;
410 print "\n";
411 print "--------------- Setting up $toolname $toolversion ----------\n";
412 }
413
414 #
415 #
416 #
417 sub _toolunset {
418 $toolname=undef;
419 $toolversion=undef;
420 $toolkey=undef;
421 %ToolEnv=();
422 %Envtype=();
423 }
424
425 #
426 # Add some functionality to modify environment variables at build time
427 #
428 sub splice_start {
429 my $var=shift;
430 my @vars=@_;
431 my $hashref;
432
433 $hashref=$toolswitch->SetupValueHash( \@vars );
434 $toolswitch->checkparam($hashref, $var, 'variable');
435 $toolswitch->checkparam($hashref, $var, 'operator');
436
437 print CLIENT $toolkey."::&tool_splice($$hashref{variable},".
438 "\"$$hashref{operator}\")\n";
439
440 }
441
442 sub type_start {
443 my $var=shift;
444 my @vars=@_;
445 my $hashref;
446
447 $hashref=$toolswitch->SetupValueHash( \@vars );
448 $toolswitch->checkparam($hashref, $var, 'name');
449 $toolswitch->checkparam($hashref, $var, 'variable');
450 $toolswitch->checkparam($hashref, $var, 'value');
451
452 push @{$TypeEnvHash{$$hashref{'variable'}}}, $$hashref{value};
453 push @{$TypeName{$$hashref{'variable'}}}, $$hashref{name};
454 push @TypeStack, $$hashref{variable};
455 #$TypeToolEnv{$$hashref{'variable'}}=$$hashref{'variable'};
456 print CLIENT $toolkey.":$$hashref{name}:&tool_splice(outfile,".
457 "\"s/(.*)/\\1__$$hashref{name}/\")\n";
458 }
459
460 sub type_end {
461 my $temp;
462 $temp=pop @TypeStack;
463 pop @{$TypeEnvHash{$temp}};
464 pop @{$TypeNameHash{$temp}};
465 }
466
467 sub Function_start {
468 my $var=shift;
469 my @vars=@_;
470 my $hashref;
471
472 $hashref=$toolswitch->SetupValueHash( \@vars );
473 $toolswitch->checkparam($hashref, $var, 'out');
474 $toolswitch->checkparam($hashref, $var, 'in');
475 $functin=$$hashref{in};
476 $functout=$$hashref{out};
477
478 push @functinStack, $functin;
479 push @functoutStack, $functout;
480 }
481
482 sub Function_end {
483 pop @functinStack;
484 pop @functoutStack;
485 }
486
487 # utility routine for sytem tag
488 sub _localenvset($) {
489 my $num=shift;
490 my $fail=0;
491 my $var;
492 foreach $var ( keys %TypeEnvHash ) {
493 $TypeLocalHash{$var}=undef;
494 $TypeLocalName{$var}=undef;
495 if ( $#{$TypeEnvHash{$var}} > $num ) {
496 $fail=1;
497 $TypeLocalHash{$var}=${$TypeEnvHash{$var}}[$num];
498 $TypeLocalName{$var}=${$TypeName{$var}}[$num];
499 }
500 }
501 return $fail;
502 }
503
504 sub system_body {
505 my $name=shift;
506 my @vars=@_;
507 my $string;
508 my $var;
509 my $var2;
510 my @typelist;
511 use ToolBox;
512
513 $string=join '', @_;
514
515 # Replace any newlines with semicolons
516 $string=~s/\n/\;/g;
517 # Get rid of any multiple semicolons
518 $string=~s/\;\;*/\;/g;
519 # Now cycle over all the possible variable values for each type
520 # to substitute the $type:: markers
521 my $n=0;
522 %TypeLocalHash=();
523 %TypeLocalName=();
524 while ( _localenvset($n) ) {
525 foreach $var ( keys %TypeLocalHash) {
526 @typelist=();
527 foreach $var2 ( keys %TypeLocalHash ) {
528 if ( $var2 ne $var ) {
529 push @typelist, $TypeLocalName{$var2};
530 }
531 }
532 my $temp=$TypeLocalHash{$var};
533 my $nv=0;
534 foreach $value ( @{$TypeEnvHash{$var}} ) {
535 $TypeLocalHash{$var}=$value;
536 my @names=(@typelist, $TypeName{$var}[$nv++]);
537 ($thisstring=$string)
538 =~s/\$type::(.*?)( |\/|\Z)/$TypeLocalHash{$1}$2/g;
539 $toolbox->addtotoolbox($functout, $functin, $toolkey,
540 $thisstring, @names);
541 }
542 $TypeLocalHash{$var}=$temp;
543 }
544 $n++;
545 }
546 }
547
548 #
549 # Tests $path directory for filenames with the words in testfiles array.
550 #
551
552 sub _testlocation($path, \@testfiles) {
553 my $default=shift;
554 my $testfiles=shift;
555 my $OK='false';
556 my $file;
557
558 chomp $default;
559 $default=&expandvars($default);
560 print "Trying $default .... ";
561 opendir DIRHANDLE, $default or do { print "No\n"; return 0; };
562 ($#{$testfiles}==-1) ? $OK='false' : $OK='true';
563 print "\n";
564 my @files=readdir DIRHANDLE;
565 close DIRHANDLE;
566 foreach $file ( @$testfiles ) {
567 print " Checking for $file .... ";
568 # now check that the required files are actually there
569 if ( ( $number = grep /$file/, @files) == 0 ) {
570 $OK='false';
571 print "not found\n";
572 last;
573 }
574 print "found\n";
575 }
576 if ( $OK eq 'true' ) {
577 print "Directory Check Complete\n";
578 return 1
579 }
580 return 0
581 }
582
583 #
584 # Expand any variables defined with $ in the string (local context of tool only)
585 #
586
587 sub expandvars ($string) {
588 my $string=shift;
589 $string=~s/\$(.*?)( |\/|\Z)/$ToolEnv{$1}$2/g;
590 return $string;
591 }
592
593 sub initialiseclient {
594 my $clientfile=shift;
595 use File::Copy;
596 my ( $name, $version, $var, @rest);
597
598 #if it dosnt exist locally try and get a copy from the releasetop
599 if ( ! (-f "$ENV{LOCALTOP}/$clientfile" ) ) {
600 copy ( "$ENV{RELEASETOP}/$clientfile","$ENV{LOCALTOP}/$clientfile" );
601 }
602 if ( ! (-f "$ENV{LOCALTOP}/".$clientfile."_reqs" ) ) {
603 copy ( "$ENV{RELEASETOP}/".$clientfile."_reqs","$ENV{LOCALTOP}/".$clientfile."_reqs" );
604 }
605 # now read it in to memory for future reference
606 open (CLIENTFILEIN, "<$ENV{LOCALTOP}/$clientfile") or return 1;
607 ($name, $version, $var, @rest ) = split /:/;
608 $key="$name:$version:$var";
609 $site{$key}=@rest;
610 close CLIENTFILEIN;
611 return 0;
612 }
613