src/Scram/ScramProjectDB.pm

#
# ScramProjectDB.pm - Keep a track of available projects
#
# Originally Written by Christopher Williams
#
# Description
# -----------
# Stores project area information
#
# Interface
# ---------
# new(dbfile)              : A new dbobject object
# file()                   : return the db file
# getarea(name,version) : return the object matching the name version
# addarea(ConfigArea)   : add a project - return 0 for success 1 for abort
# list()                : list local areas (retunns $name,$version pairs)
# listall()             : list local and linked areas
# listlinks()           : Show a list of links
# removearea(name,version) : remove the named project
# link(dblocation) : link with specified db 
# unlink(dblocation) : remove link with a specified db

package Scram::ScramProjectDB;
use Utilities::Verbose;
require 5.004;
@ISA=qw(Utilities::Verbose);

sub new {
        my $class=shift;
        my $self={};
        bless $self, $class;
        $self->{dbfile}=shift;
        $self->_readdbfile($self->{dbfile});
        $self->{projectobjects}={};
        return $self;
}

sub file {
        my $self=shift;
        return $self->{dbfile};
}

sub getarea {
        require Configuration::ConfigArea;
        my $self=shift;
        my $name=shift;
        my $version=shift;

        my $area=undef;
        my $index=$self->_findlocal($name,$version);
        if ( $index != -1 ) {   
         my $location=$self->{projects}[$index][3];
         if ( defined $self->{projectobjects}{$location} ) {
           $area=$self->{projectobjects}{$location};
         }
         else {
         $area=Configuration::ConfigArea->new();
         $self->verbose("Attempt to ressurect $name $version from $location");
         if ( $area->bootstrapfromlocation($location) == 1 ) {
           undef $area;
           $self->verbose("attempt unsuccessful");
         }
         else {
           $self->verbose("area found");
           $self->{projectobjects}{$location}=$area;
         }
         }
        }
        else {
           # -- search in linked databases
           foreach $db ( @{$self->{linkeddbs}} ) {
              $self->verbose("Searching in $db->file() for $name $version");
              $area=$db->getarea($name,$version);
              last if (defined $area);
           }
        }
        if ( ! defined $area ) {
           $self->verbose("Area $name $version not found");
        }
        return $area;
}

sub addarea {
        my $self=shift;
        my $name=shift;
        my $version=shift;
        my $area=shift;

        my $rv=1;
        my $type="file";
        my $url=$area->location()."/.SCRAM/InstallFile";
        # -- check for duplicates
        for ( my $index=0; $index<=$#{$self->{projects}}; $index++ ) {
         if  ( $self->{projects}[$index][0] eq $name ) {
          if ( $self->{projects}[$index][1] eq $version ) {
            print "$name $version already exists. Overwrite? (y/n) :";
            if ( ! (<STDIN>=~/y/i ) ) {
                        print "Aborting install ...\n";
                        return 1;
            }
            else {
               $rv=0;
               $self->{projects}[$index]=[ ($name,$version,$type,$url) ];
            }
          }
          else {
            print "Related Project : $name ".$self->{projects}[$index][1]."\n";
          }
         }
        }
        if ( $rv ) {
           # -- add to our list and save
           push @{$self->{projects}}, [ ($name,$version,$type,$url) ];
        }
        $self->_save();
        return 0;
}

sub listlinks {
        my $self=shift;

        my  @dbfile=();
        foreach $db ( @{$self->{linkeddbs}} ) {
          push @dbfile, $db->file();
        }
        return @dbfile;
}

sub list {
        my $self=shift;
        return @{$self->{projects}};
}

sub listall {
        my $self=shift;
        my @list=$self->list();

        foreach $db ( @{$self->{linkeddbs}} ) {
          $self->verbose("Adding list from $db");
          push @list, $db->listall();
        }
        return @list;
}

sub removearea {
        my $self=shift;
        my $name=shift;
        my $version=shift;

        print "Not yet implemented\n";
}

sub link {
        my $self=shift;
        my $dbfile=shift;

        my $newdb=Scram::ScramProjectDB->new($dbfile);
        push @{$self->{linkeddbs}},$newdb; 
        $self->_save();
}

sub unlink {
        my $self=shift;
        my $file=shift;

        my $db;
        for (my $i=0; $i<=$#{$self->{linkeddbs}}; $i++ ) {
           $db=${$self->{linkeddbs}}[$i];
           if  ( $db->file() eq $file ) {
             $self->verbose("Removing link $file");
             splice (@{$self->{linkeddbs}},$i,1);
             $self->_save();
           }
        }
}

# -- Support Routines

#
# Search through the project list until we get a match
sub _findlocal {
        my $self=shift;
        my $name=shift;
        my $version=shift;

        my $found=-1;
        for (my $i=0; $i<=$#{$self->{projects}}; $i++ ) {
          if  ( ( $self->{projects}[$i][0] eq $name) && 
                ( $self->{projects}[$i][1] eq $version) ) {
            $found=$i;
            last;
          }
        }
        return $found;
}

sub _save {
        my $self=shift;

        use FileHandle;
        my $fh=FileHandle->new();
        my $filename=$self->{dbfile};
        open ( $fh, ">$filename" );
        # print current links 
        foreach $db ( @{$self->{linkeddbs}} ) {
           print $fh "\!DB ".$db->file()."\n";
        }
        # save project info
        my $temp;
        foreach $elem ( @{$self->{projects}} ) {
          $temp=join ":", @{$elem};
          print $fh $temp."\n";
        }
        undef $fh;
}

sub _readdbfile {
        my $self=shift;
        my $file=shift;
        
        use FileHandle;
        my $fh=FileHandle->new();
        $self->verbose("Initialising db from $file");
        open ( $fh, "<$file" );

        my @vars;
        my $newdb;
        while ( $map=<$fh> ) {
          chomp $map;
          if ( $map=~/^\!DB (.*)/ ) { # Check for other DB files
                my $db=$1;
                if ( -f $db ) {
                  $self->verbose("Getting Linked DB $db");
                  $newdb=Scram::ScramProjectDB->new($db);
                  push @{$self->{linkeddbs}},$newdb; 
                }
                next;
          }
          @vars = split ":", $map;
          $self->verbose("registering project $map");
          push @{$self->{projects}}, [ @vars ];
        }
        undef $fh;
}
Revision:	1.4
Committed:	Mon May 28 09:06:44 2001 UTC (23 years, 11 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
Changes since 1.3:	+3 -4 lines
Log Message:	Added require statement to getarea routine.
#	User	Rev	Content
1	williamc	1.2	#
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	williamc	1.3	# list() : list local areas (retunns $name,$version pairs)
17			# listall() : list local and linked areas
18			# listlinks() : Show a list of links
19	williamc	1.2	# removearea(name,version) : remove the named project
20			# link(dblocation) : link with specified db
21			# unlink(dblocation) : remove link with a specified db
22
23			package Scram::ScramProjectDB;
24			use Utilities::Verbose;
25			require 5.004;
26			@ISA=qw(Utilities::Verbose);
27
28			sub new {
29			my $class=shift;
30			my $self={};
31			bless $self, $class;
32			$self->{dbfile}=shift;
33			$self->_readdbfile($self->{dbfile});
34			$self->{projectobjects}={};
35			return $self;
36			}
37
38			sub file {
39			my $self=shift;
40			return $self->{dbfile};
41			}
42
43			sub getarea {
44	sashby	1.4	require Configuration::ConfigArea;
45			my $self=shift;
46	williamc	1.2	my $name=shift;
47			my $version=shift;
48
49	williamc	1.3	my $area=undef;
50	williamc	1.2	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};
55			}
56			else {
57			$area=Configuration::ConfigArea->new();
58			$self->verbose("Attempt to ressurect $name $version from $location");
59			if ( $area->bootstrapfromlocation($location) == 1 ) {
60			undef $area;
61			$self->verbose("attempt unsuccessful");
62			}
63			else {
64			$self->verbose("area found");
65			$self->{projectobjects}{$location}=$area;
66			}
67			}
68			}
69			else {
70	williamc	1.3	# -- search in linked databases
71			foreach $db ( @{$self->{linkeddbs}} ) {
72			$self->verbose("Searching in $db->file() for $name $version");
73			$area=$db->getarea($name,$version);
74			last if (defined $area);
75			}
76			}
77			if ( ! defined $area ) {
78	williamc	1.2	$self->verbose("Area $name $version not found");
79			}
80			return $area;
81			}
82
83			sub addarea {
84			my $self=shift;
85			my $name=shift;
86			my $version=shift;
87			my $area=shift;
88
89			my $rv=1;
90			my $type="file";
91			my $url=$area->location()."/.SCRAM/InstallFile";
92			# -- check for duplicates
93			for ( my $index=0; $index<=$#{$self->{projects}}; $index++ ) {
94			if ( $self->{projects}[$index][0] eq $name ) {
95			if ( $self->{projects}[$index][1] eq $version ) {
96	sashby	1.4	print "$name $version already exists. Overwrite? (y/n) :";
97	williamc	1.2	if ( ! (<STDIN>=~/y/i ) ) {
98			print "Aborting install ...\n";
99			return 1;
100			}
101			else {
102			$rv=0;
103			$self->{projects}[$index]=[ ($name,$version,$type,$url) ];
104			}
105			}
106			else {
107			print "Related Project : $name ".$self->{projects}[$index][1]."\n";
108			}
109			}
110			}
111			if ( $rv ) {
112			# -- add to our list and save
113			push @{$self->{projects}}, [ ($name,$version,$type,$url) ];
114			}
115			$self->_save();
116			return 0;
117			}
118
119	williamc	1.3	sub listlinks {
120			my $self=shift;
121
122			my @dbfile=();
123			foreach $db ( @{$self->{linkeddbs}} ) {
124			push @dbfile, $db->file();
125			}
126			return @dbfile;
127			}
128
129	williamc	1.2	sub list {
130			my $self=shift;
131			return @{$self->{projects}};
132			}
133
134	williamc	1.3	sub listall {
135			my $self=shift;
136			my @list=$self->list();
137
138			foreach $db ( @{$self->{linkeddbs}} ) {
139			$self->verbose("Adding list from $db");
140			push @list, $db->listall();
141			}
142			return @list;
143			}
144
145	williamc	1.2	sub removearea {
146			my $self=shift;
147			my $name=shift;
148			my $version=shift;
149
150			print "Not yet implemented\n";
151			}
152
153			sub link {
154			my $self=shift;
155			my $dbfile=shift;
156
157			my $newdb=Scram::ScramProjectDB->new($dbfile);
158			push @{$self->{linkeddbs}},$newdb;
159			$self->_save();
160			}
161
162	williamc	1.3	sub unlink {
163			my $self=shift;
164			my $file=shift;
165
166			my $db;
167			for (my $i=0; $i<=$#{$self->{linkeddbs}}; $i++ ) {
168			$db=${$self->{linkeddbs}}[$i];
169			if ( $db->file() eq $file ) {
170			$self->verbose("Removing link $file");
171			splice (@{$self->{linkeddbs}},$i,1);
172			$self->_save();
173			}
174			}
175			}
176
177	williamc	1.2	# -- Support Routines
178
179			#
180			# Search through the project list until we get a match
181			sub _findlocal {
182			my $self=shift;
183			my $name=shift;
184			my $version=shift;
185
186			my $found=-1;
187			for (my $i=0; $i<=$#{$self->{projects}}; $i++ ) {
188			if ( ( $self->{projects}[$i][0] eq $name) &&
189			( $self->{projects}[$i][1] eq $version) ) {
190			$found=$i;
191			last;
192			}
193			}
194			return $found;
195			}
196
197			sub _save {
198			my $self=shift;
199
200			use FileHandle;
201			my $fh=FileHandle->new();
202			my $filename=$self->{dbfile};
203			open ( $fh, ">$filename" );
204			# print current links
205			foreach $db ( @{$self->{linkeddbs}} ) {
206			print $fh "\!DB ".$db->file()."\n";
207			}
208			# save project info
209			my $temp;
210			foreach $elem ( @{$self->{projects}} ) {
211			$temp=join ":", @{$elem};
212			print $fh $temp."\n";
213			}
214			undef $fh;
215			}
216
217			sub _readdbfile {
218			my $self=shift;
219			my $file=shift;
220
221			use FileHandle;
222			my $fh=FileHandle->new();
223	williamc	1.3	$self->verbose("Initialising db from $file");
224	williamc	1.2	open ( $fh, "<$file" );
225
226			my @vars;
227	williamc	1.3	my $newdb;
228	williamc	1.2	while ( $map=<$fh> ) {
229			chomp $map;
230			if ( $map=~/^\!DB (.*)/ ) { # Check for other DB files
231			my $db=$1;
232			if ( -f $db ) {
233	williamc	1.3	$self->verbose("Getting Linked DB $db");
234	williamc	1.2	$newdb=Scram::ScramProjectDB->new($db);
235			push @{$self->{linkeddbs}},$newdb;
236			}
237			next;
238			}
239			@vars = split ":", $map;
240	williamc	1.3	$self->verbose("registering project $map");
241	williamc	1.2	push @{$self->{projects}}, [ @vars ];
242			}
243			undef $fh;
244			}