ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

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

Comparing COMP/SCRAM/src/Scram/ScramProjectDB.pm (file contents):
Revision 1.4 by sashby, Mon May 28 09:06:44 2001 UTC vs.
Revision 1.8 by sashby, Fri Dec 10 13:41:42 2004 UTC

#	Line 40 | Line 40 | sub file {
40		return $self->{dbfile};
41		}
42
43	<	sub getarea {
44	<	require Configuration::ConfigArea;
45	<	my $self=shift;
46	<	my $name=shift;
47	<	my $version=shift;
48	<
49	<	my $area=undef;
50	<	my $index=$self->_findlocal($name,$version);
51	<	if ( $index != -1 ) {
52	<	my $location=$self->{projects}[$index][3];
53	<	if ( defined $self->{projectobjects}{$location} ) {
54	<	$area=$self->{projectobjects}{$location};
43	>	sub getarea
44	>	{
45	>	require Configuration::ConfigArea;
46	>	my $self=shift;
47	>	my $name=shift;
48	>	my $version=shift;
49	>	my $area=undef;
50	>	my $index=$self->_findlocal($name,$version);
51	>
52	>	if ( $index != -1 )
53	>	{
54	>	my $location=$self->{projects}[$index][3];
55	>	if ( defined $self->{projectobjects}{$location} )
56	>	{
57	>	$area=$self->{projectobjects}{$location};
58		}
59	<	else {
59	>	else
60	>	{
61		$area=Configuration::ConfigArea->new();
62		$self->verbose("Attempt to ressurect $name $version from $location");
63	<	if ( $area->bootstrapfromlocation($location) == 1 ) {
64	<	undef $area;
65	<	$self->verbose("attempt unsuccessful");
66	<	}
67	<	else {
68	<	$self->verbose("area found");
69	<	$self->{projectobjects}{$location}=$area;
63	>	if ( $area->bootstrapfromlocation($location) == 1 )
64	>	{
65	>	undef $area;
66	>	$self->verbose("attempt unsuccessful");
67	>	}
68	>	else
69	>	{
70	>	$self->verbose("area found");
71	>	$self->{projectobjects}{$location}=$area;
72	>	}
73		}
74	+	}
75	+	else
76	+	{
77	+	# -- search in linked databases
78	+	foreach $db ( @{$self->{linkeddbs}} )
79	+	{
80	+	$self->verbose("Searching in $db->file() for $name $version");
81	+	$area=$db->getarea($name,$version);
82	+	last if (defined $area);
83		}
84	<	}
85	<	else {
86	<	# -- search in linked databases
87	<	foreach $db ( @{$self->{linkeddbs}} ) {
88	<	$self->verbose("Searching in $db->file() for $name $version");
89	<	$area=$db->getarea($name,$version);
90	<	last if (defined $area);
91	<	}
92	<	}
93	<	if ( ! defined $area ) {
94	<	$self->verbose("Area $name $version not found");
95	<	}
96	<	return $area;
97	<	}
98	<
99	<	sub addarea {
100	<	my $self=shift;
101	<	my $name=shift;
102	<	my $version=shift;
103	<	my $area=shift;
104	<
105	<	my $rv=1;
106	<	my $type="file";
107	<	my $url=$area->location()."/.SCRAM/InstallFile";
108	<	# -- check for duplicates
109	<	for ( my $index=0; $index<=$#{$self->{projects}}; $index++ ) {
110	<	if  ( $self->{projects}[$index][0] eq $name ) {
111	<	if ( $self->{projects}[$index][1] eq $version ) {
112	<	print "$name $version already exists. Overwrite? (y/n) :";
113	<	if ( ! (<STDIN>=~/y/i ) ) {
114	<	print "Aborting install ...\n";
99	<	return 1;
100	<	}
101	<	else {
84	>	}
85	>	if ( ! defined $area )
86	>	{
87	>	$self->verbose("Area $name $version not found");
88	>	}
89	>
90	>	return $area;
91	>	}
92	>
93	>
94	>	sub addarea
95	>	{
96	>	my $self=shift;
97	>	my $flag=shift;
98	>	my $name=shift;
99	>	my $version=shift;
100	>	my $area=shift;
101	>
102	>	my $rv=1;
103	>	my $type="file";
104	>	my $url=$area->location();
105	>
106	>	# -- check for duplicates
107	>	for ( my $index=0; $index<=$#{$self->{projects}}; $index++ )
108	>	{
109	>	if  ( $self->{projects}[$index][0] eq $name )
110	>	{
111	>	if ( $self->{projects}[$index][1] eq $version )
112	>	{
113	>	if ($flag == 1)
114	>	{
115		$rv=0;
116		$self->{projects}[$index]=[ ($name,$version,$type,$url) ];
117	+	}
118	+	else
119	+	{
120	+	print "$name $version already exists. Overwrite? (y/n) : ";
121	+	if ( ! (<STDIN>=~/y/i ) )
122	+	{
123	+	print "Aborting install ...\n";
124	+	return 1;
125	+	}
126	+	else
127	+	{
128	+	$rv=0;
129	+	$self->{projects}[$index]=[ ($name,$version,$type,$url) ];
130	+	}
131	+	}
132		}
133	<	}
134	<	else {
133	>	else
134	>	{
135		print "Related Project : $name ".$self->{projects}[$index][1]."\n";
136	<	}
136	>	}
137		}
138	<	}
139	<	if ( $rv ) {
140	<	# -- add to our list and save
141	<	push @{$self->{projects}}, [ ($name,$version,$type,$url) ];
142	<	}
143	<	$self->_save();
144	<	return 0;
145	<	}
138	>	}
139	>
140	>	if ( $rv )
141	>	{
142	>	# -- add to our list and save
143	>	push @{$self->{projects}}, [ ($name,$version,$type,$url) ];
144	>	}
145	>
146	>	$self->_save();
147	>	return 0;
148	>	}
149
150		sub listlinks {
151		my $self=shift;
#	Line 134 | Line 165 | sub list {
165		sub listall {
166		my $self=shift;
167		my @list=$self->list();
168	<
168	>
169		foreach $db ( @{$self->{linkeddbs}} ) {
170		$self->verbose("Adding list from $db");
171		push @list, $db->listall();
172		}
173	+
174		return @list;
175		}
176
177	<	sub removearea {
178	<	my $self=shift;
179	<	my $name=shift;
180	<	my $version=shift;
181	<
182	<	print "Not yet implemented\n";
183	<	}
177	>	sub removearea
178	>	{
179	>	###############################################################
180	>	# removearea(name,version)                                    #
181	>	###############################################################
182	>	# modified : Mon May 28 11:24:29 2001 / SFA                   #
183	>	# params   :                                                  #
184	>	#          :                                                  #
185	>	#          :                                                  #
186	>	#          :                                                  #
187	>	# function : Remove project area from scramdb file.           #
188	>	#          :                                                  #
189	>	#          :                                                  #
190	>	###############################################################
191	>	my $self=shift;
192	>	my $flag=shift;
193	>	my $name=shift;
194	>	my $version=shift;
195	>	my $vfound=0;
196	>	my $nfound=0;
197	>
198	>	print "\n","Going to remove $name $version from the current scram database.....","\n";
199	>	print "\n";
200	>
201	>	for ( my $index=0; $index<=$#{$self->{projects}}; $index++ )
202	>	{
203	>	# Look for a project with name $name:
204	>	if  ( $self->{projects}[$index][0] eq $name )
205	>	{
206	>	$nfound=1;
207	>	# Check the version:
208	>	if ( $self->{projects}[$index][1] eq $version )
209	>	{
210	>	# We have a match for project name and version:
211	>	$vfound=1;
212	>	if ($flag == 1)
213	>	{
214	>	# Remove the project:
215	>	print "\n";
216	>	print "Removing project:\t$name\t$version","\n\n";
217	>	splice(@{$self->{projects}},$index,1);
218	>	}
219	>	else
220	>	{
221	>	print "Project $name Version $version exists. Remove it? (y/n): ";
222	>	if ( ! (<STDIN>=~/y/i ) )
223	>	{
224	>	print "\n","Aborting project removal...bye.\n\n";
225	>	return 1;
226	>	}
227	>	else
228	>	{
229	>	# Remove the project:
230	>	print "\n";
231	>	print "Removing project:\t$name\t$version","\n\n";
232	>	splice(@{$self->{projects}},$index,1);
233	>	}
234	>	}
235	>	}
236	>	}
237	>	}
238	>
239	>	if ( ! $nfound || ! $vfound )
240	>	{
241	>	# There was a problem finding either the
242	>	# named project or the desired version:
243	>	print "ERROR: Unable to find project $name with version $version in the database.","\n\n";
244	>	return 1;
245	>	}
246	>
247	>	print "\n";
248	>	# Save our new array:
249	>	$self->_save();
250	>	return 0;
251	>	}
252
253		sub link {
254		my $self=shift;
#	Line 162 | Line 262 | sub link {
262		sub unlink {
263		my $self=shift;
264		my $file=shift;
165	–
265		my $db;
266	+
267		for (my $i=0; $i<=$#{$self->{linkeddbs}}; $i++ ) {
268		$db=${$self->{linkeddbs}}[$i];
269		if  ( $db->file() eq $file ) {

Diff Legend

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