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.2 by williamc, Thu May 4 07:53:18 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
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 $area=shift;
68	+
69	+	my $name=$area->name();
70	+	my $version=$area->version();
71	+	my $type="_location";
72	+	my $url=$area->location();
73	+	push @{$self->{projects}}, [ ($name,$version,$type,$url) ];
74	+	$self->_save();
75	+	}
76	+
77	+	sub list {
78	+	my $self=shift;
79	+	return @{$self->{projects}};
80	+	}
81	+
82	+	sub removearea {
83	+	my $self=shift;
84	+	my $name=shift;
85	+	my $version=shift;
86	+
87	+	print "Not yet implemented\n";
88	+	}
89	+
90	+	sub link {
91	+	my $self=shift;
92	+	my $dbfile=shift;
93	+
94	+	my $newdb=Scram::ScramProjectDB->new($dbfile);
95	+	push @{$self->{linkeddbs}},$newdb;
96	+	$self->_save();
97	+	}
98	+
99	+	# -- Support Routines
100	+
101	+	#
102	+	# Search through the project list until we get a match
103	+	sub _findlocal {
104	+	my $self=shift;
105	+	my $name=shift;
106	+	my $version=shift;
107	+
108	+	my $found=-1;
109	+	for (my $i=0; $i<=$#{$self->{projects}}; $i++ ) {
110	+	if  ( ( $self->{projects}[$i][0] eq $name) &&
111	+	( $self->{projects}[$i][1] eq $version) ) {
112	+	$found=$i;
113	+	last;
114	+	}
115	+	}
116	+	return $found;
117	+	}
118	+
119	+	sub _save {
120	+	my $self=shift;
121	+
122	+	use FileHandle;
123	+	my $fh=FileHandle->new();
124	+	my $filename=$self->{dbfile}."_tmp";
125	+	open ( $fh, ">$filename" );
126	+	# print current links
127	+	foreach $db ( @{$self->{linkeddbs}} ) {
128	+	print $fh "\!DB ".$db->file()."\n";
129	+	}
130	+	# save project info
131	+	my $temp;
132	+	foreach $elem ( @{$self->{projects}} ) {
133	+	$temp=join ":", @{$elem};
134	+	print $fh $temp;
135	+	}
136	+	undef $fh;
137	+	}
138	+
139	+	sub _readdbfile {
140	+	my $self=shift;
141	+	my $file=shift;
142	+
143	+	use FileHandle;
144	+	my $fh=FileHandle->new();
145	+	open ( $fh, "<$file" );
146	+
147	+	my @vars;
148	+	while ( $map=<$fh> ) {
149	+	chomp $map;
150	+	if ( $map=~/^\!DB (.*)/ ) { # Check for other DB files
151	+	my $db=$1;
152	+	if ( -f $db ) {
153	+	$newdb=Scram::ScramProjectDB->new($db);
154	+	push @{$self->{linkeddbs}},$newdb;
155	+	}
156	+	next;
157	+	}
158	+	@vars = split ":", $map;
159	+	push @{$self->{projects}}, [ @vars ];
160	+	}
161	+	undef $fh;
162	+	}

Diff Legend

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