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});
        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];
         $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");
         }
        }
        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
Committed:	Thu May 11 14:57:52 2000 UTC (25 years ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
CVS Tags:	V0_12_12_3, V0_12_12_2, V0_12_12_1, V0_12_12_0, PlayGround_0, V0_13_0, V0_12_12, V0_12_11, V0_12_9b, V0_12_10, V0_12_9, V0_12_8, V0_12_7
Branch point for:	HPWbranch
Changes since 1.1.2.2:	+34 -8 lines
Log Message:	Fix addarea
#	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			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	williamc	1.1.2.2	else {
60			$self->verbose("Area $name $version not found");
61			}
62	williamc	1.1.2.1	return $area;
63			}
64
65			sub addarea {
66			my $self=shift;
67	williamc	1.1.2.3	my $name=shift;
68			my $version=shift;
69	williamc	1.1.2.1	my $area=shift;
70
71	williamc	1.1.2.3	my $rv=1;
72
73			#my $type="_location"; not ready for this yet
74			my $type="file";
75			my $url=$area->location()."/.SCRAM/InstallFile";
76			# -- check for duplicates
77			for ( my $index=0; $index<=$#{$self->{projects}}; $index++ ) {
78			if ( $self->{projects}[$index][0] eq $name ) {
79			if ( $self->{projects}[$index][1] eq $version ) {
80			print "$name $version alreay exists. Overwrite (y/n)\n";
81			if ( ! (<STDIN>=~/y/i ) ) {
82			print "Aborting install ...\n";
83			return 1;
84			}
85			else {
86			$rv=0;
87			$self->{projects}[$index]=[ ($name,$version,$type,$url) ];
88			}
89			}
90			else {
91			print "Related Project : $name ".$self->{projects}[$index][1]."\n";
92			}
93			}
94			}
95			if ( $rv ) {
96			# -- add to our list and save
97			push @{$self->{projects}}, [ ($name,$version,$type,$url) ];
98			}
99	williamc	1.1.2.1	$self->_save();
100	williamc	1.1.2.3	return 0;
101	williamc	1.1.2.2	}
102
103			sub list {
104			my $self=shift;
105			return @{$self->{projects}};
106	williamc	1.1.2.1	}
107
108			sub removearea {
109			my $self=shift;
110			my $name=shift;
111			my $version=shift;
112
113			print "Not yet implemented\n";
114			}
115
116			sub link {
117			my $self=shift;
118			my $dbfile=shift;
119
120			my $newdb=Scram::ScramProjectDB->new($dbfile);
121			push @{$self->{linkeddbs}},$newdb;
122			$self->_save();
123			}
124
125			# -- Support Routines
126
127			#
128			# Search through the project list until we get a match
129			sub _findlocal {
130			my $self=shift;
131			my $name=shift;
132			my $version=shift;
133
134			my $found=-1;
135			for (my $i=0; $i<=$#{$self->{projects}}; $i++ ) {
136			if ( ( $self->{projects}[$i][0] eq $name) &&
137			( $self->{projects}[$i][1] eq $version) ) {
138			$found=$i;
139			last;
140			}
141			}
142			return $found;
143			}
144
145			sub _save {
146			my $self=shift;
147
148			use FileHandle;
149			my $fh=FileHandle->new();
150	williamc	1.1.2.3	my $filename=$self->{dbfile};
151	williamc	1.1.2.1	open ( $fh, ">$filename" );
152			# print current links
153			foreach $db ( @{$self->{linkeddbs}} ) {
154			print $fh "\!DB ".$db->file()."\n";
155			}
156			# save project info
157			my $temp;
158			foreach $elem ( @{$self->{projects}} ) {
159			$temp=join ":", @{$elem};
160	williamc	1.1.2.3	print $fh $temp."\n";
161	williamc	1.1.2.1	}
162			undef $fh;
163			}
164
165			sub _readdbfile {
166			my $self=shift;
167			my $file=shift;
168
169			use FileHandle;
170			my $fh=FileHandle->new();
171			open ( $fh, "<$file" );
172
173			my @vars;
174			while ( $map=<$fh> ) {
175			chomp $map;
176			if ( $map=~/^\!DB (.*)/ ) { # Check for other DB files
177			my $db=$1;
178			if ( -f $db ) {
179			$newdb=Scram::ScramProjectDB->new($db);
180			push @{$self->{linkeddbs}},$newdb;
181			}
182			next;
183			}
184			@vars = split ":", $map;
185			push @{$self->{projects}}, [ @vars ];
186			}
187			undef $fh;
188			}