src/BuildSystem/ToolSettingValidator.pm

#____________________________________________________________________ 
# File: BuildSystem::ToolSettingValidator.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Copyright: 2004 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package BuildSystem::ToolSettingValidator;
require 5.004;
use SCRAM::MsgLog;
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) = @_;

  $self->{TOOLNAME}    = $toolname;
  $self->{ENVIRONMENT} = $environments->{ENVIRONMENT};
  $self->{RUNTIME}     = $environments->{RUNTIME};
  $self->{VARDATA}     = {};
  $self->{LOCALENV}    = \%ENV;
  $self->{STATUS}      = { 0 => $main::good."[OK]".$main::normal, 1 => $main::error."[FAIL]".$main::normal, 2 => $main::good."[OK (but currently missing)]".$main::normal };

  bless $self,$class;
  return $self;
  }

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

   my $handlertype;

   # See if there's a default/value in our data element:
   if ($self->checkdefaults($data,\$stringtoeval,\$handlertype))
      {
      $path = $self->_expandvars($stringtoeval);
      if ($self->validatepath($path,$handlertype) )
         {
         $self->savevalue($name,$path);
         }
      else
         {
         $self->promptuser($name,$path);                    
         }               
      }
   else
      {
      $self->promptuser($name,$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 $self->{uc($type)}->{$varname};
         }
      else
         {
         return 0;
         }
      }
   elsif ($type)
      {
      return $self->{uc($type)};
      }
   else
      {
      die "SCRAM: Unknown tag type/var name: $type/$varname\n";
      }
   }

sub validatepath()
   {
   my $self = shift;
   my ($path,$handlertype) = @_;
   scramlogmsg("\tChecks "), if ($path);

   # This is done so that some paths can be added which include ".":
   if (($path =~ /^\.:.*/ || $path =~ /^\.$/) || ( -f $path ) || (-d $path))
      {
      scramlogmsg($self->{STATUS}->{0}." for $path","\n");
      return 1;
      }
   elsif ($handlertype =~ /^[Ww].*$/)
      {
      scramlogmsg($self->{STATUS}->{2}." for $path","\n");
      return 1;
      }
   scramlogmsg($self->{STATUS}->{1}." for $path","\n"), unless ($path eq '');
   return 0;
   }

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

   if (ref($vardata) eq 'ARRAY')
      {
      $data = $vardata->[0];
      }
   else
      {
      $data = $vardata;
      }

   if (exists($data->{'handler'}))
      {
      $$handlertyperef = $data->{'handler'};
      }

   if (exists($data->{'value'}))
      {
      $$pathtoevalref = $data->{'value'};
      }
   elsif (exists($data->{'default'}))
      {
      $$pathtoevalref = $data->{'default'};
      }
   else
      {
      return 0;
      }

   return 1;
   }

sub _expandvars()
   {
   my $self=shift;
   my ($string) = @_;
   
   return "" , if ( ! defined $string );
   
   $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;
   
   $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;

   ($string =~ /\$/) ? return undef : return $string;
   }

sub promptuser()
   {
   my ($self,$name,$path)=@_;
   if ($path) { print "**** ERROR: No such file or directory: $path\n"; }
   die "     SCRAM does not allow prompting for user input anymore.\n",
       "     Please fix the tool file for \"",$self->{TOOLNAME},"\" and provide a valid value for \"$name\".\n";
   }

1;
Revision:	1.7
Committed:	Tue Oct 18 14:59:28 2011 UTC (13 years, 6 months ago) by muzaffar
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V2_2_5_pre2, V2_2_5_pre1, V2_2_4, V2_2_4_pre9, V2_2_4_pre8, V2_2_4_pre7, V2_2_4_pre6, V2_2_4_pre5, V2_2_4_pre4, V2_2_4_pre3, V2_2_4_pre2, V2_2_4_pre1, HEAD
Changes since 1.6:	+0 -3 lines
Log Message:	removed cvs $id statement
#	User	Rev	Content
1	sashby	1.2	#____________________________________________________________________
2			# File: BuildSystem::ToolSettingValidator.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Copyright: 2004 (C) Shaun Ashby
7			#
8			#--------------------------------------------------------------------
9			package BuildSystem::ToolSettingValidator;
10			require 5.004;
11	muzaffar	1.5	use SCRAM::MsgLog;
12	sashby	1.2	use Exporter;
13			@ISA=qw(Exporter);
14			@EXPORT_OK=qw( );
15
16			sub new()
17			###############################################################
18			# new #
19			###############################################################
20			# modified : Thu Oct 14 10:16:25 2004 / SFA #
21			# params : #
22			# : #
23			# function : #
24			# : #
25			###############################################################
26			{
27			my $proto=shift;
28			my $class=ref($proto) \|\| $proto;
29			my $self={};
30
31			# Store the list of known environments:
32	muzaffar	1.6	my ($environments,$toolname) = @_;
33	sashby	1.2
34			$self->{TOOLNAME} = $toolname;
35			$self->{ENVIRONMENT} = $environments->{ENVIRONMENT};
36			$self->{RUNTIME} = $environments->{RUNTIME};
37	muzaffar	1.6	$self->{VARDATA} = {};
38	sashby	1.2	$self->{LOCALENV} = \%ENV;
39	sashby	1.4	$self->{STATUS} = { 0 => $main::good."[OK]".$main::normal, 1 => $main::error."[FAIL]".$main::normal, 2 => $main::good."[OK (but currently missing)]".$main::normal };
40	sashby	1.2
41			bless $self,$class;
42			return $self;
43			}
44
45			sub findvalue()
46			{
47			my $self=shift;
48			my ($name, $data) = @_;
49			my $stringtoeval;
50			my $path;
51	sashby	1.4
52			my $handlertype;
53	muzaffar	1.6
54	sashby	1.2	# See if there's a default/value in our data element:
55	sashby	1.4	if ($self->checkdefaults($data,\$stringtoeval,\$handlertype))
56	sashby	1.2	{
57			$path = $self->_expandvars($stringtoeval);
58	sashby	1.4	if ($self->validatepath($path,$handlertype) )
59	sashby	1.2	{
60			$self->savevalue($name,$path);
61			}
62			else
63			{
64	muzaffar	1.6	$self->promptuser($name,$path);
65	sashby	1.2	}
66			}
67			else
68			{
69	muzaffar	1.6	$self->promptuser($name,$path);
70	sashby	1.2	}
71			return $path;
72			}
73
74			sub savevalue()
75			{
76			my $self = shift;
77			my ($varname, $path) = @_;
78
79			if ($varname && $path)
80			{
81			$self->{VARDATA}->{$varname} = $path;
82			}
83
84			return;
85			}
86
87			sub environment()
88			{
89			my $self = shift;
90			my ($type, $varname) = @_;
91
92			if ($type && $varname)
93			{
94			if (exists($self->{uc($type)}->{$varname}))
95			{
96			return $self->{uc($type)}->{$varname};
97			}
98			else
99			{
100			return 0;
101			}
102			}
103			elsif ($type)
104			{
105			return $self->{uc($type)};
106			}
107			else
108			{
109	muzaffar	1.6	die "SCRAM: Unknown tag type/var name: $type/$varname\n";
110	sashby	1.2	}
111			}
112
113			sub validatepath()
114			{
115			my $self = shift;
116	muzaffar	1.6	my ($path,$handlertype) = @_;
117	muzaffar	1.5	scramlogmsg("\tChecks "), if ($path);
118	sashby	1.4
119	sashby	1.3	# This is done so that some paths can be added which include ".":
120	muzaffar	1.6	if (($path =~ /^\.:.*/ \|\| $path =~ /^\.$/) \|\| ( -f $path ) \|\| (-d $path))
121	sashby	1.3	{
122	muzaffar	1.5	scramlogmsg($self->{STATUS}->{0}." for $path","\n");
123	sashby	1.3	return 1;
124			}
125	sashby	1.4	elsif ($handlertype =~ /^[Ww].*$/)
126			{
127	muzaffar	1.5	scramlogmsg($self->{STATUS}->{2}." for $path","\n");
128	sashby	1.4	return 1;
129			}
130	muzaffar	1.6	scramlogmsg($self->{STATUS}->{1}." for $path","\n"), unless ($path eq '');
131			return 0;
132	sashby	1.2	}
133
134			sub checkdefaults()
135			{
136			my $self=shift;
137	sashby	1.4	my ($vardata,$pathtoevalref,$handlertyperef) = @_;
138	sashby	1.2
139			if (ref($vardata) eq 'ARRAY')
140			{
141			$data = $vardata->[0];
142			}
143			else
144			{
145			$data = $vardata;
146			}
147
148	sashby	1.4	if (exists($data->{'handler'}))
149			{
150			$$handlertyperef = $data->{'handler'};
151			}
152	muzaffar	1.6
153			if (exists($data->{'value'}))
154	sashby	1.2	{
155	muzaffar	1.6	$$pathtoevalref = $data->{'value'};
156	sashby	1.2	}
157	muzaffar	1.6	elsif (exists($data->{'default'}))
158	sashby	1.2	{
159	muzaffar	1.6	$$pathtoevalref = $data->{'default'};
160	sashby	1.2	}
161			else
162			{
163			return 0;
164			}
165
166			return 1;
167			}
168
169			sub _expandvars()
170			{
171			my $self=shift;
172			my ($string) = @_;
173
174			return "" , if ( ! defined $string );
175
176			$string =~ s{\$\((\w+)\)}
177			{
178			if (defined $self->{VARDATA}->{$1})
179			{
180			$self->_expandvars($self->{VARDATA}->{$1});
181			}
182			elsif (defined $self->{LOCALENV}->{$1})
183			{
184			$self->_expandvars($self->{LOCALENV}->{$1});
185			}
186			else
187			{
188			"\$$1";
189			}
190			}egx;
191
192			$string =~ s{\$(\w+)}
193			{
194			if (defined $self->{VARDATA}->{$1})
195			{
196			$self->_expandvars($self->{VARDATA}->{$1});
197			}
198			elsif (defined $self->{LOCALENV}->{$1})
199			{
200			$self->_expandvars($self->{LOCALENV}->{$1});
201			}
202			else
203			{
204			"\$$1";
205			}
206			}egx;
207
208			($string =~ /\$/) ? return undef : return $string;
209			}
210
211			sub promptuser()
212			{
213	muzaffar	1.6	my ($self,$name,$path)=@_;
214			if ($path) { print "**** ERROR: No such file or directory: $path\n"; }
215			die " SCRAM does not allow prompting for user input anymore.\n",
216			" Please fix the tool file for \"",$self->{TOOLNAME},"\" and provide a valid value for \"$name\".\n";
217	sashby	1.2	}
218
219			1;