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

Diff Legend

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