ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/Scram/ScramFunctions.pm

Comparing COMP/SCRAM/src/Scram/ScramFunctions.pm (file contents):
Revision 1.1 by williamc, Wed Aug 9 15:58:28 2000 UTC vs.
Revision 1.1.2.6 by williamc, Mon Aug 21 18:41:52 2000 UTC

#	Line 0 | Line 1
1	+	#
2	+	# ScramFunctions.pm
3	+	#
4	+	# Written by Christopher Williams
5	+	#
6	+	# Description
7	+	#
8	+	# Interface
9	+	# ---------
10	+	# new()         : A new ScramCommands object
11	+	# project(urlstring,dir[,areaname]): Create a project from the given url file
12	+	#                                       return the area
13	+	# satellite(name,version,installdirectory[,areaname]): create a satellite
14	+	#                                       project from the specified name version
15	+	# addareatoDB(ConfigArea[,name[,version]]) : add area to the db
16	+	# globalcache([cachedirectory])) : return the global cache object/set at dir.
17	+	# scramprojectdb()              : return the scram project DB object
18	+	# areatoolbox(ConfigArea) : return the toolbox of the specified area
19	+	# setuptoolsinarea($area[,$toolname[,$toolversion[,toolfile]) : setup
20	+	# arch()                : get/set the architecture string
21	+
22	+	package Scram::ScramFunctions;
23	+	use URL::URLcache;
24	+	use Utilities::Verbose;
25	+	require 5.004;
26	+
27	+	@ISA=qw(Utilities::Verbose);
28	+
29	+	sub new {
30	+	my $class=shift;
31	+	$self={};
32	+	bless $self, $class;
33	+	# -- default settings
34	+	$self->{cachedir}=$ENV{HOME}."/.SCRAM/globalcache";
35	+	$self->{scramprojectsdbdir}=$ENV{SCRAM_LOOKUPDB};
36	+	return $self;
37	+	}
38	+
39	+	sub project {
40	+	my $self=shift;
41	+	my $url=shift;
42	+	my $installarea=shift;
43	+
44	+	my $areaname="";
45	+	if ( @_ ) {
46	+	$areaname=shift;
47	+	}
48	+	require Configuration::BootStrapProject;
49	+	my $bs=Configuration::BootStrapProject->
50	+	new($self->globalcache(),$installarea);
51	+	$self->verbose("BootStrapping $url");
52	+	my $area=$bs->boot($url,$areaname);
53	+	if ( ! defined $area ) {
54	+	$self->error("Unable to create project area");
55	+	}
56	+	$area->archname($self->arch());
57	+
58	+	# -- download all tool description files
59	+	my $req=$self->arearequirements($area);
60	+	if ( defined $req ) {
61	+	$req->download($self->areatoolbox($area));
62	+	}
63	+
64	+	return $area;
65	+	}
66	+
67	+	sub setuptoolsinarea {
68	+	my $self=shift;
69	+	my $area=shift;
70	+
71	+	# -- initialise
72	+	$self->_allprojectinitsearcher();
73	+
74	+	# -- create a new toolbox object
75	+	my $toolbox=$self->areatoolbox($area);
76	+	$toolbox->searcher($self->_projsearcher());
77	+
78	+	if ( @_ ) {
79	+	# -- specific tool specified
80	+	if ( my $rv=$toolbox->toolsetup(@_) ) {
81	+	if ( $rv eq 1 ) {
82	+	print "Unknown tool $toolname @ARGV\n";
83	+	exit 1;
84	+	}
85	+	}
86	+	}
87	+	else {
88	+	# -- setup all tools specified in the requirements doc
89	+	my $reqs=$self->arearequirements($area);
90	+	$self->verbose("Setup ToolBox from Requirements doc ($reqs)");
91	+	$reqs->setup($toolbox);
92	+	}
93	+	}
94	+
95	+	sub satellite {
96	+	my $self=shift;
97	+	my $name=shift;
98	+	my $version=shift;
99	+	my $installarea=shift;
100	+
101	+	my $areaname="";
102	+	if ( @_ ) {
103	+	$areaname=shift;
104	+	}
105	+
106	+	# -- look up scram database for location
107	+	my $relarea=$self->_lookupareaindb($name,$version);
108	+	if ( ! defined $relarea ) {
109	+	$self->error("Unable to Find Project $name $version");
110	+	}
111	+
112	+	# -- create satellite
113	+	my $area=$relarea->satellite($installarea,$areaname);
114	+	$area->archname($self->arch());
115	+
116	+	# -- copy setup info - deprecated by toolbox copy method
117	+	#$relarea->copysetup($area->location());
118	+
119	+	# -- copy toolbox
120	+	my $rtb=$self->areatoolbox($relarea);
121	+	my $tb=$self->areatoolbox($area);
122	+	$rtb->copytools($tb);
123	+
124	+	# -- copy configuration directory
125	+	if ( ! -d $area->location()."/".$area->configurationdir() ) {
126	+	use Utilities::AddDir;
127	+	AddDir::copydir($relarea->location()."/".$relarea->configurationdir(),
128	+	$area->location()."/".$area->configurationdir() );
129	+	}
130	+
131	+	# -- copy RequirementsDoc
132	+	if ( ! -f $area->requirementsdoc() ) {
133	+	copy( $relarea->requirementsdoc() , $area->requirementsdoc());
134	+	}
135	+
136	+	return $area;
137	+	}
138	+
139	+	sub addareatoDB {
140	+	my $self=shift;
141	+	my $area=shift;
142	+	my $tagname=shift;
143	+	my $version=shift;
144	+
145	+	# -- create defaults if necessary
146	+	if ( (! defined $version)  || ( $version eq "") ) {
147	+	$version=$area->version();
148	+	}
149	+	if ( (! defined $tagname)  || ( $tagname eq "") ) {
150	+	$tagname=$area->name();
151	+	}
152	+
153	+	# -- Add to the DB
154	+	$self->scramprojectdb()->addarea($tagname,$version,$area);
155	+	}
156	+
157	+	sub globalcache {
158	+	my $self=shift;
159	+	if ( @_ ) {
160	+	$self->{cachedir}=shift;
161	+	}
162	+	if ( ! defined $self->{globalcache} ) {
163	+	$self->{globalcache}=URL::URLcache->new($self->{cachedir});
164	+	}
165	+	return $self->{globalcache};
166	+	}
167	+
168	+
169	+	sub scramprojectdb {
170	+	my $self=shift;
171	+	if ( @_ ) {
172	+	$self->{scramprojectsdbdir}=shift;
173	+	}
174	+	if ( ! defined $self->{scramprojectsdb} ) {
175	+	require Scram::ScramProjectDB;
176	+	$self->{scramprojectsdb}=Scram::ScramProjectDB->new(
177	+	$self->{scramprojectsdbdir} );
178	+	$self->{scramprojectsdb}->verbosity($self->verbosity());
179	+	}
180	+	return $self->{scramprojectsdb};
181	+	}
182	+
183	+	sub areatoolbox {
184	+	my $self=shift;
185	+	my $area=shift;
186	+
187	+	my $name=$area->location();
188	+	if ( ! defined $self->{toolboxes}{$name} ) {
189	+	# -- create a new toolbox object
190	+	require BuildSystem::ToolBox;
191	+	$self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area);
192	+	$self->{toolboxes}{$name}->verbosity($self->verbosity());
193	+	}
194	+	return $self->{toolboxes}{$name};
195	+	}
196	+
197	+	sub arearequirements {
198	+	my $self=shift;
199	+	my $area=shift;
200	+
201	+	my $name=$area->location();
202	+	if ( ! defined $self->{requirements}{$name} ) {
203	+	# -- create a new toolbox object
204	+	require BuildSystem::Requirements;
205	+	my $doc=$area->requirementsdoc();
206	+	my $cache=$area->cache();
207	+	my $db=$area->objectstore();
208	+	$self->{requirements}{$name}=
209	+	BuildSystem::Requirements->new("file:".$doc,$cache,$db);
210	+	$self->{requirements}{$name}->verbosity($self->verbosity());
211	+	$self->verbose("Requirements Doc (".$self->{requirements}{$name}.
212	+	") for area :\n $name\n initiated from $doc");
213	+	}
214	+	else {
215	+	$self->verbose("Requirements Doc (".$self->{requirements}{$name}.")");
216	+	}
217	+	return $self->{requirements}{$name};
218	+	}
219	+
220	+	sub arch {
221	+	my $self=shift;
222	+
223	+	@_?$self->{arch}=shift
224	+	:$self->{arch};
225	+	}
226	+
227	+	# -------------- Support Routines ------------------------------
228	+
229	+
230	+	sub _allprojectinitsearcher {
231	+	if ( ! defined $self->{projsearcher} ) {
232	+	my $search=_projsearcher();
233	+	foreach $proj ( $self->scramprojectdb()->list() ) {
234	+	$search->addproject($$proj[0],$$proj[1]);
235	+	}
236	+	}
237	+	}
238	+
239	+	sub _projsearcher {
240	+	if ( ! defined $self->{projsearcher} ) {
241	+	require Scram::ProjectSearcher;
242	+	$self->{projsearcher}=Scram::ProjectSearcher->new(
243	+	$self->scramprojectdb());
244	+	}
245	+	return $self->{projsearcher};
246	+	}
247	+
248	+
249	+	sub _lookupareaindb {
250	+	my $self=shift;
251	+
252	+	my $area=undef;
253	+	# -- Look up the area in the databse
254	+	my @areas=$self->scramprojectdb()->getarea(@_);
255	+	if ( $#areas > 0 ) { #ambigous
256	+	# could ask user - for now just error
257	+	$self->error("Ambigous request - please be more specific");
258	+	}
259	+	elsif ( $#areas != 0 ) { #not found
260	+	$self->error("The project requested has not been found");
261	+	}
262	+	else {
263	+	$area=$areas[0];
264	+	}
265	+	return $area;
266	+	}

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines