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 areas (retunns $name,$version pairs)
# 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;
        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 {
           $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 list {
        my $self=shift;
        return @{$self->{projects}};
}

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();
}

# -- 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();
        open ( $fh, "<$file" );

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