src/BuildSystem/ToolBox.pm

#
# ToolBox.pm
#
# Originally Written by Christopher Williams
#
# Description
# -----------
# tools 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; returns 0=OK 1=no version 
# interactive(0|1)      : set the setup mode

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 interactive {
        my $self=shift;

        @_?$self->{interactive}=shift
          :((defined $self->{interactive})?$self->{interactive}:0);
}

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);

        print "\n ----------- Setting Up $name $version ---------------\n";
        require BuildSystem::ToolDoc;
        my $doc=BuildSystem::ToolDoc->new();
        $doc->tool($tool);
        $doc->interactive($self->interactive());
        $tool->reset();
        if ( ! $doc->setup($url,$name,$version) ) {
          $tool->store($self->_toolfile($name,$version));
        }
        else {
          $self->error("Unable to find $name $version in $url");
        }
        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
}

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

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

#
# return list of matching tools
sub _gettools {
        my $self=shift;
        my $tool=shift;

        my @tools=();
        if ( defined $self->{toolboxsearcher} ) {
           my $it=$self->{toolboxsearcher}->newiterator();
           while ( ! $it->last()  ) {
             $rtool=$it->next();
             if ( $rtool->equals($tool) ) {
                push @tools,$rtool;
             }
           }
        }
        return @tools;
}

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

        $name=~tr[A-Z][a-z];
        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 _readdefaultsfile {
        my $self=shift;
        my $file=shift;

        # -- Get defaults from the RequirementsDoc
        my $req=$self->_requirements();
        my $tool;
        foreach $tool ( $req->tools()) {
           if ( ! defined $self->{defaults}{$tool} ) {
             $self->{defaults}{$tool}=$req->version($tool);
           }
        }

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

sub _requirements {
        if ( ! defined $reqsobj ) {
          require BuildSystem::Requirements;
          $reqsobj=BuildSystem::Requirements->new($ENV{SCRAM_ProjReqsDoc});
        }
        return $reqsobj;
}

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

        my $rv=0;

        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);
           }
           else {
                $rv=1;
                $self->verbose("Tool $product $version needs set up");
           }
           push @{$self->{toollist}}, [$product, $version];
        }
        return ($self->{tools}{$product}{$version}, $rv);
}
Revision:	1.1.2.13
Committed:	Thu Apr 27 13:24:00 2000 UTC (25 years ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
Changes since 1.1.2.12:	+19 -0 lines
Log Message:	gettools iteration method added - not finished
#	User	Rev	Content
1	williamc	1.1.2.1	#
2			# ToolBox.pm
3			#
4			# Originally Written by Christopher Williams
5			#
6			# Description
7			# -----------
8	williamc	1.1.2.9	# tools and interface to access them
9	williamc	1.1.2.1	#
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	williamc	1.1.2.7	# document; returns 0=OK 1=no version
21	williamc	1.1.2.8	# interactive(0\|1) : set the setup mode
22	williamc	1.1.2.1
23			package BuildSystem::ToolBox;
24			use FileHandle;
25			use BuildSystem::Tool;
26	williamc	1.1.2.3	use Utilities::Verbose;
27
28			@ISA=qw(Utilities::Verbose);
29	williamc	1.1.2.1	require 5.004;
30
31			sub new {
32			my $class=shift;
33			$self={};
34			bless $self, $class;
35			$self->init();
36			return $self;
37			}
38
39			sub init {
40			my $self=shift;
41	williamc	1.1.2.3	$self->{urlcache}="$ENV{LOCALTOP}/.SCRAM/ToolFiles";
42			$self->{datastore}=$ENV{LOCALTOP}."/.SCRAM/".$ENV{SCRAM_ARCH};
43			AddDir::adddir($self->{datastore});
44			AddDir::adddir($self->{urlcache});
45	williamc	1.1.2.1	$self->_readdefaultsfile($ENV{LOCALTOP}."/".$ENV{projconfigdir}.
46			"/External_Dependencies");
47			}
48
49	williamc	1.1.2.8	sub interactive {
50			my $self=shift;
51
52			@_?$self->{interactive}=shift
53			:((defined $self->{interactive})?$self->{interactive}:0);
54			}
55
56	williamc	1.1.2.1	sub tools {
57			my $self=shift;
58			return @{$self->{toollist}};
59			}
60
61	williamc	1.1.2.3	sub toolsetup {
62			my $self=shift;
63			my $name=shift;
64
65			my $rv=0;
66			# -- get version
67			my $version;
68			if ( @_ ) {
69			$version=shift;
70			}
71			else {
72			$version=$self->defaultversion($name);
73			if ( ! defined $version ) { $rv=1; return $rv; }
74			}
75
76			my $url;
77
78			# -- get a tool object
79			my ($tool)=$self->_toolobject($name,$version);
80
81			# -- get the url
82			if ( @_ ) {
83			$url=shift;
84			}
85			else {
86			# no url specified - try to get it from the tool
87			$url=$tool->url();
88			if ( ! defined $url ) {
89			$self->error("Unable to determine document for tool ".
90			$name." ".$version);
91			}
92			}
93			$url=$self->_download($url);
94
95	williamc	1.1.2.10	print "\n ----------- Setting Up $name $version ---------------\n";
96	williamc	1.1.2.3	require BuildSystem::ToolDoc;
97			my $doc=BuildSystem::ToolDoc->new();
98			$doc->tool($tool);
99	williamc	1.1.2.8	$doc->interactive($self->interactive());
100	williamc	1.1.2.6	$tool->reset();
101	williamc	1.1.2.3	if ( ! $doc->setup($url,$name,$version) ) {
102			$tool->store($self->_toolfile($name,$version));
103	williamc	1.1.2.7	}
104			else {
105			$self->error("Unable to find $name $version in $url");
106	williamc	1.1.2.3	}
107			undef $doc;
108			return $rv;
109			}
110
111
112	williamc	1.1.2.1	sub gettool {
113			my $self=shift;
114			my $product=shift;
115			my $version;
116
117			if ( @_ ) { $version=shift; }
118			else {
119			# lookup the default version
120			$version=$self->defaultversion($product);
121			return undef, if ( ! defined $version );
122			}
123	williamc	1.1.2.3	my ($tool,$rv)=$self->_toolobject($product,$version);
124			return ( $rv==0?$tool:undef ); # only return if already set up
125	williamc	1.1.2.1	}
126
127			sub defaultversion {
128			my $self=shift;
129			my $product=shift;
130
131			return $self->{defaults}{$product};
132			}
133
134	williamc	1.1.2.13	#
135			# return list of matching tools
136			sub _gettools {
137			my $self=shift;
138			my $tool=shift;
139
140			my @tools=();
141			if ( defined $self->{toolboxsearcher} ) {
142			my $it=$self->{toolboxsearcher}->newiterator();
143			while ( ! $it->last() ) {
144			$rtool=$it->next();
145			if ( $rtool->equals($tool) ) {
146			push @tools,$rtool;
147			}
148			}
149			}
150			return @tools;
151			}
152
153	williamc	1.1.2.3	sub _toolfile {
154			my $self=shift;
155			my $name=shift;
156			my $version=shift;
157
158	williamc	1.1.2.12	$name=~tr[A-Z][a-z];
159	williamc	1.1.2.11	return $self->{datastore}."/".$name."_$version.dat";
160	williamc	1.1.2.3	}
161
162			sub _download {
163			my $self=shift;
164			my $url=shift;
165
166			$url=~s/$self->{urlcache}\///;
167			# -- make sure we have a copy of the file
168			if ( ! -e $self->{urlcache}."/".$url ) {
169			&urlhandler::urlhandler("file:$ENV{SCRAM_HOME}/toolbox/"
170			.$url, $self->{urlcache}."/$url") ;
171			}
172			return $self->{urlcache}."/".$url;
173			}
174
175	williamc	1.1.2.1	sub _readdefaultsfile {
176			my $self=shift;
177			my $file=shift;
178
179	williamc	1.1.2.9	# -- Get defaults from the RequirementsDoc
180			my $req=$self->_requirements();
181			my $tool;
182			foreach $tool ( $req->tools()) {
183			if ( ! defined $self->{defaults}{$tool} ) {
184			$self->{defaults}{$tool}=$req->version($tool);
185			}
186			}
187
188			# -- Read the default override file
189	williamc	1.1.2.1	my $fh=FileHandle->new();
190	williamc	1.1.2.9	$fh->open("<".$file);
191	williamc	1.1.2.1	while ( <$fh> ) {
192			chomp;
193			next if /^#/;
194			next if /^\s*$/;
195			($product, $version)=split /:/;
196			$product=~tr[A-Z][a-z];
197			$self->{defaults}{$product}=$version;
198			}
199			undef $fh;
200			}
201
202	williamc	1.1.2.9	sub _requirements {
203			if ( ! defined $reqsobj ) {
204			require BuildSystem::Requirements;
205			$reqsobj=BuildSystem::Requirements->new($ENV{SCRAM_ProjReqsDoc});
206			}
207			return $reqsobj;
208			}
209	williamc	1.1.2.3
210	williamc	1.1.2.1	sub _toolobject {
211			my $self=shift;
212			my $product=shift;
213			my $version=shift;
214
215	williamc	1.1.2.5	my $rv=0;
216	williamc	1.1.2.3
217	williamc	1.1.2.1	if ( ! exists $self->{tools}{$product}{$version} ) {
218	williamc	1.1.2.3	$self->verbose("$product $version being Intitialised");
219	williamc	1.1.2.1	$self->{tools}{$product}{$version}=BuildSystem::Tool->new();
220	williamc	1.1.2.3	my $file=$self->_toolfile($product,$version);
221			if ( -f $file ) { # restore it from disk
222			$self->verbose("Recovering $product $version from $file");
223			$self->{tools}{$product}{$version}->restore($file);
224			}
225			else {
226	williamc	1.1.2.5	$rv=1;
227	williamc	1.1.2.3	$self->verbose("Tool $product $version needs set up");
228			}
229	williamc	1.1.2.1	push @{$self->{toollist}}, [$product, $version];
230			}
231	williamc	1.1.2.3	return ($self->{tools}{$product}{$version}, $rv);
232	williamc	1.1.2.1	}