ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/Scram/ScramProjectDB.pm
(Generate patch)

Comparing COMP/SCRAM/src/Scram/ScramProjectDB.pm (file contents):
Revision 1.2 by williamc, Mon Aug 28 08:35:15 2000 UTC vs.
Revision 1.7 by sashby, Fri Nov 9 14:15:15 2001 UTC

# Line 13 | Line 13
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 < # list()                : list areas (retunns $name,$version pairs)
16 > # list()                : list local areas (retunns $name,$version pairs)
17 > # listall()             : list local and linked areas
18 > # listlinks()           : Show a list of links
19   # removearea(name,version) : remove the named project
20   # link(dblocation) : link with specified db
21   # unlink(dblocation) : remove link with a specified db
# Line 38 | Line 40 | sub file {
40          return $self->{dbfile};
41   }
42  
43 < sub getarea {
44 <        my $self=shift;
45 <        my $name=shift;
46 <        my $version=shift;
47 <
48 <        my $area;
49 <        my $index=$self->_findlocal($name,$version);
50 <        if ( $index != -1 ) {  
51 <         my $location=$self->{projects}[$index][3];
52 <         if ( defined $self->{projectobjects}{$location} ) {
53 <           $area=$self->{projectobjects}{$location};
43 > 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           }
59 <         else {
59 >      else
60 >         {
61           $area=Configuration::ConfigArea->new();
62           $self->verbose("Attempt to ressurect $name $version from $location");
63 <         if ( $area->bootstrapfromlocation($location) == 1 ) {
64 <           undef $area;
65 <           $self->verbose("attempt unsuccessful");
66 <         }
67 <         else {
68 <           $self->verbose("area found");
69 <           $self->{projectobjects}{$location}=$area;
63 >         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           }
74 +      }
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           }
84 <        }
85 <        else {
86 <           $self->verbose("Area $name $version not found");
87 <        }
88 <        return $area;
89 < }
84 >      }
85 >   if ( ! defined $area )
86 >      {
87 >      $self->verbose("Area $name $version not found");
88 >      }
89 >
90 >   return $area;
91 >   }
92 >
93  
94   sub addarea {
95          my $self=shift;
# Line 76 | Line 98 | sub addarea {
98          my $area=shift;
99  
100          my $rv=1;
79 –
80 –        #my $type="_location"; not ready for this yet
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 <            print "$name $version alreay exists. Overwrite (y/n)\n";
107 >            print "$name $version already exists. Overwrite? (y/n) :";
108              if ( ! (<STDIN>=~/y/i ) ) {
109                          print "Aborting install ...\n";
110                          return 1;
# Line 107 | Line 127 | sub addarea {
127          return 0;
128   }
129  
130 + 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   sub list {
141          my $self=shift;
142          return @{$self->{projects}};
143   }
144  
145 < sub removearea {
145 > sub listall {
146          my $self=shift;
147 <        my $name=shift;
148 <        my $version=shift;
147 >        my @list=$self->list();
148 >        
149 >        foreach $db ( @{$self->{linkeddbs}} ) {
150 >          $self->verbose("Adding list from $db");
151 >          push @list, $db->listall();
152 >        }
153  
154 <        print "Not yet implemented\n";
154 >        return @list;
155   }
156  
157 + 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 +   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 +
180 +   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 +   }
221 +
222   sub link {
223          my $self=shift;
224          my $dbfile=shift;
# Line 129 | Line 228 | sub link {
228          $self->_save();
229   }
230  
231 + sub unlink {
232 +        my $self=shift;
233 +        my $file=shift;
234 +        my $db;
235 +        
236 +        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   # -- Support Routines
247  
248   #
# Line 175 | Line 289 | sub _readdbfile {
289          
290          use FileHandle;
291          my $fh=FileHandle->new();
292 +        $self->verbose("Initialising db from $file");
293          open ( $fh, "<$file" );
294  
295          my @vars;
296 +        my $newdb;
297          while ( $map=<$fh> ) {
298            chomp $map;
299            if ( $map=~/^\!DB (.*)/ ) { # Check for other DB files
300                  my $db=$1;
301                  if ( -f $db ) {
302 +                  $self->verbose("Getting Linked DB $db");
303                    $newdb=Scram::ScramProjectDB->new($db);
304                    push @{$self->{linkeddbs}},$newdb;
305                  }
306                  next;
307            }
308            @vars = split ":", $map;
309 +          $self->verbose("registering project $map");
310            push @{$self->{projects}}, [ @vars ];
311          }
312          undef $fh;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines