Update of /cvsroot/fink/fink/perlmod/Fink
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20771
Modified Files:
ChangeLog Engine.pm Package.pm PkgVersion.pm
Log Message:
* Engine.pm: Don't just promise to remove on-disk cache in 'index
--full',
actually do it.
* Package.pm, PkgVersion.pm: Don't allow user to interrupt when Storable
is loading part of the DB, to eliminate spurious warnings about
corruption.
* Package.pm, PkgVersion.pm: Remove dead code related to merging
PkgVersions
into the DB. Make new merge method to merge trees.
* PkgVersion.pm: Add new methods to examine trees, also store trees in
index.db.
* Engine.pm: Use new in_tree method in list. Add 'trees' item to
dumpinfo.
*** DB FORMAT CHANGE, YOU WILL NEED A FULL REINDEX ***
Index: PkgVersion.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/PkgVersion.pm,v
retrieving revision 1.447
retrieving revision 1.448
diff -u -d -r1.447 -r1.448
--- PkgVersion.pm 26 Aug 2005 21:27:19 -0000 1.447
+++ PkgVersion.pm 27 Aug 2005 12:21:01 -0000 1.448
@@ -131,40 +131,50 @@
=cut
our %shared_loads;
+
+{
+ # Some things we don't want to load, if we'd rather keep what's already
in
+ # the database.
+ my %dont_load = map { $_ => 1 } qw(_trees);
-sub load_fields {
- my $self = shift;
- return $self if !$self->has_param('_backed_file')
- || $self->param('_backed_loaded')
- || !eval { require Storable };
-
- $self->set_param('_backed_loaded', 1);
- my $file = $self->param('_backed_file');
- my $loaded;
- if (exists $shared_loads{$file}) {
+ sub load_fields {
+ my $self = shift;
+ return $self if !$self->has_param('_backed_file')
+ || $self->param('_backed_loaded')
+ || !eval { require Storable };
+
+ $self->set_param('_backed_loaded', 1);
+ my $file = $self->param('_backed_file');
+ my $loaded;
+ if (exists $shared_loads{$file}) {
# print "Sharing PkgVersion " . $self->get_fullname . "
from $file\n";
- $loaded = $shared_loads{$file};
- } else {
+ $loaded = $shared_loads{$file};
+ } else {
# print "Loading PkgVersion " . $self->get_fullname . "
from: $file\n";
- eval { $loaded = Storable::lock_retrieve($file); };
- if ($@ || !defined $loaded) {
- die "It appears that part of Fink's package database is
corrupted "
- . "or missing. Please run 'fink index' to
correct the "
- . "problem.\n";
+ eval {
+ local $SIG{INT} = 'IGNORE'; # No user interrupts
+ $loaded = Storable::lock_retrieve($file);
+ };
+ if ($@ || !defined $loaded) {
+ die "It appears that part of Fink's package
database is corrupted "
+ . "or missing. Please run 'fink index'
to correct the "
+ . "problem.\n";
+ }
+ $shared_loads{$file} = $loaded;
}
- $shared_loads{$file} = $loaded;
+
+ return $self unless exists $loaded->{$self->get_fullname};
+
+ # Insert the loaded fields
+ my $href = $loaded->{$self->get_fullname};
+ my @load_keys = grep { !exists $dont_load{$_} } keys %$href;
+ @[EMAIL PROTECTED] = @[EMAIL PROTECTED];
+
+ # We need to update %d, %D, %i and %I to adapt to changes in
buildpath
+ $self->_set_destdirs;
+
+ return $self;
}
-
- return $self unless exists $loaded->{$self->get_fullname};
-
- # Insert the loaded fields
- my $href = $loaded->{$self->get_fullname};
- @$self{keys %$href} = values %$href;
-
- # We need to update %d, %D, %i and %I to adapt to changes in buildpath
- $self->_set_destdirs;
-
- return $self;
}
# PRIVATE: $pv->_set_destdirs
@@ -197,7 +207,7 @@
{
# Fields required to add a package to $packages
my @keepfields = qw(_name _epoch _version _revision _filename
- _pkglist_provides essential);
+ _pkglist_provides essential _trees);
sub get_init_fields {
my $self = shift;
@@ -252,7 +262,7 @@
$self->{_section} = 'unknown';
$self->{_debpath} = '/tmp';
$self->{_debpaths} = ['/tmp'];
- $self->{_tree} = 'unknown';
+ $self->{_trees} = [ 'unknown' ];
} else {
die "Path \"$filename\" contains no finkinfo
directory!\n";
}
@@ -272,8 +282,8 @@
}
# determine the package tree ("stable", "unstable",
etc.)
- @parts = split(/\//,
substr($filename,length("$basepath/fink/dists/")));
- $self->{_tree} = $parts[0];
+ @parts = split(/\//,
substr($filename,length("$basepath/fink/dists/")));
+ $self->{_trees} = [ $parts[0] ];
}
} else {
# for dummy descriptions generated from dpkg status data alone
@@ -283,7 +293,7 @@
$self->{_debpaths} = [];
# assume "binary" tree
- $self->{_tree} = "binary";
+ $self->{_trees} = [ "binary" ];
}
# some commonly used stuff
@@ -775,14 +785,39 @@
push @{$self->{_splitoffs_obj}}, @splitoffs;
}
-### merge duplicate package description
+=item merge
+
+ $new_pv->merge($old_pv);
+
+When one PkgVersion supplants another one, some properties of the old one may
+still be relevant. This call method gives the new one a chance to examine the
+old one and take things from it.
+
+=cut
sub merge {
- my $self = shift;
- my $dup = shift;
+ my ($self, $old) = @_;
- print "Warning! Not a dummy package\n" if $self->is_type('dummy');
- push @{$self->{_debpaths}}, @{$dup->{_debpaths}};
+ # Insert new trees
+ {
+ my %seen = map { $_ => 1 } $self->get_trees;
+ foreach my $tree ($old->get_trees) {
+ unshift @{$self->{_trees}}, $tree unless $seen{$tree}++;
+ }
+ }
+
+ # FIXME: Should we merge in the debpaths, as we (possibly) once did? It
+ # would make sense, since a deb in the wrong tree should still be fine.
+ # *BUT*, it would require storing the debpaths in the index.db, that
+ # might be overkill. (Will UseBinaryDist find them anyhow?)
+
+### NOTE: This method used to do something different, and it looks
+### like that code path is dead. Code is left here until we're sure.
+# my $self = shift;
+# my $dup = shift;
+#
+# print "Warning! Not a dummy package\n" if $self->is_type('dummy');
+# push @{$self->{_debpaths}}, @{$dup->{_debpaths}};
}
### bootstrap helpers
@@ -966,13 +1001,48 @@
return $size;
}
+=item get_tree
+
+ my $tree = $pv->get_tree;
+
+Get the last (highest priority) tree in which this package can be found.
+
+=cut
+
### Do not change API! This is used by FinkCommander (fpkg_list.pl)
sub get_tree {
my $self = shift;
- return $self->{_tree};
+ return( ($self->get_trees)[-1] );
}
+=item get_trees
+
+ my @trees = $pv->get_trees;
+
+Get a list of every tree in which this package can be found.
+
+=cut
+
+sub get_trees {
+ my $self = shift;
+ return @{$self->{_trees}};
+}
+
+=item in_tree
+
+ my $bool = $pv->in_tree($tree);
+
+Get whether or not this package can be found in the given tree.
+
+=cut
+
+sub in_tree {
+ my ($self, $tree) = @_;
+ return scalar(grep { $_ eq $tree } $self->get_trees);
+}
+
+
### other accessors
# get_source_suffices
Index: Package.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Package.pm,v
retrieving revision 1.157
retrieving revision 1.158
diff -u -d -r1.157 -r1.158
--- Package.pm 26 Aug 2005 21:27:19 -0000 1.157
+++ Package.pm 27 Aug 2005 12:21:01 -0000 1.158
@@ -147,36 +147,42 @@
my $version_object = shift;
my $version = $version_object->get_fullversion();
- if (exists $self->{_versions}->{$version}
- && $self->{_versions}->{$version}->is_type('dummy') ) {
- $self->{_versions}->{$version}->merge($version_object);
- } else {
- # $pv->fullname is currently treated as unique, even though it
won't be
- # if the version is the same but epoch isn't. So let's make
sure.
+
+### FIXME: It doesn't look like this can occur, is it dead code?
+# if (exists $self->{_versions}->{$version}
+# && $self->{_versions}->{$version}->is_type('dummy') ) {
+# $self->{_versions}->{$version}->merge($version_object);
+
+ if (exists $self->{_versions}->{$version}) {
+ # Use the new version, but merge in the old one
+ my $old = $self->{_versions}->{$version};
delete $self->{_versions}->{$version};
- my $fullname = $version_object->get_fullname();
-
- # noload
- if (grep { $_->get_fullname() eq $fullname }
$self->get_all_versions(1)) {
- # avoid overhead of allocating for and storing the grep
- # results in if() since it's rare we'll need it
- my $msg = "A package name is not allowed to have the
same ".
- "version-revision but different epochs:
$fullname\n";
- foreach (
- grep { $_->get_fullname() eq $fullname }
$self->get_all_versions(),
- $version_object
- ) {
- my $infofile = $_->get_info_filename();
- $msg .= sprintf " epoch %d\t%s\n",
- $_->get_epoch(),
- length $infofile ? "fink virtual or
dpkg status" : $infofile;
- };
- die $msg;
- }
-
- $self->{_versions}->{$version} = $version_object;
+ $version_object->merge($old);
}
-
+
+ # $pv->fullname is currently treated as unique, even though it won't be
+ # if the version is the same but epoch isn't. So let's make sure.
+ my $fullname = $version_object->get_fullname();
+
+ # noload
+ if (grep { $_->get_fullname() eq $fullname }
$self->get_all_versions(1)) {
+ # avoid overhead of allocating for and storing the grep
+ # results in if() since it's rare we'll need it
+ my $msg = "A package name is not allowed to have the same ".
+ "version-revision but different epochs: $fullname\n";
+ foreach (
+ grep { $_->get_fullname() eq $fullname }
$self->get_all_versions(),
+ $version_object
+ ) {
+ my $infofile = $_->get_info_filename();
+ $msg .= sprintf " epoch %d\t%s\n",
+ $_->get_epoch(),
+ length $infofile ? "fink virtual or dpkg
status" : $infofile;
+ };
+ die $msg;
+ }
+
+ $self->{_versions}->{$version} = $version_object;
$self->{_virtual} = 0;
}
@@ -221,9 +227,10 @@
sub get_latest_version {
my $self = shift;
+ my $noload = shift || 0;
my @vers = $self->list_versions;
return undef unless @vers;
- return $self->get_version(latest_version(@vers));
+ return $self->get_version(latest_version(@vers), $noload);
}
=item get_matching_versions
@@ -992,7 +999,10 @@
if ($proxy_ok) {
# Just use the proxies
$valid_since = (stat($class->db_proxies))[9];
- eval { $packages = Storable::lock_retrieve($class->db_proxies);
};
+ eval {
+ local $SIG{INT} = 'IGNORE'; # No user interrupts
+ $packages = Storable::lock_retrieve($class->db_proxies);
+ };
if ($@ || !defined $packages) {
die "It appears that part of Fink's package database is
corrupted. "
. "Please run 'fink index' to correct the
problem.\n";
@@ -1005,7 +1015,10 @@
$valid_since = time;
my $idx;
if ($idx_ok) {
- eval { $idx =
Storable::lock_retrieve($class->db_index); };
+ eval {
+ local $SIG{INT} = 'IGNORE'; # No user interrupts
+ $idx =
Storable::lock_retrieve($class->db_index);
+ };
if ($@ || !defined $idx) {
close $lock if $lock;
# Try to force a re-gen next time
@@ -1025,17 +1038,12 @@
close $lock if $lock;
return unless $ops{load};
- # Pass 2: Scan for files to load: Last one reached for each
fullname
- my %name2latest;
- for my $info (@infos) {
- my @fullnames = keys %{ $idx->{infos}{$info}{inits} };
- @[EMAIL PROTECTED] = ($info) x scalar(@fullnames);
- }
- my %loadinfos = map { $_ => 1} values %name2latest; #
uniqify
- my @loadinfos = keys %loadinfos;
+ # Pass 2: This used to narrow down the list of files so only the
+ # 'current' .info files are loaded. We don't do this anymore,
since
+ # we want to know every tree a .info file is in.
# Pass 3: Load and insert the .info files
- $class->pass3_insert($idx, @loadinfos);
+ $class->pass3_insert($idx, @infos);
# Store the proxy db
if ($ops{write}) {
@@ -1163,8 +1171,10 @@
my $dlist = shift;
foreach my $pkgname (keys %$dlist) {
- my $po = $class->package_by_name_create($pkgname);
+ # Skip it if it's already there
+ my $po = $class->package_by_name_create($pkgname);
next if exists
$po->{_versions}->{$dlist->{$pkgname}->{version}};
+
my $hash = $dlist->{$pkgname};
# create dummy object
Index: Engine.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Engine.pm,v
retrieving revision 1.313
retrieving revision 1.314
diff -u -d -r1.313 -r1.314
--- Engine.pm 26 Aug 2005 21:27:19 -0000 1.313
+++ Engine.pm 27 Aug 2005 12:21:01 -0000 1.314
@@ -338,7 +338,7 @@
# Need to auto-index if specifically running 'fink index'!
$config->set_param("NoAutoIndex", 0);
if ($full) {
- Fink::Package->forget_packages();
+ Fink::Package->forget_packages({ disk => 1 });
}
Fink::Package->update_db(no_load => 1, no_fastload => 1);
}
@@ -544,7 +544,7 @@
next unless ( $vo->has_param("maintainer") &&
$vo->param("maintainer") =~ /\Q$maintainer\E/i );
}
if (defined $pkgtree) {
- next unless $vo->get_tree($vo) =~ /\b\Q$pkgtree\E\b/i;
+ next unless $vo->in_tree($pkgtree);
}
if ($cmd eq "apropos") {
next unless ( $vo->has_param("Description") &&
$vo->param("Description") =~ /\Q$pattern\E/i ) || $vo->get_name() =~
/\Q$pattern\E/i;
@@ -2184,6 +2184,7 @@
allversions - List of all known versions of the package name in order.
Currently-installed version (if any) is prefixed with "i".
env - Shell environment in effect during pkg construction.
+ trees - Trees in which this package (same version) exists.
EOF
exit 0;
@@ -2210,7 +2211,7 @@
if ($wantall or not (@fields or @percents)) {
@fields = (qw/
infofile package epoch version
revision parent family
- status allversions
+ status allversions trees
description type license maintainer
pre-depends depends builddepends
provides replaces conflicts
buildconflicts
@@ -2408,6 +2409,8 @@
my $value = $pkg->get_env;
printf "%s:\n", $_;
print map { " $_=".$value->{$_}."\n" } sort
keys %$value;
+ } elsif ($_ eq 'trees') {
+ printf "%s: %s\n", $_, join(' ',
$pkg->get_trees);
} else {
die "Unknown field $_\n";
}
Index: ChangeLog
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/ChangeLog,v
retrieving revision 1.1108
retrieving revision 1.1109
diff -u -d -r1.1108 -r1.1109
--- ChangeLog 26 Aug 2005 21:27:19 -0000 1.1108
+++ ChangeLog 27 Aug 2005 12:21:00 -0000 1.1109
@@ -1,5 +1,19 @@
2005-08-26 Dave Vasilevsky <[EMAIL PROTECTED]>
+ * Engine.pm: Don't just promise to remove on-disk cache in 'index
--full',
+ actually do it.
+ * Package.pm, PkgVersion.pm: Don't allow user to interrupt when Storable
+ is loading part of the DB, to eliminate spurious warnings about
corruption.
+ * Package.pm, PkgVersion.pm: Remove dead code related to merging
PkgVersions
+ into the DB. Make new merge method to merge trees.
+ * PkgVersion.pm: Add new methods to examine trees, also store trees in
+ index.db.
+ * Engine.pm: Use new in_tree method in list. Add 'trees' item to
dumpinfo.
+
+ *** DB FORMAT CHANGE, YOU WILL NEED A FULL REINDEX ***
+
+2005-08-26 Dave Vasilevsky <[EMAIL PROTECTED]>
+
* Bootstrap.pm, Engine.pm, Package.pm, SelfUpdate.pm: Remove unneeded
references to Shlibs.
* PkgVersion.pm: Remove unused method for getting Depends from deb, a
more
-------------------------------------------------------
SF.Net email is Sponsored by the Better Software Conference & EXPO
September 19-22, 2005 * San Francisco, CA * Development Lifecycle Practices
Agile & Plan-Driven Development * Managing Projects & Teams * Testing & QA
Security * Process Improvement & Measurement * http://www.sqe.com/bsce5sf
_______________________________________________
Fink-commits mailing list
Fink-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/fink-commits
