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.1 by williamc, Fri Apr 28 12:47:35 2000 UTC vs.
Revision 1.2 by williamc, Mon Aug 28 08:35:15 2000 UTC

#	Line 0 | Line 1
1	+	#
2	+	# ScramProjectDB.pm - Keep a track of available projects
3	+	#
4	+	# Originally Written by Christopher Williams
5	+	#
6	+	# Description
7	+	# -----------
8	+	# Stores project area information
9	+	#
10	+	# Interface
11	+	# ---------
12	+	# new(dbfile)              : A new dbobject object
13	+	# file()                   : return the db file
14	+	# getarea(name,version) : return the object matching the name version
15	+	# addarea(ConfigArea)   : add a project - return 0 for success 1 for abort
16	+	# list()                : list areas (retunns $name,$version pairs)
17	+	# removearea(name,version) : remove the named project
18	+	# link(dblocation) : link with specified db
19	+	# unlink(dblocation) : remove link with a specified db
20	+
21	+	package Scram::ScramProjectDB;
22	+	use Utilities::Verbose;
23	+	require 5.004;
24	+	@ISA=qw(Utilities::Verbose);
25	+
26	+	sub new {
27	+	my $class=shift;
28	+	my $self={};
29	+	bless $self, $class;
30	+	$self->{dbfile}=shift;
31	+	$self->_readdbfile($self->{dbfile});
32	+	$self->{projectobjects}={};
33	+	return $self;
34	+	}
35	+
36	+	sub file {
37	+	my $self=shift;
38	+	return $self->{dbfile};
39	+	}
40	+
41	+	sub getarea {
42	+	my $self=shift;
43	+	my $name=shift;
44	+	my $version=shift;
45	+
46	+	my $area;
47	+	my $index=$self->_findlocal($name,$version);
48	+	if ( $index != -1 ) {
49	+	my $location=$self->{projects}[$index][3];
50	+	if ( defined $self->{projectobjects}{$location} ) {
51	+	$area=$self->{projectobjects}{$location};
52	+	}
53	+	else {
54	+	$area=Configuration::ConfigArea->new();
55	+	$self->verbose("Attempt to ressurect $name $version from $location");
56	+	if ( $area->bootstrapfromlocation($location) == 1 ) {
57	+	undef $area;
58	+	$self->verbose("attempt unsuccessful");
59	+	}
60	+	else {
61	+	$self->verbose("area found");
62	+	$self->{projectobjects}{$location}=$area;
63	+	}
64	+	}
65	+	}
66	+	else {
67	+	$self->verbose("Area $name $version not found");
68	+	}
69	+	return $area;
70	+	}
71	+
72	+	sub addarea {
73	+	my $self=shift;
74	+	my $name=shift;
75	+	my $version=shift;
76	+	my $area=shift;
77	+
78	+	my $rv=1;
79	+
80	+	#my $type="_location"; not ready for this yet
81	+	my $type="file";
82	+	my $url=$area->location()."/.SCRAM/InstallFile";
83	+	# -- check for duplicates
84	+	for ( my $index=0; $index<=$#{$self->{projects}}; $index++ ) {
85	+	if  ( $self->{projects}[$index][0] eq $name ) {
86	+	if ( $self->{projects}[$index][1] eq $version ) {
87	+	print "$name $version alreay exists. Overwrite (y/n)\n";
88	+	if ( ! (<STDIN>=~/y/i ) ) {
89	+	print "Aborting install ...\n";
90	+	return 1;
91	+	}
92	+	else {
93	+	$rv=0;
94	+	$self->{projects}[$index]=[ ($name,$version,$type,$url) ];
95	+	}
96	+	}
97	+	else {
98	+	print "Related Project : $name ".$self->{projects}[$index][1]."\n";
99	+	}
100	+	}
101	+	}
102	+	if ( $rv ) {
103	+	# -- add to our list and save
104	+	push @{$self->{projects}}, [ ($name,$version,$type,$url) ];
105	+	}
106	+	$self->_save();
107	+	return 0;
108	+	}
109	+
110	+	sub list {
111	+	my $self=shift;
112	+	return @{$self->{projects}};
113	+	}
114	+
115	+	sub removearea {
116	+	my $self=shift;
117	+	my $name=shift;
118	+	my $version=shift;
119	+
120	+	print "Not yet implemented\n";
121	+	}
122	+
123	+	sub link {
124	+	my $self=shift;
125	+	my $dbfile=shift;
126	+
127	+	my $newdb=Scram::ScramProjectDB->new($dbfile);
128	+	push @{$self->{linkeddbs}},$newdb;
129	+	$self->_save();
130	+	}
131	+
132	+	# -- Support Routines
133	+
134	+	#
135	+	# Search through the project list until we get a match
136	+	sub _findlocal {
137	+	my $self=shift;
138	+	my $name=shift;
139	+	my $version=shift;
140	+
141	+	my $found=-1;
142	+	for (my $i=0; $i<=$#{$self->{projects}}; $i++ ) {
143	+	if  ( ( $self->{projects}[$i][0] eq $name) &&
144	+	( $self->{projects}[$i][1] eq $version) ) {
145	+	$found=$i;
146	+	last;
147	+	}
148	+	}
149	+	return $found;
150	+	}
151	+
152	+	sub _save {
153	+	my $self=shift;
154	+
155	+	use FileHandle;
156	+	my $fh=FileHandle->new();
157	+	my $filename=$self->{dbfile};
158	+	open ( $fh, ">$filename" );
159	+	# print current links
160	+	foreach $db ( @{$self->{linkeddbs}} ) {
161	+	print $fh "\!DB ".$db->file()."\n";
162	+	}
163	+	# save project info
164	+	my $temp;
165	+	foreach $elem ( @{$self->{projects}} ) {
166	+	$temp=join ":", @{$elem};
167	+	print $fh $temp."\n";
168	+	}
169	+	undef $fh;
170	+	}
171	+
172	+	sub _readdbfile {
173	+	my $self=shift;
174	+	my $file=shift;
175	+
176	+	use FileHandle;
177	+	my $fh=FileHandle->new();
178	+	open ( $fh, "<$file" );
179	+
180	+	my @vars;
181	+	while ( $map=<$fh> ) {
182	+	chomp $map;
183	+	if ( $map=~/^\!DB (.*)/ ) { # Check for other DB files
184	+	my $db=$1;
185	+	if ( -f $db ) {
186	+	$newdb=Scram::ScramProjectDB->new($db);
187	+	push @{$self->{linkeddbs}},$newdb;
188	+	}
189	+	next;
190	+	}
191	+	@vars = split ":", $map;
192	+	push @{$self->{projects}}, [ @vars ];
193	+	}
194	+	undef $fh;
195	+	}

Diff Legend

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