src/Configuration/ConfigArea.pm

#
# ConfigArea.pm
#
# Written by Christopher Williams
#
# Description
# -----------
# creates and manages a configuration area
#
# Options
# -------
# ConfigArea_location
# ConfigArea_name
#
# Interface
# ---------
# new()                         : A new ConfigArea object
# location([dir])               : set/return the location of the work area
# bootstrapfromlocation([location]) : bootstrap the object based on location.
#                                     no location specified - cwd used
#                                     return 0 if succesful 1 otherwise
# requirementsdoc()             : get set the requirements doc
# searchlocation([startdir])    : returns the location directory. search starts
#                                 from cwd if not specified
# defaultdirname()              : return the default directory name string
# scramversion()                : return the scram version associated with
#                                 area
# configurationdir()            : return the location of the project 
#                                 configuration directory
# copy(location)                : copy a configuration
# copysetup(location)           : copy the architecture specific tool setup
#                                 returns 0 if successful, 1 otherwise
# copyenv($ref)                 : copy the areas environment into the hashref
# toolbox()                     : return the areas toolbox object
# - temporary
# align()                       : adjust hard paths to suit local loaction

package Configuration::ConfigArea;
require 5.004;
use Utilities::AddDir;
use Utilities::Verbose;
use Cwd;
@ISA=qw(Utilities::Verbose);

sub new {
        my $class=shift;
        my $self={};
        bless $self, $class;

        # data init
        $self->{admindir}=".SCRAM";

        return $self;
}

sub configurationdir {
        my $self=shift;
        if ( @_ ) {
          $self->{configurationdir}=shift;
        }
        if ( ! defined $self->{configurationdir} ) {
          $self->_LoadEnvFile();
          $self->{configurationdir}=$self->{ENV}{projconfigdir};
        }
        return $self->{configurationdir};
}

sub toolbox {
        my $self=shift;
        if ( ! defined $self->{toolbox} ) {
          $self->{toolbox}=BuildSystem::ToolBox->new($self);
        }
        return $self->{toolbox};
}

sub requirementsdoc {
        my $self=shift;
        if ( @_ ) {
          $self->{reqdoc}=shift;
        }
        if ( ! defined $self->{reqdoc} ) {
          $self->_LoadEnvFile();
          $self->{reqdoc}=$self->{ENV}{SCRAM_ProjReqsDoc};
        }
        return $self->{reqdoc};
}

sub scramversion {
        my $self=shift;
        if ( ! defined $self->{scramversion} ) {
          my $filename=$self->location()."/".$self->configurationdir()."/".
                                                        "scram_version";
          if ( -f $filename ) {
            use FileHandle;
            $fh=FileHandle->new();
            open ($fh, "<".$filename);
            my $version=<$fh>;
            chomp $version;
            $self->{scramversion}=$version;
            undef $fh;
          }
        }
        return $self->{scramversion};
}

sub bootstrapfromlocation {
        my $self=shift;

        my $rv=0;
        
        my $location;
        if ( ! defined ($location=$self->searchlocation(@_)) ) {
         $rv=1;
         $self->verbose("Unable to locate the top of local configuration area");
        }
        else {
         $self->location($location);
         $self->verbose("Found top ".$self->location());
         my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat";
         $self->_LoadEnvFile();
        }
        return $rv;
}

sub location {
        my $self=shift;

        if ( @_ ) {
          $self->{location}=shift;
        }
        elsif ( ! defined $self->{location} ) {
          # try and find the release location
          $self->{location}=$self->searchlocation();
        }
        return  $self->{location};
}

sub searchlocation {
        my $self=shift;

        #start search in current directory if not specified
        my $thispath;
        if ( @_ ) {
          $thispath=shift
        }
        else {
          $thispath=cwd();
        }
 
        my $rv=0;

        # chop off any files - we only want dirs
        if ( -f $thispath ) {
          $thispath=~s/(.*)\/.*/$1/;
        }
        Sloop:{
        do {
          $self->verbose("Searching $thispath");
          if ( -e "$thispath/".$self->{admindir} ) {
            $self->verbose("Found\n");
            $rv=1;
            last Sloop;
          }
        } while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) };

        return $rv?$thispath:undef;
}

sub copy {
        my $self=shift;
        my $destination=shift;

        # copy across the admin dir
        my $temp=$self->location()."/".$self->{admindir};
        AddDir::copydir($temp,"$destination/".$self->{admindir});
}

sub align {
        my $self=shift;
        use File::Copy;

        $self->_LoadEnvFile();
        my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
        my $tmpEnvfile=$Envfile.".bak";
        my $rel=$self->{ENV}{RELEASETOP};
        my $local=$self->location();

        rename( $Envfile, $tmpEnvfile );
        use FileHandle;
        my $fh=FileHandle->new();
        my $fout=FileHandle->new();
        open ( $fh, "<".$tmpEnvfile ) or
                $self->error("Cannot find Environment file. Area Corrupted? ("
                                .$self->location().")\n $!");
        open ( $fout, ">".$Envfile ) or
                $self->error("Cannot find Environment file. Area Corrupted? ("
                                .$self->location().")\n $!");
        while ( <$fh> ) {
          $_=~s/\Q$rel\L/$local/g;
          print $fout $_;
        }
        undef $fh;
        undef $fout;
}

sub copysetup {
        my $self=shift;
        my $dest=shift;

        my $rv=1;
        # copy across the admin dir
        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
        if ( $temp ne $temp2 ) {
         if ( -d $temp ) {
          AddDir::copydir($temp,$temp2);
          $rv=0;
         }
        }
        return $rv;
}

sub copyenv {
        my $self=shift;
        my $hashref=shift;
        
        foreach $elem ( keys %{$self->{ENV}} ) {
           $$hashref{$elem}=$self->{ENV}{$elem};
        }
}

sub arch {
        my $self=shift;
        return $ENV{SCRAM_ARCH};
}

# ---- support routines
sub _LoadEnvFile {
        my $self=shift;

        use FileHandle;
        my $fh=FileHandle->new();
        open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
                "Environment" ) or 
                $self->error("Cannot find Environment file. Area Corrupted? ("
                                .$self->location().")\n $!"); 
        while ( <$fh> ) {
           chomp;
           next if /^#/;
           next if /^\s*$/ ;
           ($name, $value)=split /=/;
           eval "\$self->{ENV}{${name}}=\"$value\"";
        }
        undef $fh;
}
Revision:	1.13.2.6
Committed:	Tue May 16 14:03:02 2000 UTC (25 years ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
CVS Tags:	V0_12_12_4, V0_12_12_3, V0_12_12_2, V0_12_12_1, V0_12_12_0, PlayGround_0, V0_12_12, V0_12_11, V0_12_9b, V0_12_10, V0_12_9, V0_12_8, V0_12_7
Branch point for:	HPWbranch
Changes since 1.13.2.5:	+30 -24 lines
Log Message:	Add align method
#	User	Rev	Content
1	williamc	1.1	#
2			# ConfigArea.pm
3			#
4	williamc	1.13.2.1	# Written by Christopher Williams
5	williamc	1.1	#
6			# Description
7	williamc	1.9	# -----------
8			# creates and manages a configuration area
9			#
10			# Options
11			# -------
12			# ConfigArea_location
13			# ConfigArea_name
14	williamc	1.1	#
15			# Interface
16			# ---------
17	williamc	1.13.2.1	# new() : A new ConfigArea object
18			# location([dir]) : set/return the location of the work area
19	williamc	1.13.2.3	# bootstrapfromlocation([location]) : bootstrap the object based on location.
20			# no location specified - cwd used
21			# return 0 if succesful 1 otherwise
22	williamc	1.13.2.5	# requirementsdoc() : get set the requirements doc
23	williamc	1.5	# searchlocation([startdir]) : returns the location directory. search starts
24			# from cwd if not specified
25	williamc	1.6	# defaultdirname() : return the default directory name string
26	williamc	1.13.2.1	# scramversion() : return the scram version associated with
27			# area
28			# configurationdir() : return the location of the project
29			# configuration directory
30	williamc	1.13.2.2	# copy(location) : copy a configuration
31			# copysetup(location) : copy the architecture specific tool setup
32			# returns 0 if successful, 1 otherwise
33			# copyenv($ref) : copy the areas environment into the hashref
34	williamc	1.13.2.5	# toolbox() : return the areas toolbox object
35	williamc	1.13.2.6	# - temporary
36			# align() : adjust hard paths to suit local loaction
37	williamc	1.1
38			package Configuration::ConfigArea;
39			require 5.004;
40			use Utilities::AddDir;
41	williamc	1.13.2.1	use Utilities::Verbose;
42	williamc	1.6	use Cwd;
43	williamc	1.13.2.1	@ISA=qw(Utilities::Verbose);
44	williamc	1.1
45	williamc	1.13.2.1	sub new {
46			my $class=shift;
47			my $self={};
48			bless $self, $class;
49	williamc	1.9
50	williamc	1.13.2.2	# data init
51			$self->{admindir}=".SCRAM";
52	williamc	1.7
53	williamc	1.13.2.2	return $self;
54	williamc	1.9	}
55	williamc	1.8
56	williamc	1.13.2.1	sub configurationdir {
57	williamc	1.1	my $self=shift;
58	williamc	1.13.2.1	if ( @_ ) {
59			$self->{configurationdir}=shift;
60	williamc	1.6	}
61	williamc	1.13.2.1	if ( ! defined $self->{configurationdir} ) {
62			$self->_LoadEnvFile();
63			$self->{configurationdir}=$self->{ENV}{projconfigdir};
64			}
65			return $self->{configurationdir};
66	williamc	1.13.2.5	}
67
68			sub toolbox {
69			my $self=shift;
70			if ( ! defined $self->{toolbox} ) {
71			$self->{toolbox}=BuildSystem::ToolBox->new($self);
72			}
73			return $self->{toolbox};
74			}
75
76			sub requirementsdoc {
77			my $self=shift;
78			if ( @_ ) {
79			$self->{reqdoc}=shift;
80			}
81			if ( ! defined $self->{reqdoc} ) {
82			$self->_LoadEnvFile();
83			$self->{reqdoc}=$self->{ENV}{SCRAM_ProjReqsDoc};
84			}
85			return $self->{reqdoc};
86	williamc	1.13.2.1	}
87
88			sub scramversion {
89			my $self=shift;
90			if ( ! defined $self->{scramversion} ) {
91	williamc	1.13.2.2	my $filename=$self->location()."/".$self->configurationdir()."/".
92	williamc	1.13.2.1	"scram_version";
93			if ( -f $filename ) {
94			use FileHandle;
95			$fh=FileHandle->new();
96			open ($fh, "<".$filename);
97			my $version=<$fh>;
98			chomp $version;
99			$self->{scramversion}=$version;
100			undef $fh;
101			}
102	williamc	1.1	}
103	williamc	1.13.2.1	return $self->{scramversion};
104	williamc	1.4	}
105
106	williamc	1.5	sub bootstrapfromlocation {
107			my $self=shift;
108	williamc	1.13.2.2
109			my $rv=0;
110	williamc	1.5
111	williamc	1.13.2.3	my $location;
112			if ( ! defined ($location=$self->searchlocation(@_)) ) {
113	williamc	1.13.2.2	$rv=1;
114			$self->verbose("Unable to locate the top of local configuration area");
115			}
116			else {
117	williamc	1.13.2.3	$self->location($location);
118	williamc	1.13.2.2	$self->verbose("Found top ".$self->location());
119			my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat";
120			$self->_LoadEnvFile();
121	williamc	1.5	}
122	williamc	1.13.2.2	return $rv;
123	williamc	1.1	}
124
125			sub location {
126			my $self=shift;
127
128	williamc	1.5	if ( @_ ) {
129	williamc	1.6	$self->{location}=shift;
130	williamc	1.5	}
131			elsif ( ! defined $self->{location} ) {
132			# try and find the release location
133	williamc	1.9	$self->{location}=$self->searchlocation();
134	williamc	1.5	}
135			return $self->{location};
136			}
137
138			sub searchlocation {
139			my $self=shift;
140
141			#start search in current directory if not specified
142			my $thispath;
143	williamc	1.13.2.3	if ( @_ ) {
144			$thispath=shift
145			}
146			else {
147			$thispath=cwd();
148			}
149	williamc	1.5
150			my $rv=0;
151
152	williamc	1.13.2.3	# chop off any files - we only want dirs
153			if ( -f $thispath ) {
154			$thispath=~s/(.)\/./$1/;
155			}
156	williamc	1.6	Sloop:{
157			do {
158	williamc	1.13.2.1	$self->verbose("Searching $thispath");
159	williamc	1.8	if ( -e "$thispath/".$self->{admindir} ) {
160	williamc	1.13.2.1	$self->verbose("Found\n");
161	williamc	1.5	$rv=1;
162	williamc	1.6	last Sloop;
163	williamc	1.5	}
164	williamc	1.6	} while ( ($thispath=~s/(.)\/./$1/)=~/./ ) };
165	williamc	1.5
166			return $rv?$thispath:undef;
167	williamc	1.1	}
168
169	williamc	1.13.2.2	sub copy {
170			my $self=shift;
171			my $destination=shift;
172
173			# copy across the admin dir
174			my $temp=$self->location()."/".$self->{admindir};
175			AddDir::copydir($temp,"$destination/".$self->{admindir});
176			}
177
178	williamc	1.13.2.6	sub align {
179			my $self=shift;
180			use File::Copy;
181
182			$self->_LoadEnvFile();
183			my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
184			my $tmpEnvfile=$Envfile.".bak";
185			my $rel=$self->{ENV}{RELEASETOP};
186			my $local=$self->location();
187
188			rename( $Envfile, $tmpEnvfile );
189			use FileHandle;
190			my $fh=FileHandle->new();
191			my $fout=FileHandle->new();
192			open ( $fh, "<".$tmpEnvfile ) or
193			$self->error("Cannot find Environment file. Area Corrupted? ("
194			.$self->location().")\n $!");
195			open ( $fout, ">".$Envfile ) or
196			$self->error("Cannot find Environment file. Area Corrupted? ("
197			.$self->location().")\n $!");
198			while ( <$fh> ) {
199			$_=~s/\Q$rel\L/$local/g;
200			print $fout $_;
201			}
202			undef $fh;
203			undef $fout;
204			}
205
206	williamc	1.13.2.2	sub copysetup {
207			my $self=shift;
208			my $dest=shift;
209
210			my $rv=1;
211			# copy across the admin dir
212			my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
213			my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
214			if ( $temp ne $temp2 ) {
215			if ( -d $temp ) {
216			AddDir::copydir($temp,$temp2);
217			$rv=0;
218			}
219			}
220			return $rv;
221			}
222
223			sub copyenv {
224			my $self=shift;
225			my $hashref=shift;
226
227			foreach $elem ( keys %{$self->{ENV}} ) {
228			$$hashref{$elem}=$self->{ENV}{$elem};
229			}
230			}
231
232			sub arch {
233			my $self=shift;
234			return $ENV{SCRAM_ARCH};
235			}
236
237	williamc	1.13.2.1	# ---- support routines
238			sub _LoadEnvFile {
239	williamc	1.1	my $self=shift;
240
241	williamc	1.13.2.1	use FileHandle;
242			my $fh=FileHandle->new();
243	williamc	1.13.2.2	open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
244			"Environment" ) or
245	williamc	1.13.2.3	$self->error("Cannot find Environment file. Area Corrupted? ("
246			.$self->location().")\n $!");
247	williamc	1.13.2.1	while ( <$fh> ) {
248			chomp;
249			next if /^#/;
250			next if /^\s*$/ ;
251			($name, $value)=split /=/;
252			eval "\$self->{ENV}{${name}}=\"$value\"";
253	williamc	1.9	}
254	williamc	1.13.2.1	undef $fh;
255	williamc	1.1	}