1 |
#____________________________________________________________________
|
2 |
# File: ToolCache.pm
|
3 |
#____________________________________________________________________
|
4 |
#
|
5 |
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
|
6 |
# Update: 2003-10-28 10:14:08+0100
|
7 |
# Revision: $Id: ToolCache.pm,v 1.2.2.1 2006/05/17 12:11:39 sashby Exp $
|
8 |
#
|
9 |
# Copyright: 2003 (C) Shaun Ashby
|
10 |
#
|
11 |
#--------------------------------------------------------------------
|
12 |
package BuildSystem::ToolCache;
|
13 |
require 5.004;
|
14 |
|
15 |
use Exporter;
|
16 |
@ISA=qw(Exporter);
|
17 |
#
|
18 |
sub new()
|
19 |
{
|
20 |
my $proto=shift;
|
21 |
my $class=ref($proto) || $proto;
|
22 |
my $self =
|
23 |
{
|
24 |
DOWNLOADED => { tools => undef, url => undef }, # Downloaded tool infos;
|
25 |
SELECTED => undef, # The selected tools (info from RequirementsDoc);
|
26 |
DEFAULTVERSIONS => {}, # Hash of tools and their default version;
|
27 |
RAW => [], # The tools to be set up (the raw data from the tool docs);
|
28 |
SETUP => {}, # The saved set-up data;
|
29 |
STAMP => undef # The last time the cache was modified
|
30 |
};
|
31 |
|
32 |
bless $self,$class;
|
33 |
return $self;
|
34 |
}
|
35 |
|
36 |
sub downloadedtools()
|
37 |
{
|
38 |
my $self=shift;
|
39 |
# Returns an array of downloaded tools, basically all
|
40 |
# those listed in configuration:
|
41 |
@_ ? $self->{DOWNLOADED}{tools} = shift #
|
42 |
: $self->{DOWNLOADED}{tools};
|
43 |
}
|
44 |
|
45 |
sub defaultversions()
|
46 |
{
|
47 |
my $self=shift;
|
48 |
# Returns a hash of tools and their default versions:
|
49 |
@_ ? $self->{DEFAULTVERSIONS} = shift #
|
50 |
: $self->{DEFAULTVERSIONS};
|
51 |
}
|
52 |
|
53 |
sub toolurls()
|
54 |
{
|
55 |
my $self=shift;
|
56 |
# Returns a hash of tools and their URLs:
|
57 |
@_ ? $self->{DOWNLOADED}->{url} = shift #
|
58 |
: $self->{DOWNLOADED}->{url};
|
59 |
}
|
60 |
|
61 |
sub selected()
|
62 |
{
|
63 |
my $self=shift;
|
64 |
# Returns hash of selected tools:
|
65 |
@_ ? $self->{SELECTED} = $_[0]
|
66 |
: $self->{SELECTED};
|
67 |
}
|
68 |
|
69 |
sub addtoselected()
|
70 |
{
|
71 |
my $self=shift;
|
72 |
my ($toolname)=@_;
|
73 |
# When "scram setup X" is used to add new tool to environment, we need a way to add this tool
|
74 |
# to the list of selected tools. Otherwise, runtime env won't work.
|
75 |
# Need to check to see if this tool already exists in the SELECTED hash.
|
76 |
# Only try to add a new rank if tool doesn't already exist:
|
77 |
if (! exists $self->{SELECTED}->{$toolname})
|
78 |
{
|
79 |
# First, check the highest rank (just number of elements [i.e., keys in hash]). Next
|
80 |
# tool added will get next number:
|
81 |
my $nextrank = (keys %{$self->{SELECTED}}) + 1;
|
82 |
$self->{SELECTED}->{$toolname} = $nextrank;
|
83 |
}
|
84 |
}
|
85 |
|
86 |
sub store()
|
87 |
{
|
88 |
my $self=shift;
|
89 |
# Store ToolParser objects (tools not set up yet):
|
90 |
@_ ? push(@{$self->{RAW}},@_) #
|
91 |
: @{$self->{RAW}};
|
92 |
}
|
93 |
|
94 |
sub rawtools()
|
95 |
{
|
96 |
my $self=shift;
|
97 |
# Return a list of tools
|
98 |
return @{$self->{RAW}};
|
99 |
}
|
100 |
|
101 |
sub setup()
|
102 |
{
|
103 |
my $self=shift;
|
104 |
# Returns a hash of toolname/ToolData objects (set-up tools):
|
105 |
return $self->{SETUP};
|
106 |
}
|
107 |
|
108 |
sub cleanup_raw()
|
109 |
{
|
110 |
my $self=shift;
|
111 |
my ($tremoved)=@_;
|
112 |
my $newrtools=[];
|
113 |
|
114 |
# Remove the tool from the list of raw tool objects:
|
115 |
foreach my $rawtool (@{$self->{RAW}})
|
116 |
{
|
117 |
# Find the tool name from the ToolParser object $rawtool:
|
118 |
if ($tremoved eq $rawtool->toolname())
|
119 |
{
|
120 |
print "Removing ToolParser $tremoved from cache.","\n";
|
121 |
}
|
122 |
else
|
123 |
{
|
124 |
push(@{$newrtools},$rawtool);
|
125 |
}
|
126 |
}
|
127 |
|
128 |
# Remove from list of selected tools and version list:
|
129 |
delete $self->{SELECTED}->{$tremoved};
|
130 |
delete $self->{DEFAULTVERSIONS}->{$tremoved};
|
131 |
# Now save the new tool list:
|
132 |
$self->{RAW} = $newrtools;
|
133 |
}
|
134 |
|
135 |
sub inheritcontent()
|
136 |
{
|
137 |
my $self=shift;
|
138 |
my ($externaltm)=@_;
|
139 |
|
140 |
# Inherit all tool data from an external scram-managed project.
|
141 |
# Basically copy RAW, SETUP and SELECTED hash data:
|
142 |
$self->{RAW} = [ $externaltm->rawtools() ];
|
143 |
$self->{SETUP} = $externaltm->setup();
|
144 |
|
145 |
my $tmpselected = $externaltm->selected();
|
146 |
|
147 |
# We add the downloaded SELECTED entries to our existing SELECTED data
|
148 |
# in the same order as they already appear:
|
149 |
foreach my $entry ( sort { %{$tmpselected}->{$a}
|
150 |
<=> %{$tmpselected}->{$b}}
|
151 |
keys %{$tmpselected} )
|
152 |
{
|
153 |
# Now add them to selected data:
|
154 |
$self->addtoselected($entry);
|
155 |
}
|
156 |
}
|
157 |
|
158 |
### Read/write from/to cachefile:
|
159 |
sub name()
|
160 |
{
|
161 |
my $self = shift;
|
162 |
# Set the name of the cache file:
|
163 |
@_ ? $self->{CACHENAME} = shift #
|
164 |
: $self->{CACHENAME};
|
165 |
}
|
166 |
|
167 |
sub writecache()
|
168 |
{
|
169 |
my $self=shift;
|
170 |
use Cache::CacheUtilities;
|
171 |
&Cache::CacheUtilities::write($self,$self->{CACHENAME});
|
172 |
}
|
173 |
|
174 |
1;
|
175 |
|