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 {
        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="_location"; not ready for this yet
        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 alreay exists. Overwrite (y/n)\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.1.2.3.2.1.4.1
Committed:	Fri Oct 27 08:39:55 2000 UTC (24 years, 6 months ago) by williamc
Content type:	text/plain
Branch:	V0_16branch
CVS Tags:	BuildSystemProto1, V0_18_0, V0_18_0model, V0_17_1, V0_18_0alpha, V0_17_0, V0_16_4, V0_16_3, V0_16_2, V0_16_1
Branch point for:	V0_17branch
Changes since 1.1.2.3.2.1:	+52 -2 lines
Log Message:	add unlink, and listall methods
#	User	Rev	Content
1	williamc	1.1.2.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	williamc	1.1.2.3	# addarea(ConfigArea) : add a project - return 0 for success 1 for abort
16	williamc	1.1.2.3.2.1.4.1	# 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.1.2.1	# 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	williamc	1.1.2.3.2.1	$self->{projectobjects}={};
35	williamc	1.1.2.1	return $self;
36			}
37
38			sub file {
39			my $self=shift;
40			return $self->{dbfile};
41			}
42
43			sub getarea {
44			my $self=shift;
45			my $name=shift;
46			my $version=shift;
47
48	williamc	1.1.2.3.2.1.4.1	my $area=undef;
49	williamc	1.1.2.1	my $index=$self->_findlocal($name,$version);
50			if ( $index != -1 ) {
51			my $location=$self->{projects}[$index][3];
52	williamc	1.1.2.3.2.1	if ( defined $self->{projectobjects}{$location} ) {
53			$area=$self->{projectobjects}{$location};
54			}
55			else {
56	williamc	1.1.2.1	$area=Configuration::ConfigArea->new();
57			$self->verbose("Attempt to ressurect $name $version from $location");
58			if ( $area->bootstrapfromlocation($location) == 1 ) {
59			undef $area;
60			$self->verbose("attempt unsuccessful");
61			}
62			else {
63			$self->verbose("area found");
64	williamc	1.1.2.3.2.1	$self->{projectobjects}{$location}=$area;
65			}
66	williamc	1.1.2.1	}
67			}
68	williamc	1.1.2.2	else {
69	williamc	1.1.2.3.2.1.4.1	# -- search in linked databases
70			foreach $db ( @{$self->{linkeddbs}} ) {
71			$self->verbose("Searching in $db->file() for $name $version");
72			$area=$db->getarea($name,$version);
73			last if (defined $area);
74			}
75			}
76			if ( ! defined $area ) {
77	williamc	1.1.2.2	$self->verbose("Area $name $version not found");
78			}
79	williamc	1.1.2.1	return $area;
80			}
81
82			sub addarea {
83			my $self=shift;
84	williamc	1.1.2.3	my $name=shift;
85			my $version=shift;
86	williamc	1.1.2.1	my $area=shift;
87
88	williamc	1.1.2.3	my $rv=1;
89
90			#my $type="_location"; not ready for this yet
91			my $type="file";
92			my $url=$area->location()."/.SCRAM/InstallFile";
93			# -- check for duplicates
94			for ( my $index=0; $index<=$#{$self->{projects}}; $index++ ) {
95			if ( $self->{projects}[$index][0] eq $name ) {
96			if ( $self->{projects}[$index][1] eq $version ) {
97			print "$name $version alreay exists. Overwrite (y/n)\n";
98			if ( ! (<STDIN>=~/y/i ) ) {
99			print "Aborting install ...\n";
100			return 1;
101			}
102			else {
103			$rv=0;
104			$self->{projects}[$index]=[ ($name,$version,$type,$url) ];
105			}
106			}
107			else {
108			print "Related Project : $name ".$self->{projects}[$index][1]."\n";
109			}
110			}
111			}
112			if ( $rv ) {
113			# -- add to our list and save
114			push @{$self->{projects}}, [ ($name,$version,$type,$url) ];
115			}
116	williamc	1.1.2.1	$self->_save();
117	williamc	1.1.2.3	return 0;
118	williamc	1.1.2.2	}
119
120	williamc	1.1.2.3.2.1.4.1	sub listlinks {
121			my $self=shift;
122
123			my @dbfile=();
124			foreach $db ( @{$self->{linkeddbs}} ) {
125			push @dbfile, $db->file();
126			}
127			return @dbfile;
128			}
129
130	williamc	1.1.2.2	sub list {
131			my $self=shift;
132			return @{$self->{projects}};
133	williamc	1.1.2.1	}
134
135	williamc	1.1.2.3.2.1.4.1	sub listall {
136			my $self=shift;
137			my @list=$self->list();
138
139			foreach $db ( @{$self->{linkeddbs}} ) {
140			$self->verbose("Adding list from $db");
141			push @list, $db->listall();
142			}
143			return @list;
144			}
145
146	williamc	1.1.2.1	sub removearea {
147			my $self=shift;
148			my $name=shift;
149			my $version=shift;
150
151			print "Not yet implemented\n";
152			}
153
154			sub link {
155			my $self=shift;
156			my $dbfile=shift;
157
158			my $newdb=Scram::ScramProjectDB->new($dbfile);
159			push @{$self->{linkeddbs}},$newdb;
160			$self->_save();
161			}
162
163	williamc	1.1.2.3.2.1.4.1	sub unlink {
164			my $self=shift;
165			my $file=shift;
166
167			my $db;
168			for (my $i=0; $i<=$#{$self->{linkeddbs}}; $i++ ) {
169			$db=${$self->{linkeddbs}}[$i];
170			if ( $db->file() eq $file ) {
171			$self->verbose("Removing link $file");
172			splice (@{$self->{linkeddbs}},$i,1);
173			$self->_save();
174			}
175			}
176			}
177
178	williamc	1.1.2.1	# -- Support Routines
179
180			#
181			# Search through the project list until we get a match
182			sub _findlocal {
183			my $self=shift;
184			my $name=shift;
185			my $version=shift;
186
187			my $found=-1;
188			for (my $i=0; $i<=$#{$self->{projects}}; $i++ ) {
189			if ( ( $self->{projects}[$i][0] eq $name) &&
190			( $self->{projects}[$i][1] eq $version) ) {
191			$found=$i;
192			last;
193			}
194			}
195			return $found;
196			}
197
198			sub _save {
199			my $self=shift;
200
201			use FileHandle;
202			my $fh=FileHandle->new();
203	williamc	1.1.2.3	my $filename=$self->{dbfile};
204	williamc	1.1.2.1	open ( $fh, ">$filename" );
205			# print current links
206			foreach $db ( @{$self->{linkeddbs}} ) {
207			print $fh "\!DB ".$db->file()."\n";
208			}
209			# save project info
210			my $temp;
211			foreach $elem ( @{$self->{projects}} ) {
212			$temp=join ":", @{$elem};
213	williamc	1.1.2.3	print $fh $temp."\n";
214	williamc	1.1.2.1	}
215			undef $fh;
216			}
217
218			sub _readdbfile {
219			my $self=shift;
220			my $file=shift;
221
222			use FileHandle;
223			my $fh=FileHandle->new();
224	williamc	1.1.2.3.2.1.4.1	$self->verbose("Initialising db from $file");
225	williamc	1.1.2.1	open ( $fh, "<$file" );
226
227			my @vars;
228	williamc	1.1.2.3.2.1.4.1	my $newdb;
229	williamc	1.1.2.1	while ( $map=<$fh> ) {
230			chomp $map;
231			if ( $map=~/^\!DB (.*)/ ) { # Check for other DB files
232			my $db=$1;
233			if ( -f $db ) {
234	williamc	1.1.2.3.2.1.4.1	$self->verbose("Getting Linked DB $db");
235	williamc	1.1.2.1	$newdb=Scram::ScramProjectDB->new($db);
236			push @{$self->{linkeddbs}},$newdb;
237			}
238			next;
239			}
240			@vars = split ":", $map;
241	williamc	1.1.2.3.2.1.4.1	$self->verbose("registering project $map");
242	williamc	1.1.2.1	push @{$self->{projects}}, [ @vars ];
243			}
244			undef $fh;
245			}