src/BuildSystem/ToolSettingValidator.pm

#____________________________________________________________________ 
# File: BuildSystem::ToolSettingValidator.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2004-10-14 10:16:21+0200
# Revision: $Id: ToolSettingValidator.pm,v 1.1.2.2 2004/10/22 17:12:30 sashby Exp $ 
#
# Copyright: 2004 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package BuildSystem::ToolSettingValidator;
require 5.004;

use Exporter;
@ISA=qw(Exporter);
@EXPORT_OK=qw( );

sub new()
  ###############################################################
  # new                                                         #
  ###############################################################
  # modified : Thu Oct 14 10:16:25 2004 / SFA                   #
  # params   :                                                  #
  #          :                                                  #
  # function :                                                  #
  #          :                                                  #
  ###############################################################
  {
  my $proto=shift;
  my $class=ref($proto) || $proto;
  my $self={};
  
  # Store the list of known environments:
  my ($environments,$toolname,$interactive) = @_;

  $self->{TOOLNAME}    = $toolname;
  $self->{ENVIRONMENT} = $environments->{ENVIRONMENT};
  $self->{RUNTIME}     = $environments->{RUNTIME};
  $self->{VARDATA}     = {}; # Somewhere to store the variables
  $self->{LOCALENV}    = \%ENV;
  $self->{STATUS}      = { 0 => $main::good."[OK]".$main::normal, 1 => $main::error."[FAIL]".$main::normal };
  $self->{INVALIDPATHERRORMSG} = $main::error."Invalid path...please try again!".$main::normal;

  # Are we interactive or not?
  $self->{INTERACTIVE} = $interactive;
  
  bless $self,$class;
  return $self;
  }

sub findvalue()
   {
   my $self=shift;
   my ($name, $data) = @_;
   my $stringtoeval;
   my $path;
   
   # See if there's a default/value in our data element:
   if ($self->checkdefaults($data,\$stringtoeval))
      {
      # OK, there's a def/val. 
      $path = $self->_expandvars($stringtoeval);
      
      if ($self->validatepath($path))
         {
         # Save in VARDATA:
         $self->savevalue($name,$path);
         }
      else
         {
         # Prompt user for a value:
         $path = $self->promptuser($name);                  
         }               
      }
   else
      {
      # Path was invalid. Fall back to prompting:
      $path = $self->promptuser($name);
      }
   
   # Return the path:
   return $path;
   }

sub ifindvalue()
   {
   my $self=shift;
   my ($name, $data) = @_;
   my $stringtoeval;
   my ($dpath,$path);

   # See if there's a default/value in our data element:
   if ($self->checkdefaults($data,\$stringtoeval))
      {
      # OK, there's a def/val. 
      $dpath = $self->_expandvars($stringtoeval);
      
      if ($self->validatepath($dpath))
         {
         $path = $self->promptuser($name,$dpath);
         # Save in VARDATA:
         $self->savevalue($name, $path);
         }
      else
         {
         # Prompt user for a value:
         $path = $self->promptuser($name);
         }               
      }
   else
      {      
      # Path was invalid. Fall back to prompting:
      $path = $self->promptuser($name);
      }
   
   # Return the path:
   return $path;
   }

sub savevalue()
   {
   my $self = shift;
   my ($varname, $path) = @_;

   if ($varname && $path)
      {
      $self->{VARDATA}->{$varname} = $path;
      }

   return;
   }

sub environment()
   {
   my $self = shift;
   my ($type, $varname) = @_;

   if ($type && $varname)
      {
      if (exists($self->{uc($type)}->{$varname}))
         {
         # Return the tag data:
         return $self->{uc($type)}->{$varname};
         }
      else
         {
         # No tag data so return 0:
         return 0;
         }
      }
   elsif ($type)
      {
      # Return all environments of type $type:
      return $self->{uc($type)};
      }
   else
      {
      print "SCRAM: Unknown tag type/var name","\n";
      }
   }

sub validatepath()
   {
   my $self = shift;
   my ($pathvalue) = @_;
   my $path;

   # Either we use the pathvalue supplied or
   # we use PATHFROMDB:
   if ($pathvalue)
      {
      $path = $pathvalue;
      }
   else
      {
      $path = $self->{PATHFROMDB};
      }
   
   print "\tChecks ", if ($path);
   
   if ( -f $path)
      {
      # File exists:
      print $self->{STATUS}->{0}." for $path","\n";
      return 1;
      }
   else
      {
      use DirHandle;
      my $dh = DirHandle->new();
      
      opendir $dh, $path or do
         {
         # No path:
         print $self->{STATUS}->{1}." for $path","\n", unless ($path eq '');
         return 0;
         };
      
      # Dir found:
      print $self->{STATUS}->{0}." for $path","\n";
      return 1;
      }
   }

sub checkdefaults()
   {
   my $self=shift;
   my ($vardata,$pathtoevalref) = @_;

   # If $vardata is actually an array (which it will
   # be if there is more than one VAR element), dereference
   # to get only the first hash entry (this is fine as the
   # block of code to handle nmore than one element will loop
   # over all elements of the array so that a hash is passed
   # to this routine:
   if (ref($vardata) eq 'ARRAY')
      {
      $data = $vardata->[0];
      }
   else
      {
      $data = $vardata;
      }

   
   if (exists($data->{'default'}))
      {
      $$pathtoevalref = $data->{'default'};
      }
   elsif (exists($data->{'value'}))
      {
      $$pathtoevalref = $data->{'value'};
      }
   else
      {
      # No value or default. Return 0:
      return 0;
      }

   return 1;
   }

sub pathfromdb()
   {
   my $self=shift;
   return $self->{PATHFROMDB};
   }

sub checkDB()
   {
   my $self = shift;
   my ($varname) = @_;
   
   if ($::lookupdb->checkTool($self->{TOOLNAME}))
      {
      $pathfromdb = $::lookupdb->lookupTag($self->{TOOLNAME}, $varname);

      if ($pathfromdb ne "")
         {
         $self->{PATHFROMDB} = $pathfromdb;
         return 1;
         }
      else
         {
         return 0;     
         }
      }
   else
      {
      return 0;
      }
   }

sub _expandvars()
   {
   my $self=shift;
   my ($string) = @_;
   
   return "" , if ( ! defined $string );
   
   # To evaluate variables in brackets, like $(X):
   $string =~ s{\$\((\w+)\)}
      {
      if (defined $self->{VARDATA}->{$1})
         {
         $self->_expandvars($self->{VARDATA}->{$1});
         }
      elsif (defined $self->{LOCALENV}->{$1})
         {
         $self->_expandvars($self->{LOCALENV}->{$1});
         }
      else
         {
         "\$$1";
         }
      }egx;
   
   # To evaluate variables like $X:
   $string =~ s{\$(\w+)}
      {
      if (defined $self->{VARDATA}->{$1})
         {
         $self->_expandvars($self->{VARDATA}->{$1});
         }
      elsif (defined $self->{LOCALENV}->{$1})
         {
         $self->_expandvars($self->{LOCALENV}->{$1});
         }
      else
         {
         "\$$1";
         }
      }egx;

   # Now return false if the string wasn't properly evaluated (i.e. some $ remain), otherwise
   # return the expanded string:
   ($string =~ /\$/) ? return undef : return $string;
   }

sub promptuser()
   {
   my $self=shift;
   my ($varname, $default)=@_;
   my $pathvalue;
   my $novalid = 1;
   my $dummy = '';
   my $ORKEEP = '';
   print "\n";

   while ($novalid)
      {
      if ($self->interactive())
         {
         # Only mention the default stuff if default actually has
         # a value. It might not (e.g., in the case of a new tool)
         if ($default ne '')
            {
            print "Default value is $default","\n", unless ($default eq '');
            $ORKEEP=' (or <ret> to keep)';
            }

         print "\n";
         print $main::prompt."Please Enter a Value$ORKEEP: > ".$main::normal;

         $dummy = <STDIN>;
         chomp($dummy);
         # If we have an empty string, return the default value:
         if ($dummy eq '' && $default ne '')
            {
            return $default;
            }
         print "\n"
         }
      else
         {
         print "\n";
         print $main::prompt."Please Enter a Value: > ".$main::normal;
         $dummy = <STDIN>;
         chomp($dummy);
         }
      
      print "\n";
      # Also use _expandvars() here so that env variables
      # can be used:

      $pathvalue=$self->_expandvars($dummy);
      if ($self->validatepath($pathvalue))
         {
         $novalid = 0;
         $self->{VARDATA}->{$varname} = $pathvalue;
         }
      else
         {
         print $self->{INVALIDPATHERRORMSG},"\n";
         }
      }
   
   # Return the path:
   return $pathvalue;
   }

sub interactive()
   {
   my $self=shift;
   return $self->{INTERACTIVE};
   }

sub promptuserforvar()
   {
   my $self=shift;
   my ($varname, $default)=@_;
   my $value;
   my $novalid = 1;
   my $dummy = '';
   my $ORKEEP = '';

   print "\n";

   while ($novalid)
      {
      if ($self->interactive())
         {
         # Only mention the default stuff if default actually has
         # a value. It might not (e.g., in the case of a new tool)
         if ($default ne '')
            {
            print "Default value for $varname is $default","\n", unless ($default eq '');
            $ORKEEP=' (or <ret> to keep)';
            }
         
         print "\n";
         print $main::prompt."Please Enter a Value$ORKEEP: > ".$main::normal;
         $dummy = <STDIN>;
         chomp($dummy);  
         # If we have an empty string, set to the default value:
         if ($dummy eq '')
            {
            $dummy = $default;
            }
         
         print "\n";
         }
      else
         {
         print "\n";
         print $main::prompt."Please Enter a Value: > ".$main::normal;
         $dummy = <STDIN>;
         chomp($dummy);
         }

      print "\n";
      # Also use _expandvars() here so that env variables
      # can be used:
      $value = $self->_expandvars($dummy);
      print "Runtime variable ",$varname," set to \"",$value,"\"\n";
      $novalid = 0;
      }
   
   # Return the path:
   return $value;
   }

1;
Revision:	1.2
Committed:	Fri Dec 10 13:41:37 2004 UTC (20 years, 4 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
Changes since 1.1:	+444 -0 lines
Log Message:	Merged V1_0 branch to HEAD
#	User	Rev	Content
1	sashby	1.2	#____________________________________________________________________
2			# File: BuildSystem::ToolSettingValidator.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Update: 2004-10-14 10:16:21+0200
7			# Revision: $Id: ToolSettingValidator.pm,v 1.1.2.2 2004/10/22 17:12:30 sashby Exp $
8			#
9			# Copyright: 2004 (C) Shaun Ashby
10			#
11			#--------------------------------------------------------------------
12			package BuildSystem::ToolSettingValidator;
13			require 5.004;
14
15			use Exporter;
16			@ISA=qw(Exporter);
17			@EXPORT_OK=qw( );
18
19			sub new()
20			###############################################################
21			# new #
22			###############################################################
23			# modified : Thu Oct 14 10:16:25 2004 / SFA #
24			# params : #
25			# : #
26			# function : #
27			# : #
28			###############################################################
29			{
30			my $proto=shift;
31			my $class=ref($proto) \|\| $proto;
32			my $self={};
33
34			# Store the list of known environments:
35			my ($environments,$toolname,$interactive) = @_;
36
37			$self->{TOOLNAME} = $toolname;
38			$self->{ENVIRONMENT} = $environments->{ENVIRONMENT};
39			$self->{RUNTIME} = $environments->{RUNTIME};
40			$self->{VARDATA} = {}; # Somewhere to store the variables
41			$self->{LOCALENV} = \%ENV;
42			$self->{STATUS} = { 0 => $main::good."[OK]".$main::normal, 1 => $main::error."[FAIL]".$main::normal };
43			$self->{INVALIDPATHERRORMSG} = $main::error."Invalid path...please try again!".$main::normal;
44
45			# Are we interactive or not?
46			$self->{INTERACTIVE} = $interactive;
47
48			bless $self,$class;
49			return $self;
50			}
51
52			sub findvalue()
53			{
54			my $self=shift;
55			my ($name, $data) = @_;
56			my $stringtoeval;
57			my $path;
58
59			# See if there's a default/value in our data element:
60			if ($self->checkdefaults($data,\$stringtoeval))
61			{
62			# OK, there's a def/val.
63			$path = $self->_expandvars($stringtoeval);
64
65			if ($self->validatepath($path))
66			{
67			# Save in VARDATA:
68			$self->savevalue($name,$path);
69			}
70			else
71			{
72			# Prompt user for a value:
73			$path = $self->promptuser($name);
74			}
75			}
76			else
77			{
78			# Path was invalid. Fall back to prompting:
79			$path = $self->promptuser($name);
80			}
81
82			# Return the path:
83			return $path;
84			}
85
86			sub ifindvalue()
87			{
88			my $self=shift;
89			my ($name, $data) = @_;
90			my $stringtoeval;
91			my ($dpath,$path);
92
93			# See if there's a default/value in our data element:
94			if ($self->checkdefaults($data,\$stringtoeval))
95			{
96			# OK, there's a def/val.
97			$dpath = $self->_expandvars($stringtoeval);
98
99			if ($self->validatepath($dpath))
100			{
101			$path = $self->promptuser($name,$dpath);
102			# Save in VARDATA:
103			$self->savevalue($name, $path);
104			}
105			else
106			{
107			# Prompt user for a value:
108			$path = $self->promptuser($name);
109			}
110			}
111			else
112			{
113			# Path was invalid. Fall back to prompting:
114			$path = $self->promptuser($name);
115			}
116
117			# Return the path:
118			return $path;
119			}
120
121			sub savevalue()
122			{
123			my $self = shift;
124			my ($varname, $path) = @_;
125
126			if ($varname && $path)
127			{
128			$self->{VARDATA}->{$varname} = $path;
129			}
130
131			return;
132			}
133
134			sub environment()
135			{
136			my $self = shift;
137			my ($type, $varname) = @_;
138
139			if ($type && $varname)
140			{
141			if (exists($self->{uc($type)}->{$varname}))
142			{
143			# Return the tag data:
144			return $self->{uc($type)}->{$varname};
145			}
146			else
147			{
148			# No tag data so return 0:
149			return 0;
150			}
151			}
152			elsif ($type)
153			{
154			# Return all environments of type $type:
155			return $self->{uc($type)};
156			}
157			else
158			{
159			print "SCRAM: Unknown tag type/var name","\n";
160			}
161			}
162
163			sub validatepath()
164			{
165			my $self = shift;
166			my ($pathvalue) = @_;
167			my $path;
168
169			# Either we use the pathvalue supplied or
170			# we use PATHFROMDB:
171			if ($pathvalue)
172			{
173			$path = $pathvalue;
174			}
175			else
176			{
177			$path = $self->{PATHFROMDB};
178			}
179
180			print "\tChecks ", if ($path);
181
182			if ( -f $path)
183			{
184			# File exists:
185			print $self->{STATUS}->{0}." for $path","\n";
186			return 1;
187			}
188			else
189			{
190			use DirHandle;
191			my $dh = DirHandle->new();
192
193			opendir $dh, $path or do
194			{
195			# No path:
196			print $self->{STATUS}->{1}." for $path","\n", unless ($path eq '');
197			return 0;
198			};
199
200			# Dir found:
201			print $self->{STATUS}->{0}." for $path","\n";
202			return 1;
203			}
204			}
205
206			sub checkdefaults()
207			{
208			my $self=shift;
209			my ($vardata,$pathtoevalref) = @_;
210
211			# If $vardata is actually an array (which it will
212			# be if there is more than one VAR element), dereference
213			# to get only the first hash entry (this is fine as the
214			# block of code to handle nmore than one element will loop
215			# over all elements of the array so that a hash is passed
216			# to this routine:
217			if (ref($vardata) eq 'ARRAY')
218			{
219			$data = $vardata->[0];
220			}
221			else
222			{
223			$data = $vardata;
224			}
225
226
227			if (exists($data->{'default'}))
228			{
229			$$pathtoevalref = $data->{'default'};
230			}
231			elsif (exists($data->{'value'}))
232			{
233			$$pathtoevalref = $data->{'value'};
234			}
235			else
236			{
237			# No value or default. Return 0:
238			return 0;
239			}
240
241			return 1;
242			}
243
244			sub pathfromdb()
245			{
246			my $self=shift;
247			return $self->{PATHFROMDB};
248			}
249
250			sub checkDB()
251			{
252			my $self = shift;
253			my ($varname) = @_;
254
255			if ($::lookupdb->checkTool($self->{TOOLNAME}))
256			{
257			$pathfromdb = $::lookupdb->lookupTag($self->{TOOLNAME}, $varname);
258
259			if ($pathfromdb ne "")
260			{
261			$self->{PATHFROMDB} = $pathfromdb;
262			return 1;
263			}
264			else
265			{
266			return 0;
267			}
268			}
269			else
270			{
271			return 0;
272			}
273			}
274
275			sub _expandvars()
276			{
277			my $self=shift;
278			my ($string) = @_;
279
280			return "" , if ( ! defined $string );
281
282			# To evaluate variables in brackets, like $(X):
283			$string =~ s{\$\((\w+)\)}
284			{
285			if (defined $self->{VARDATA}->{$1})
286			{
287			$self->_expandvars($self->{VARDATA}->{$1});
288			}
289			elsif (defined $self->{LOCALENV}->{$1})
290			{
291			$self->_expandvars($self->{LOCALENV}->{$1});
292			}
293			else
294			{
295			"\$$1";
296			}
297			}egx;
298
299			# To evaluate variables like $X:
300			$string =~ s{\$(\w+)}
301			{
302			if (defined $self->{VARDATA}->{$1})
303			{
304			$self->_expandvars($self->{VARDATA}->{$1});
305			}
306			elsif (defined $self->{LOCALENV}->{$1})
307			{
308			$self->_expandvars($self->{LOCALENV}->{$1});
309			}
310			else
311			{
312			"\$$1";
313			}
314			}egx;
315
316			# Now return false if the string wasn't properly evaluated (i.e. some $ remain), otherwise
317			# return the expanded string:
318			($string =~ /\$/) ? return undef : return $string;
319			}
320
321			sub promptuser()
322			{
323			my $self=shift;
324			my ($varname, $default)=@_;
325			my $pathvalue;
326			my $novalid = 1;
327			my $dummy = '';
328			my $ORKEEP = '';
329			print "\n";
330
331			while ($novalid)
332			{
333			if ($self->interactive())
334			{
335			# Only mention the default stuff if default actually has
336			# a value. It might not (e.g., in the case of a new tool)
337			if ($default ne '')
338			{
339			print "Default value is $default","\n", unless ($default eq '');
340			$ORKEEP=' (or <ret> to keep)';
341			}
342
343			print "\n";
344			print $main::prompt."Please Enter a Value$ORKEEP: > ".$main::normal;
345
346			$dummy = <STDIN>;
347			chomp($dummy);
348			# If we have an empty string, return the default value:
349			if ($dummy eq '' && $default ne '')
350			{
351			return $default;
352			}
353			print "\n"
354			}
355			else
356			{
357			print "\n";
358			print $main::prompt."Please Enter a Value: > ".$main::normal;
359			$dummy = <STDIN>;
360			chomp($dummy);
361			}
362
363			print "\n";
364			# Also use _expandvars() here so that env variables
365			# can be used:
366
367			$pathvalue=$self->_expandvars($dummy);
368			if ($self->validatepath($pathvalue))
369			{
370			$novalid = 0;
371			$self->{VARDATA}->{$varname} = $pathvalue;
372			}
373			else
374			{
375			print $self->{INVALIDPATHERRORMSG},"\n";
376			}
377			}
378
379			# Return the path:
380			return $pathvalue;
381			}
382
383			sub interactive()
384			{
385			my $self=shift;
386			return $self->{INTERACTIVE};
387			}
388
389			sub promptuserforvar()
390			{
391			my $self=shift;
392			my ($varname, $default)=@_;
393			my $value;
394			my $novalid = 1;
395			my $dummy = '';
396			my $ORKEEP = '';
397
398			print "\n";
399
400			while ($novalid)
401			{
402			if ($self->interactive())
403			{
404			# Only mention the default stuff if default actually has
405			# a value. It might not (e.g., in the case of a new tool)
406			if ($default ne '')
407			{
408			print "Default value for $varname is $default","\n", unless ($default eq '');
409			$ORKEEP=' (or <ret> to keep)';
410			}
411
412			print "\n";
413			print $main::prompt."Please Enter a Value$ORKEEP: > ".$main::normal;
414			$dummy = <STDIN>;
415			chomp($dummy);
416			# If we have an empty string, set to the default value:
417			if ($dummy eq '')
418			{
419			$dummy = $default;
420			}
421
422			print "\n";
423			}
424			else
425			{
426			print "\n";
427			print $main::prompt."Please Enter a Value: > ".$main::normal;
428			$dummy = <STDIN>;
429			chomp($dummy);
430			}
431
432			print "\n";
433			# Also use _expandvars() here so that env variables
434			# can be used:
435			$value = $self->_expandvars($dummy);
436			print "Runtime variable ",$varname," set to \"",$value,"\"\n";
437			$novalid = 0;
438			}
439
440			# Return the path:
441			return $value;
442			}
443
444			1;