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
   {
   ###############################################################
   # removearea(name,version)                                    #
   ###############################################################
   # modified : Mon May 28 11:24:29 2001 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   #          :                                                  #
   #          :                                                  #
   # function : Remove project area from scramdb file.           #
   #          :                                                  #
   #          :                                                  #
   ###############################################################
   my $self=shift;
   my $name=shift;
   my $version=shift;
   my $vfound=0;
   my $nfound=0;
   
   print "\n","Going to remove $name $version from the current scram database.....","\n"; 
   print "\n";

   for ( my $index=0; $index<=$#{$self->{projects}}; $index++ )
      {
      # Look for a project with name $name:
      if  ( $self->{projects}[$index][0] eq $name )
         {
         $nfound=1; 
         # Check the version:
         if ( $self->{projects}[$index][1] eq $version )
            {
            # We have a match for project name and version:
            $vfound=1;
            print "Project $name Version $version exists. Remove it? (y/n): ";
            if ( ! (<STDIN>=~/y/i ) )
               {
               print "\n","Aborting project removal...bye.\n\n";
               return 1;
               }
            else
               {
               # Remove the project:
               print "\n";
               print "Removing project:\t$name\t$version","\n\n";
               splice(@{$self->{projects}},$index,1);
               }
            }
         } 
      }
   
   if ( ! $nfound || ! $vfound )
      {
      # There was a problem finding either the
      # named project or the desired version:
      print "ERROR: Unable to find project $name with version $version in the database.","\n\n";
      return 1;
      }
   
   print "\n";   
   # Save our new array:
   $self->_save();
   return 0;
   }

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.7
Committed:	Fri Nov 9 14:15:15 2001 UTC (23 years, 6 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V0_19_7, V0_19_6, V0_19_6p1, V0_19_5, SFATEST, V0_19_4, V0_19_4_pre3, V0_19_4_pre2, V0_19_4_pre1, V0_19_3, V0_19_2, V0_19_1
Branch point for:	SCRAM_V1_BRANCH, V0_19_4_B
Changes since 1.6:	+47 -35 lines
Log Message:	Improved list command and area-checking.
#	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	sashby	1.7	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	williamc	1.2	}
59	sashby	1.7	else
60			{
61	williamc	1.2	$area=Configuration::ConfigArea->new();
62			$self->verbose("Attempt to ressurect $name $version from $location");
63	sashby	1.7	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	williamc	1.2	}
74	sashby	1.7	}
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	williamc	1.2	}
84	sashby	1.7	}
85			if ( ! defined $area )
86			{
87			$self->verbose("Area $name $version not found");
88			}
89
90			return $area;
91			}
92
93	williamc	1.2
94			sub addarea {
95			my $self=shift;
96			my $name=shift;
97			my $version=shift;
98			my $area=shift;
99
100			my $rv=1;
101			my $type="file";
102			my $url=$area->location()."/.SCRAM/InstallFile";
103			# -- check for duplicates
104			for ( my $index=0; $index<=$#{$self->{projects}}; $index++ ) {
105			if ( $self->{projects}[$index][0] eq $name ) {
106			if ( $self->{projects}[$index][1] eq $version ) {
107	sashby	1.4	print "$name $version already exists. Overwrite? (y/n) :";
108	williamc	1.2	if ( ! (<STDIN>=~/y/i ) ) {
109			print "Aborting install ...\n";
110			return 1;
111			}
112			else {
113			$rv=0;
114			$self->{projects}[$index]=[ ($name,$version,$type,$url) ];
115			}
116			}
117			else {
118			print "Related Project : $name ".$self->{projects}[$index][1]."\n";
119			}
120			}
121			}
122			if ( $rv ) {
123			# -- add to our list and save
124			push @{$self->{projects}}, [ ($name,$version,$type,$url) ];
125			}
126			$self->_save();
127			return 0;
128			}
129
130	williamc	1.3	sub listlinks {
131			my $self=shift;
132
133			my @dbfile=();
134			foreach $db ( @{$self->{linkeddbs}} ) {
135			push @dbfile, $db->file();
136			}
137			return @dbfile;
138			}
139
140	williamc	1.2	sub list {
141			my $self=shift;
142			return @{$self->{projects}};
143			}
144
145	williamc	1.3	sub listall {
146			my $self=shift;
147			my @list=$self->list();
148	sashby	1.7
149	williamc	1.3	foreach $db ( @{$self->{linkeddbs}} ) {
150			$self->verbose("Adding list from $db");
151			push @list, $db->listall();
152			}
153	sashby	1.7
154	williamc	1.3	return @list;
155			}
156
157	sashby	1.5	sub removearea
158			{
159			###############################################################
160			# removearea(name,version) #
161			###############################################################
162			# modified : Mon May 28 11:24:29 2001 / SFA #
163			# params : #
164			# : #
165			# : #
166			# : #
167			# function : Remove project area from scramdb file. #
168			# : #
169			# : #
170			###############################################################
171			my $self=shift;
172			my $name=shift;
173			my $version=shift;
174	sashby	1.6	my $vfound=0;
175			my $nfound=0;
176
177			print "\n","Going to remove $name $version from the current scram database.....","\n";
178			print "\n";
179	williamc	1.2
180	sashby	1.6	for ( my $index=0; $index<=$#{$self->{projects}}; $index++ )
181			{
182			# Look for a project with name $name:
183			if ( $self->{projects}[$index][0] eq $name )
184			{
185			$nfound=1;
186			# Check the version:
187			if ( $self->{projects}[$index][1] eq $version )
188			{
189			# We have a match for project name and version:
190			$vfound=1;
191			print "Project $name Version $version exists. Remove it? (y/n): ";
192			if ( ! (<STDIN>=~/y/i ) )
193			{
194			print "\n","Aborting project removal...bye.\n\n";
195			return 1;
196			}
197			else
198			{
199			# Remove the project:
200			print "\n";
201			print "Removing project:\t$name\t$version","\n\n";
202			splice(@{$self->{projects}},$index,1);
203			}
204			}
205			}
206			}
207
208			if ( ! $nfound \|\| ! $vfound )
209			{
210			# There was a problem finding either the
211			# named project or the desired version:
212			print "ERROR: Unable to find project $name with version $version in the database.","\n\n";
213			return 1;
214			}
215
216			print "\n";
217			# Save our new array:
218			$self->_save();
219			return 0;
220	sashby	1.5	}
221	williamc	1.2
222			sub link {
223			my $self=shift;
224			my $dbfile=shift;
225
226			my $newdb=Scram::ScramProjectDB->new($dbfile);
227			push @{$self->{linkeddbs}},$newdb;
228			$self->_save();
229			}
230
231	williamc	1.3	sub unlink {
232			my $self=shift;
233			my $file=shift;
234			my $db;
235	sashby	1.6
236	williamc	1.3	for (my $i=0; $i<=$#{$self->{linkeddbs}}; $i++ ) {
237			$db=${$self->{linkeddbs}}[$i];
238			if ( $db->file() eq $file ) {
239			$self->verbose("Removing link $file");
240			splice (@{$self->{linkeddbs}},$i,1);
241			$self->_save();
242			}
243			}
244			}
245
246	williamc	1.2	# -- Support Routines
247
248			#
249			# Search through the project list until we get a match
250			sub _findlocal {
251			my $self=shift;
252			my $name=shift;
253			my $version=shift;
254
255			my $found=-1;
256			for (my $i=0; $i<=$#{$self->{projects}}; $i++ ) {
257			if ( ( $self->{projects}[$i][0] eq $name) &&
258			( $self->{projects}[$i][1] eq $version) ) {
259			$found=$i;
260			last;
261			}
262			}
263			return $found;
264			}
265
266			sub _save {
267			my $self=shift;
268
269			use FileHandle;
270			my $fh=FileHandle->new();
271			my $filename=$self->{dbfile};
272			open ( $fh, ">$filename" );
273			# print current links
274			foreach $db ( @{$self->{linkeddbs}} ) {
275			print $fh "\!DB ".$db->file()."\n";
276			}
277			# save project info
278			my $temp;
279			foreach $elem ( @{$self->{projects}} ) {
280			$temp=join ":", @{$elem};
281			print $fh $temp."\n";
282			}
283			undef $fh;
284			}
285
286			sub _readdbfile {
287			my $self=shift;
288			my $file=shift;
289
290			use FileHandle;
291			my $fh=FileHandle->new();
292	williamc	1.3	$self->verbose("Initialising db from $file");
293	williamc	1.2	open ( $fh, "<$file" );
294
295			my @vars;
296	williamc	1.3	my $newdb;
297	williamc	1.2	while ( $map=<$fh> ) {
298			chomp $map;
299			if ( $map=~/^\!DB (.*)/ ) { # Check for other DB files
300			my $db=$1;
301			if ( -f $db ) {
302	williamc	1.3	$self->verbose("Getting Linked DB $db");
303	williamc	1.2	$newdb=Scram::ScramProjectDB->new($db);
304			push @{$self->{linkeddbs}},$newdb;
305			}
306			next;
307			}
308			@vars = split ":", $map;
309	williamc	1.3	$self->verbose("registering project $map");
310	williamc	1.2	push @{$self->{projects}}, [ @vars ];
311			}
312			undef $fh;
313			}