src/BuildSystem/ToolBox.pm

#
# ToolBox.pm
#
# Originally Written by Christopher Williams
#
# Description
# -----------
# create tools from clientsettings and interface to access them 
#
# Interface
# ---------
# new()         : A new toolbox object
# tools()       : return a list of tools (name,version) pairs
# defaultversion(tool) : return the default version of the specified tool
# gettool(name[,version]) : get the tool object with the given name
#                           returns the default version if version not spec.
#                           returns undef if no setup tool is available
# toolsetup(name,version[,doc]) : setup the named tool from the specified doc
#                                 if doc not specified try and use previous
#                                 document

package BuildSystem::ToolBox;
use FileHandle;
use BuildSystem::Tool;
use Utilities::Verbose;

@ISA=qw(Utilities::Verbose);
require 5.004;

sub new {
        my $class=shift;
        $self={};
        bless $self, $class;
        $self->init();
        return $self;
}

sub init {
        my $self=shift;
        $self->{urlcache}="$ENV{LOCALTOP}/.SCRAM/ToolFiles";
        $self->{datastore}=$ENV{LOCALTOP}."/.SCRAM/".$ENV{SCRAM_ARCH};
        AddDir::adddir($self->{datastore});
        AddDir::adddir($self->{urlcache});
        $self->_readdefaultsfile($ENV{LOCALTOP}."/".$ENV{projconfigdir}.
                                                "/External_Dependencies");
}

sub tools {
        my $self=shift;
        return @{$self->{toollist}};
}

sub toolsetup {
        my $self=shift;
        my $name=shift;

        my $rv=0;
        # -- get version
        my $version;
        if ( @_ ) {
          $version=shift;
        }
        else {
          $version=$self->defaultversion($name);
          if ( ! defined $version ) { $rv=1; return $rv; }
        }

        my $url;

        # -- get a tool object
        my ($tool)=$self->_toolobject($name,$version);

        # -- get the url
        if ( @_ ) {
          $url=shift;
        }
        else {
          # no url specified - try to get it from the tool
          $url=$tool->url();
          if ( ! defined $url ) {
            $self->error("Unable to determine document for tool ".
                                $name." ".$version);
          }
        }
        $url=$self->_download($url);

        require BuildSystem::ToolDoc;
        my $doc=BuildSystem::ToolDoc->new();
        $doc->tool($tool);
        if ( ! $doc->setup($url,$name,$version) ) {
          $tool->store($self->_toolfile($name,$version));
        }
        undef $doc;
        return $rv;
}


sub gettool {
        my $self=shift;
        my $product=shift;
        my $version;

        if ( @_ ) { $version=shift; }
        else {
          # lookup the default version
          $version=$self->defaultversion($product);
          return undef, if ( ! defined $version );
        }
        my ($tool,$rv)=$self->_toolobject($product,$version); 
        return ( $rv==0?$tool:undef ); # only return if already set up
#       return (exists $self->{tools}{$product}{$version})?
#                       $self->{tools}{$product}{$version}:undef; 
}

sub defaultversion {
        my $self=shift;
        my $product=shift;

        return $self->{defaults}{$product};
}

sub _toolfile {
        my $self=shift;
        my $name=shift;
        my $version=shift;

        return $self->{datastore}."/$name_$version.dat";
}

sub _download {
        my $self=shift;
        my $url=shift;

        $url=~s/$self->{urlcache}\///;
        # -- make sure we have a copy of the file
        if ( ! -e $self->{urlcache}."/".$url ) {
                &urlhandler::urlhandler("file:$ENV{SCRAM_HOME}/toolbox/"
                        .$url, $self->{urlcache}."/$url") ;
        }
        return $self->{urlcache}."/".$url;
}

sub _readclientsettings {
        my $self=shift;
        my $clientfile=shift;

        my $fh=FileHandle->new();
        $fh->open("<".$clientfile) or die "Unable to open $clientfile\n";
        my ($tool,$product,$type,$version,$variable,$value);
        while ( <$fh> ) {
          chomp;
          next if /^#/;
          next if /^\s*$/;
          ($product, $version, $type, $variable, $value)=split /:/;
          next if ( $variable=~/\&/ );
          $product=~tr[A-Z][a-z];
          ($tool,$rv)=$self->_toolobject($product,$version);
          $tool->addfeature($variable,$value);
          $type=~tr[A-Z][a-z];
          $tool->type($variable,$type);
        }
        undef $fh;
}

sub _readdefaultsfile {
        my $self=shift;
        my $file=shift;

        my $fh=FileHandle->new();
        $fh->open("<".$file) or die "Unable to open $file $!\n";
        while ( <$fh> ) {
          chomp;
          next if /^#/;
          next if /^\s*$/;
          ($product, $version)=split /:/;
          $product=~tr[A-Z][a-z];
          $self->{defaults}{$product}=$version;
        }
        undef $fh;
}


sub _toolobject {
        my $self=shift;
        my $product=shift;
        my $version=shift;

        my $rv=1;

        if ( ! exists $self->{tools}{$product}{$version} ) {
           $self->verbose("$product $version being Intitialised");
           $self->{tools}{$product}{$version}=BuildSystem::Tool->new();
           my $file=$self->_toolfile($product,$version);
           if ( -f $file ) { # restore it from disk
             $self->verbose("Recovering $product $version from $file");
             $self->{tools}{$product}{$version}->restore($file);
             $rv=0;
           }
           else {
                $self->verbose("Tool $product $version needs set up");
           }
           push @{$self->{toollist}}, [$product, $version];
        }
        return ($self->{tools}{$product}{$version}, $rv);
}
Revision:	1.1.2.4
Committed:	Thu Apr 20 10:34:53 2000 UTC (25 years ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
Changes since 1.1.2.3:	+0 -1 lines
Log Message:	correct uerls form download
#	User	Rev	Content
1	williamc	1.1.2.1	#
2			# ToolBox.pm
3			#
4			# Originally Written by Christopher Williams
5			#
6			# Description
7			# -----------
8			# create tools from clientsettings and interface to access them
9			#
10			# Interface
11			# ---------
12			# new() : A new toolbox object
13			# tools() : return a list of tools (name,version) pairs
14			# defaultversion(tool) : return the default version of the specified tool
15			# gettool(name[,version]) : get the tool object with the given name
16			# returns the default version if version not spec.
17	williamc	1.1.2.3	# returns undef if no setup tool is available
18			# toolsetup(name,version[,doc]) : setup the named tool from the specified doc
19			# if doc not specified try and use previous
20			# document
21	williamc	1.1.2.1
22			package BuildSystem::ToolBox;
23			use FileHandle;
24			use BuildSystem::Tool;
25	williamc	1.1.2.3	use Utilities::Verbose;
26
27			@ISA=qw(Utilities::Verbose);
28	williamc	1.1.2.1	require 5.004;
29
30			sub new {
31			my $class=shift;
32			$self={};
33			bless $self, $class;
34			$self->init();
35			return $self;
36			}
37
38			sub init {
39			my $self=shift;
40	williamc	1.1.2.3	$self->{urlcache}="$ENV{LOCALTOP}/.SCRAM/ToolFiles";
41			$self->{datastore}=$ENV{LOCALTOP}."/.SCRAM/".$ENV{SCRAM_ARCH};
42			AddDir::adddir($self->{datastore});
43			AddDir::adddir($self->{urlcache});
44	williamc	1.1.2.1	$self->_readdefaultsfile($ENV{LOCALTOP}."/".$ENV{projconfigdir}.
45			"/External_Dependencies");
46			}
47
48			sub tools {
49			my $self=shift;
50			return @{$self->{toollist}};
51			}
52
53	williamc	1.1.2.3	sub toolsetup {
54			my $self=shift;
55			my $name=shift;
56
57			my $rv=0;
58			# -- get version
59			my $version;
60			if ( @_ ) {
61			$version=shift;
62			}
63			else {
64			$version=$self->defaultversion($name);
65			if ( ! defined $version ) { $rv=1; return $rv; }
66			}
67
68			my $url;
69
70			# -- get a tool object
71			my ($tool)=$self->_toolobject($name,$version);
72
73			# -- get the url
74			if ( @_ ) {
75			$url=shift;
76			}
77			else {
78			# no url specified - try to get it from the tool
79			$url=$tool->url();
80			if ( ! defined $url ) {
81			$self->error("Unable to determine document for tool ".
82			$name." ".$version);
83			}
84			}
85			$url=$self->_download($url);
86
87			require BuildSystem::ToolDoc;
88			my $doc=BuildSystem::ToolDoc->new();
89			$doc->tool($tool);
90			if ( ! $doc->setup($url,$name,$version) ) {
91			$tool->store($self->_toolfile($name,$version));
92			}
93			undef $doc;
94			return $rv;
95			}
96
97
98	williamc	1.1.2.1	sub gettool {
99			my $self=shift;
100			my $product=shift;
101			my $version;
102
103			if ( @_ ) { $version=shift; }
104			else {
105			# lookup the default version
106			$version=$self->defaultversion($product);
107			return undef, if ( ! defined $version );
108			}
109	williamc	1.1.2.3	my ($tool,$rv)=$self->_toolobject($product,$version);
110			return ( $rv==0?$tool:undef ); # only return if already set up
111			# return (exists $self->{tools}{$product}{$version})?
112			# $self->{tools}{$product}{$version}:undef;
113	williamc	1.1.2.1	}
114
115			sub defaultversion {
116			my $self=shift;
117			my $product=shift;
118
119			return $self->{defaults}{$product};
120			}
121
122	williamc	1.1.2.3	sub _toolfile {
123			my $self=shift;
124			my $name=shift;
125			my $version=shift;
126
127			return $self->{datastore}."/$name_$version.dat";
128			}
129
130			sub _download {
131			my $self=shift;
132			my $url=shift;
133
134			$url=~s/$self->{urlcache}\///;
135			# -- make sure we have a copy of the file
136			if ( ! -e $self->{urlcache}."/".$url ) {
137			&urlhandler::urlhandler("file:$ENV{SCRAM_HOME}/toolbox/"
138			.$url, $self->{urlcache}."/$url") ;
139			}
140			return $self->{urlcache}."/".$url;
141			}
142
143	williamc	1.1.2.1	sub _readclientsettings {
144			my $self=shift;
145			my $clientfile=shift;
146
147			my $fh=FileHandle->new();
148			$fh->open("<".$clientfile) or die "Unable to open $clientfile\n";
149			my ($tool,$product,$type,$version,$variable,$value);
150			while ( <$fh> ) {
151			chomp;
152			next if /^#/;
153			next if /^\s*$/;
154			($product, $version, $type, $variable, $value)=split /:/;
155			next if ( $variable=~/\&/ );
156			$product=~tr[A-Z][a-z];
157	williamc	1.1.2.3	($tool,$rv)=$self->_toolobject($product,$version);
158	williamc	1.1.2.1	$tool->addfeature($variable,$value);
159	williamc	1.1.2.2	$type=~tr[A-Z][a-z];
160			$tool->type($variable,$type);
161	williamc	1.1.2.1	}
162			undef $fh;
163			}
164
165			sub _readdefaultsfile {
166			my $self=shift;
167			my $file=shift;
168
169			my $fh=FileHandle->new();
170			$fh->open("<".$file) or die "Unable to open $file $!\n";
171			while ( <$fh> ) {
172			chomp;
173			next if /^#/;
174			next if /^\s*$/;
175			($product, $version)=split /:/;
176			$product=~tr[A-Z][a-z];
177			$self->{defaults}{$product}=$version;
178			}
179			undef $fh;
180			}
181
182	williamc	1.1.2.3
183	williamc	1.1.2.1	sub _toolobject {
184			my $self=shift;
185			my $product=shift;
186			my $version=shift;
187
188	williamc	1.1.2.3	my $rv=1;
189
190	williamc	1.1.2.1	if ( ! exists $self->{tools}{$product}{$version} ) {
191	williamc	1.1.2.3	$self->verbose("$product $version being Intitialised");
192	williamc	1.1.2.1	$self->{tools}{$product}{$version}=BuildSystem::Tool->new();
193	williamc	1.1.2.3	my $file=$self->_toolfile($product,$version);
194			if ( -f $file ) { # restore it from disk
195			$self->verbose("Recovering $product $version from $file");
196			$self->{tools}{$product}{$version}->restore($file);
197			$rv=0;
198			}
199			else {
200			$self->verbose("Tool $product $version needs set up");
201			}
202	williamc	1.1.2.1	push @{$self->{toollist}}, [$product, $version];
203			}
204	williamc	1.1.2.3	return ($self->{tools}{$product}{$version}, $rv);
205	williamc	1.1.2.1	}