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.2 2004/12/10 13:41:37 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;
      }
   # This is done so that some paths can be added which include ".":
   elsif ($path =~ /\.:.*/ || $path =~ /\./)
      {
      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.3
Committed:	Fri Dec 10 15:29:50 2004 UTC (20 years, 4 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_0_0
Changes since 1.2:	+8 -2 lines
Log Message:	Finally fix age-old problem with Geometry_PATH...
#	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	sashby	1.3	# Revision: $Id: ToolSettingValidator.pm,v 1.2 2004/12/10 13:41:37 sashby Exp $
8	sashby	1.2	#
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	sashby	1.3
65	sashby	1.2	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	sashby	1.3	# This is done so that some paths can be added which include ".":
189			elsif ($path =~ /\.:.*/ \|\| $path =~ /\./)
190			{
191			print $self->{STATUS}->{0}." for $path","\n";
192			return 1;
193			}
194	sashby	1.2	else
195			{
196			use DirHandle;
197			my $dh = DirHandle->new();
198
199			opendir $dh, $path or do
200			{
201			# No path:
202			print $self->{STATUS}->{1}." for $path","\n", unless ($path eq '');
203			return 0;
204			};
205
206			# Dir found:
207			print $self->{STATUS}->{0}." for $path","\n";
208			return 1;
209			}
210			}
211
212			sub checkdefaults()
213			{
214			my $self=shift;
215			my ($vardata,$pathtoevalref) = @_;
216
217			# If $vardata is actually an array (which it will
218			# be if there is more than one VAR element), dereference
219			# to get only the first hash entry (this is fine as the
220			# block of code to handle nmore than one element will loop
221			# over all elements of the array so that a hash is passed
222			# to this routine:
223			if (ref($vardata) eq 'ARRAY')
224			{
225			$data = $vardata->[0];
226			}
227			else
228			{
229			$data = $vardata;
230			}
231
232
233			if (exists($data->{'default'}))
234			{
235			$$pathtoevalref = $data->{'default'};
236			}
237			elsif (exists($data->{'value'}))
238			{
239			$$pathtoevalref = $data->{'value'};
240			}
241			else
242			{
243			# No value or default. Return 0:
244			return 0;
245			}
246
247			return 1;
248			}
249
250			sub pathfromdb()
251			{
252			my $self=shift;
253			return $self->{PATHFROMDB};
254			}
255
256			sub checkDB()
257			{
258			my $self = shift;
259			my ($varname) = @_;
260
261			if ($::lookupdb->checkTool($self->{TOOLNAME}))
262			{
263			$pathfromdb = $::lookupdb->lookupTag($self->{TOOLNAME}, $varname);
264
265			if ($pathfromdb ne "")
266			{
267			$self->{PATHFROMDB} = $pathfromdb;
268			return 1;
269			}
270			else
271			{
272			return 0;
273			}
274			}
275			else
276			{
277			return 0;
278			}
279			}
280
281			sub _expandvars()
282			{
283			my $self=shift;
284			my ($string) = @_;
285
286			return "" , if ( ! defined $string );
287
288			# To evaluate variables in brackets, like $(X):
289			$string =~ s{\$\((\w+)\)}
290			{
291			if (defined $self->{VARDATA}->{$1})
292			{
293			$self->_expandvars($self->{VARDATA}->{$1});
294			}
295			elsif (defined $self->{LOCALENV}->{$1})
296			{
297			$self->_expandvars($self->{LOCALENV}->{$1});
298			}
299			else
300			{
301			"\$$1";
302			}
303			}egx;
304
305			# To evaluate variables like $X:
306			$string =~ s{\$(\w+)}
307			{
308			if (defined $self->{VARDATA}->{$1})
309			{
310			$self->_expandvars($self->{VARDATA}->{$1});
311			}
312			elsif (defined $self->{LOCALENV}->{$1})
313			{
314			$self->_expandvars($self->{LOCALENV}->{$1});
315			}
316			else
317			{
318			"\$$1";
319			}
320			}egx;
321
322			# Now return false if the string wasn't properly evaluated (i.e. some $ remain), otherwise
323			# return the expanded string:
324			($string =~ /\$/) ? return undef : return $string;
325			}
326
327			sub promptuser()
328			{
329			my $self=shift;
330			my ($varname, $default)=@_;
331			my $pathvalue;
332			my $novalid = 1;
333			my $dummy = '';
334			my $ORKEEP = '';
335			print "\n";
336
337			while ($novalid)
338			{
339			if ($self->interactive())
340			{
341			# Only mention the default stuff if default actually has
342			# a value. It might not (e.g., in the case of a new tool)
343			if ($default ne '')
344			{
345			print "Default value is $default","\n", unless ($default eq '');
346			$ORKEEP=' (or <ret> to keep)';
347			}
348
349			print "\n";
350			print $main::prompt."Please Enter a Value$ORKEEP: > ".$main::normal;
351
352			$dummy = <STDIN>;
353			chomp($dummy);
354			# If we have an empty string, return the default value:
355			if ($dummy eq '' && $default ne '')
356			{
357			return $default;
358			}
359			print "\n"
360			}
361			else
362			{
363			print "\n";
364			print $main::prompt."Please Enter a Value: > ".$main::normal;
365			$dummy = <STDIN>;
366			chomp($dummy);
367			}
368
369			print "\n";
370			# Also use _expandvars() here so that env variables
371			# can be used:
372
373			$pathvalue=$self->_expandvars($dummy);
374			if ($self->validatepath($pathvalue))
375			{
376			$novalid = 0;
377			$self->{VARDATA}->{$varname} = $pathvalue;
378			}
379			else
380			{
381			print $self->{INVALIDPATHERRORMSG},"\n";
382			}
383			}
384
385			# Return the path:
386			return $pathvalue;
387			}
388
389			sub interactive()
390			{
391			my $self=shift;
392			return $self->{INTERACTIVE};
393			}
394
395			sub promptuserforvar()
396			{
397			my $self=shift;
398			my ($varname, $default)=@_;
399			my $value;
400			my $novalid = 1;
401			my $dummy = '';
402			my $ORKEEP = '';
403
404			print "\n";
405
406			while ($novalid)
407			{
408			if ($self->interactive())
409			{
410			# Only mention the default stuff if default actually has
411			# a value. It might not (e.g., in the case of a new tool)
412			if ($default ne '')
413			{
414			print "Default value for $varname is $default","\n", unless ($default eq '');
415			$ORKEEP=' (or <ret> to keep)';
416			}
417
418			print "\n";
419			print $main::prompt."Please Enter a Value$ORKEEP: > ".$main::normal;
420			$dummy = <STDIN>;
421			chomp($dummy);
422			# If we have an empty string, set to the default value:
423			if ($dummy eq '')
424			{
425			$dummy = $default;
426			}
427
428			print "\n";
429			}
430			else
431			{
432			print "\n";
433			print $main::prompt."Please Enter a Value: > ".$main::normal;
434			$dummy = <STDIN>;
435			chomp($dummy);
436			}
437
438			print "\n";
439			# Also use _expandvars() here so that env variables
440			# can be used:
441			$value = $self->_expandvars($dummy);
442			print "Runtime variable ",$varname," set to \"",$value,"\"\n";
443			$novalid = 0;
444			}
445
446			# Return the path:
447			return $value;
448			}
449
450			1;