Update of /cvsroot/fink/fink/perlmod/Fink
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32234/perlmod/Fink
Modified Files:
ChangeLog Package.pm Services.pm
Log Message:
new multi-dir finkinfodb system
Index: Services.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Services.pm,v
retrieving revision 1.163
retrieving revision 1.164
diff -u -d -r1.163 -r1.164
--- Services.pm 28 Apr 2005 05:00:44 -0000 1.163
+++ Services.pm 28 Apr 2005 05:27:01 -0000 1.164
@@ -1486,6 +1486,11 @@
A description of the process that the lock is synchronizing. This is used in
messages printed by this function, eg: "Waiting for $desc to finish".
+=item no_block => $no_block
+
+If present and true, lock_wait will forget the 'wait' part of its name. If the
+lock cannot be acquired immediately, failure will be returned.
+
=back
=cut
@@ -1494,28 +1499,31 @@
my $lockfile = shift;
my %options = @_;
- my $write = $options{exclusive} || 0;
+ my $exclusive = $options{exclusive} || 0;
my $timeout = exists $options{timeout} ? $options{timeout} : 300;
$timeout = $options{root_timeout} if exists $options{root_timeout};
my $root_timeout = $options{root_timeout} || 0;
my $quiet = $options{quiet} || 0;
my $desc = $options{desc} || "another process";
+ my $no_block = $options{no_block} || 0;
my $really_timeout = $> != 0 || $root_timeout;
# Make sure we can access the lock
my $lockfile_FH = Symbol::gensym();
{
- my $mode = $write ? "+>>" : "<";
+ my $mode = ($exclusive || ! -e $lockfile) ? "+>>" : "<";
unless (open $lockfile_FH, "$mode $lockfile") {
return wantarray ? (0, 0) : 0;
}
}
- my $mode = $write ? LOCK_EX : LOCK_SH;
+ my $mode = $exclusive ? LOCK_EX : LOCK_SH;
if (flock $lockfile_FH, $mode | LOCK_NB) {
return wantarray ? ($lockfile_FH, 0) : $lockfile_FH;
} else {
+ return (wantarray ? (0, 0) : 0) if $no_block;
+
# Couldn't get lock, meaning process has it
my $waittime = $really_timeout ? "$timeout seconds " : "";
print STDERR "Waiting ${waittime}for $desc to finish..."
Index: Package.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Package.pm,v
retrieving revision 1.135
retrieving revision 1.136
diff -u -d -r1.135 -r1.136
--- Package.pm 28 Apr 2005 01:19:07 -0000 1.135
+++ Package.pm 28 Apr 2005 05:27:01 -0000 1.136
@@ -412,19 +412,129 @@
}
+=private comment
+
+When Fink uses a DB dir, it needs continued access to what's inside (since it
+likely is using 'backed' PkgVersions). So when the DB is invalidated, we can't
+just delete it.
+
+Instead, we mark it as 'old' by creating a brand new DB dir. These dirs all
+look like 'db.#', eg: db.1234, and the one that has the largest # is the
+current one.
+
+But how do we ever delete a DB dir? Each Fink gets a shared lock on its DB
+dir; then if a DB dir is old and has no shared locks, it's no longer in use
+and can be deleted.
+
+=item check_dbdirs
+
+ my ($path, $fh) = Fink::Package->check_dbdirs $write, $force_create;
+
+Process the DB dirs. Returns the good directory found/created, and the lock
+already acquired.
+
+If $write is true, will create a new directory if one does not exist, and will
+delete any old dirs.
+
+If $force_create is true, will always create a new directory (invalidating any
+previous PDB dirs).
+
+=cut
+
+sub check_dbdirs {
+ my ($class, $write, $force_create) = @_;
+
+ # This directory holds multiple 'db.#' dirs
+ my $multidir = "$dbpath/finkinfodb";
+
+ # Special case: If the file "$multidir/invalidate" exists, it means
+ # a shell script wants us to invalidate the DB
+ my $inval = "$multidir/invalidate";
+ if (-e $inval) {
+ $force_create = 1;
+ rm_f($inval) if $write;
+ }
+
+ # Get the db.# numbers in high-to-low order.
+ my @nums;
+ if (opendir MULTI, $multidir) {
+ @nums = sort { $b <=> $a} map { /^db\.(\d+)$/ ? $1 : () }
readdir MULTI;
+ }
+ # Find a number higher than all existing, for new dir
+ my $higher = @nums ? $nums[0] + 1 : 1;
+ my $newdir = "$multidir/db.$higher";
+
+ # Get the current dir
+ my @dirs = grep { -d $_ } map { "$multidir/db.$_" } @nums;
+ my $use_existing = !$force_create && @dirs;
+ my ($current, $fh);
+
+ # Try to lock on an existing dir, if applicable
+ if ($use_existing) {
+ $current = $dirs[0];
+ $fh = lock_wait("$current.lock", exclusive => 0, no_block => 1);
+ # Failure ok, will try a new dir
+ }
+
+ # Use and lock a new dir, if needed
+ if (!$fh) {
+ $current = $newdir;
+ if ($write) { # If non-write, it's just a fake new dir
+ mkdir_p($multidir) unless -d $multidir;
+ $fh = lock_wait("$current.lock", exclusive => 0,
no_block => 1)
+ or die "Can't make new DB dir $current: $!\n";
+ mkdir_p($current);
+ }
+ }
+
+ # Try to delete old dirs
+ my @old = grep { $_ ne $current } @dirs;
+ if ($write) {
+ for my $dir (@old) {
+ if (my $fh = lock_wait("$dir.lock", exclusive => 1,
no_block => 1)) {
+ rm_rf($dir);
+ close $fh;
+ }
+ }
+ }
+
+ return ($current, $fh);
+}
+
=item db_dir
- my $path = Fink::Package->db_dir;
-
+ my $path = Fink::Package->db_dir $write;
+
Get the path to the directory that can store the Fink cached package database.
+Creates it if it does not exist and $write is true.
+
+=item forget_db_dir
+
+ Fink::Package->forget_db_dir;
+
+Forget the current DB directory.
=cut
-sub db_dir {
- my $class = shift;
- return "$dbpath/finkinfodb";
-}
+{
+ my $cache_db_dir = undef;
+ my $cache_db_dir_fh = undef;
+ sub db_dir {
+ my $class = shift;
+ my $write = shift || 0;
+
+ unless (defined $cache_db_dir) {
+ ($cache_db_dir, $cache_db_dir_fh) =
$class->check_dbdirs($write, 0);
+ }
+ return $cache_db_dir;
+ }
+
+ sub forget_db_dir {
+ close $cache_db_dir_fh if $cache_db_dir_fh;
+ ($cache_db_dir, $cache_db_dir_fh) = (undef, undef);
+ }
+}
=item db_index
@@ -532,7 +642,11 @@
if (!$just_memory && $> == 0) { # Only if we're root
my $lock = lock_wait($class->db_lockfile, exclusive =>
1,
desc => "another Fink's indexing");
- rm_rf($class->db_dir);
+
+ # Create a new DB dir (possibly deleting the old one)
+ $class->forget_db_dir();
+ $class->check_dbdirs(1, 1);
+
rm_f($class->db_index);
rm_f($class->db_infolist);
close $lock if $lock;
@@ -645,7 +759,7 @@
my %new_idx = (
inits => { map { $_->get_fullname => $_->get_init_fields } @pvs
},
- cache => $cache
+ cache => $cache,
);
return ($idx->{infos}{$info} = \%new_idx);
@@ -859,8 +973,7 @@
}
# Get the cache dir
- my $dbdir = $class->db_dir;
- mkdir_p($dbdir) if $ops{write} && !-d $dbdir;
+ my $dbdir = $class->db_dir($ops{write});
# Load the index
my $idx = { infos => { }, next => 1 };
Index: ChangeLog
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/ChangeLog,v
retrieving revision 1.984
retrieving revision 1.985
diff -u -d -r1.984 -r1.985
--- ChangeLog 28 Apr 2005 05:00:38 -0000 1.984
+++ ChangeLog 28 Apr 2005 05:27:01 -0000 1.985
@@ -1,3 +1,9 @@
+2005-04-28 Dave Vasilevsky <[EMAIL PROTECTED]>
+
+ * Services.pm: Add no_block (non-blocking) ability to lock_wait.
+ * Package.pm: Use multi-dir finkinfodb system to avoid accidentally
+ deleting another Fink's DB.
+
2005-04-27 Dave Vasilevsky <[EMAIL PROTECTED]>
* Services.pm: New lockwait_executable (with better PATH
-------------------------------------------------------
SF.Net email is sponsored by: Tell us your software development plans!
Take this survey and enter to win a one-year sub to SourceForge.net
Plus IDC's 2005 look-ahead and a copy of this survey
Click here to start! http://www.idcswdc.com/cgi-bin/survey?id=105hix
_______________________________________________
Fink-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/fink-commits
