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