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.1.2.3 by williamc, Thu May 11 14:57:52 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	+	return $self;
33	+	}
34	+
35	+	sub file {
36	+	my $self=shift;
37	+	return $self->{dbfile};
38	+	}
39	+
40	+	sub getarea {
41	+	my $self=shift;
42	+	my $name=shift;
43	+	my $version=shift;
44	+
45	+	my $area;
46	+	my $index=$self->_findlocal($name,$version);
47	+	if ( $index != -1 ) {
48	+	my $location=$self->{projects}[$index][3];
49	+	$area=Configuration::ConfigArea->new();
50	+	$self->verbose("Attempt to ressurect $name $version from $location");
51	+	if ( $area->bootstrapfromlocation($location) == 1 ) {
52	+	undef $area;
53	+	$self->verbose("attempt unsuccessful");
54	+	}
55	+	else {
56	+	$self->verbose("area found");
57	+	}
58	+	}
59	+	else {
60	+	$self->verbose("Area $name $version not found");
61	+	}
62	+	return $area;
63	+	}
64	+
65	+	sub addarea {
66	+	my $self=shift;
67	+	my $name=shift;
68	+	my $version=shift;
69	+	my $area=shift;
70	+
71	+	my $rv=1;
72	+
73	+	#my $type="_location"; not ready for this yet
74	+	my $type="file";
75	+	my $url=$area->location()."/.SCRAM/InstallFile";
76	+	# -- check for duplicates
77	+	for ( my $index=0; $index<=$#{$self->{projects}}; $index++ ) {
78	+	if  ( $self->{projects}[$index][0] eq $name ) {
79	+	if ( $self->{projects}[$index][1] eq $version ) {
80	+	print "$name $version alreay exists. Overwrite (y/n)\n";
81	+	if ( ! (<STDIN>=~/y/i ) ) {
82	+	print "Aborting install ...\n";
83	+	return 1;
84	+	}
85	+	else {
86	+	$rv=0;
87	+	$self->{projects}[$index]=[ ($name,$version,$type,$url) ];
88	+	}
89	+	}
90	+	else {
91	+	print "Related Project : $name ".$self->{projects}[$index][1]."\n";
92	+	}
93	+	}
94	+	}
95	+	if ( $rv ) {
96	+	# -- add to our list and save
97	+	push @{$self->{projects}}, [ ($name,$version,$type,$url) ];
98	+	}
99	+	$self->_save();
100	+	return 0;
101	+	}
102	+
103	+	sub list {
104	+	my $self=shift;
105	+	return @{$self->{projects}};
106	+	}
107	+
108	+	sub removearea {
109	+	my $self=shift;
110	+	my $name=shift;
111	+	my $version=shift;
112	+
113	+	print "Not yet implemented\n";
114	+	}
115	+
116	+	sub link {
117	+	my $self=shift;
118	+	my $dbfile=shift;
119	+
120	+	my $newdb=Scram::ScramProjectDB->new($dbfile);
121	+	push @{$self->{linkeddbs}},$newdb;
122	+	$self->_save();
123	+	}
124	+
125	+	# -- Support Routines
126	+
127	+	#
128	+	# Search through the project list until we get a match
129	+	sub _findlocal {
130	+	my $self=shift;
131	+	my $name=shift;
132	+	my $version=shift;
133	+
134	+	my $found=-1;
135	+	for (my $i=0; $i<=$#{$self->{projects}}; $i++ ) {
136	+	if  ( ( $self->{projects}[$i][0] eq $name) &&
137	+	( $self->{projects}[$i][1] eq $version) ) {
138	+	$found=$i;
139	+	last;
140	+	}
141	+	}
142	+	return $found;
143	+	}
144	+
145	+	sub _save {
146	+	my $self=shift;
147	+
148	+	use FileHandle;
149	+	my $fh=FileHandle->new();
150	+	my $filename=$self->{dbfile};
151	+	open ( $fh, ">$filename" );
152	+	# print current links
153	+	foreach $db ( @{$self->{linkeddbs}} ) {
154	+	print $fh "\!DB ".$db->file()."\n";
155	+	}
156	+	# save project info
157	+	my $temp;
158	+	foreach $elem ( @{$self->{projects}} ) {
159	+	$temp=join ":", @{$elem};
160	+	print $fh $temp."\n";
161	+	}
162	+	undef $fh;
163	+	}
164	+
165	+	sub _readdbfile {
166	+	my $self=shift;
167	+	my $file=shift;
168	+
169	+	use FileHandle;
170	+	my $fh=FileHandle->new();
171	+	open ( $fh, "<$file" );
172	+
173	+	my @vars;
174	+	while ( $map=<$fh> ) {
175	+	chomp $map;
176	+	if ( $map=~/^\!DB (.*)/ ) { # Check for other DB files
177	+	my $db=$1;
178	+	if ( -f $db ) {
179	+	$newdb=Scram::ScramProjectDB->new($db);
180	+	push @{$self->{linkeddbs}},$newdb;
181	+	}
182	+	next;
183	+	}
184	+	@vars = split ":", $map;
185	+	push @{$self->{projects}}, [ @vars ];
186	+	}
187	+	undef $fh;
188	+	}

Diff Legend

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