| Subject: | Win32 |
Hello Lionel,
Tried on Windows, I got the following error messages. My guess is
because Directory::Queue does not use File::Spec family and the $!
values explicitely.
C:\>perl -MDirectory::Queue::Simple -e "$queue =
Directory::Queue::Simple->new(path => shift); $queue->add(\"test\");
foreach (1..2
) {if (fork() == 0) {if ($first = $queue->first())
{$queue->lock($first)}}} sleep(2);" C:\Windows\Temp
Directory::Queue::Simple: cannot
link(C:\Windows\Temp/4f7579d0/4f7579e4880b74,
C:\Windows\Temp/4f7579d0/4f7579e4880b74.lck): Invalid argument
Directory::Queue::Simple: cannot
link(C:\Windows\Temp/4f7579d0/4f7579e4880b74,
C:\Windows\Temp/4f7579d0/4f7579e4880b74.lck): Invalid argument
Since I tried only Directory::Queue::Simple, please find attached a
proposal for this sub-module (and its parent Queue.pm), not validated
under *ix btw -;! But the principle remains valid; may I suggest to use
File::Spec and not explicit errno values in your package, so that your
package gains portability ? I assumed "link" works every where.
Thanks a lot,
Cheers,
Jean-Damien Durand.
| Subject: | Directory_Queue.diff |
diff -Naur Directory-Queue-1.5.old/lib/Directory/Queue/Simple.pm Directory-Queue-1.5.new/lib/Directory/Queue/Simple.pm
--- Directory-Queue-1.5.old/lib/Directory/Queue/Simple.pm 2012-01-24 09:58:01.000000000 +0100
+++ Directory-Queue-1.5.new/lib/Directory/Queue/Simple.pm 2012-03-30 10:19:06.979900600 +0200
@@ -22,6 +22,7 @@
use Directory::Queue qw(:DIR :FILE :RE :ST _fatal _name SYSBUFSIZE);
use POSIX qw(:errno_h);
+use File::Spec::Functions qw(catfile catdir);
#
# inheritance
@@ -88,10 +89,10 @@
$dir = _add_dir($self);
while (1) {
$name = _name();
- $tmp = $self->{path} . "/" . $dir . "/" . $name . TEMPORARY_SUFFIX;
+ $tmp = catfile($self->{path}, $dir, $name . TEMPORARY_SUFFIX);
$fh = _file_create($tmp, $self->{umask});
last if $fh;
- _special_mkdir($self->{path} . "/" . $dir, $self->{umask}) if $! == ENOENT;
+ _special_mkdir(catdir($self->{path}, $dir), $self->{umask}) if ! -d catdir($self->{path}, $dir);
}
$length = length($$dataref);
$offset = 0;
@@ -111,13 +112,13 @@
while (1) {
$name = _name();
- $new = $self->{path} . "/" . $dir . "/" . $name;
+ $new = catfile($self->{path}, $dir, $name);
# N.B. we use link() + unlink() to make sure $new is never overwritten
if (link($tmp, $new)) {
unlink($tmp) or _fatal("cannot unlink(%s): %s", $tmp, $!);
- return($dir . "/" . $name);
+ return(catfile($dir, $name));
}
- _fatal("cannot link(%s, %s): %s", $tmp, $new, $!) unless $! == EEXIST;
+ _fatal("cannot link(%s, %s): %s", $tmp, $new, $!) unless -e $new;
}
}
@@ -146,7 +147,7 @@
my($dir);
$dir = _add_dir($self);
- _special_mkdir($self->{path} . "/" . $dir, $self->{umask});
+ _special_mkdir(catdir($self->{path}, $dir), $self->{umask});
return(_add_path($self, $path, $dir));
}
@@ -157,19 +158,19 @@
sub get : method {
my($self, $name) = @_;
- return(${ _file_read($self->{path} . "/" . $name . LOCKED_SUFFIX, 0) });
+ return(${ _file_read(catfile($self->{path}, $name . LOCKED_SUFFIX), 0) });
}
sub get_ref : method {
my($self, $name) = @_;
- return(_file_read($self->{path} . "/" . $name . LOCKED_SUFFIX, 0));
+ return(_file_read(catfile($self->{path}, $name . LOCKED_SUFFIX), 0));
}
sub get_path : method {
my($self, $name) = @_;
- return($self->{path} . "/" . $name . LOCKED_SUFFIX);
+ return(catfile($self->{path}, $name . LOCKED_SUFFIX));
}
#
@@ -183,7 +184,7 @@
my($path, $lock, $time);
$permissive = 1 unless defined($permissive);
- $path = $self->{path} . "/" . $name;
+ $path = catfile($self->{path}, $name);
$lock = $path . LOCKED_SUFFIX;
if (link($path, $lock)) {
# we also touch the element to indicate the lock time
@@ -192,7 +193,7 @@
or _fatal("cannot utime(%d, %d, %s): %s", $time, $time, $path, $!);
return(1);
}
- return(0) if $permissive and ($! == EEXIST or $! == ENOENT);
+ return(0) if $permissive and (-e $lock or ! -e $path);
_fatal("cannot link(%s, %s): %s", $path, $lock, $!);
}
@@ -207,10 +208,13 @@
my($path, $lock);
$permissive = 0 unless defined($permissive);
- $path = $self->{path} . "/" . $name;
+ $path = catfile($self->{path}, $name);
$lock = $path . LOCKED_SUFFIX;
- return(1) if unlink($lock);
- return(0) if $permissive and $! == ENOENT;
+ if (unlink($lock)) {
+ return(1);
+ } else {
+ return(0) if $permissive and -e $lock;
+ }
_fatal("cannot unlink(%s): %s", $lock, $!);
}
@@ -222,7 +226,7 @@
my($self, $name) = @_;
my($path, $lock);
- $path = $self->{path} . "/" . $name;
+ $path = catfile($self->{path}, $name);
$lock = $path . LOCKED_SUFFIX;
unlink($path) or _fatal("cannot unlink(%s): %s", $path, $!);
unlink($lock) or _fatal("cannot unlink(%s): %s", $lock, $!);
@@ -243,7 +247,7 @@
}
# count the elements inside
foreach $name (@list) {
- $count += grep(/^(?:$_ElementRegexp)$/o, _special_getdir($self->{path} . "/" . $name));
+ $count += grep(/^(?:$_ElementRegexp)$/o, _special_getdir(catdir($self->{path}, $name)));
}
# that's all
return($count);
@@ -276,18 +280,18 @@
$oldlock = time() - $option{maxlock} if $option{maxlock};
if ($oldtemp or $oldlock) {
foreach $name (@list) {
- $path = $self->{path} . "/" . $name;
+ $path = catdir($self->{path}, $name);
foreach $old (grep(/\./, _special_getdir($path))) {
- @stat = stat($path . "/" . $old);
+ @stat = stat(catfile($path, $old));
unless (@stat) {
- _fatal("cannot stat(%s/%s): %s", $path, $old, $!) unless $! == ENOENT;
+ _fatal("cannot stat(%s): %s", catfile($path, $old), $!) unless ! -e catfile($path, $old);
next;
}
next if substr($old, -4) eq TEMPORARY_SUFFIX and $stat[ST_MTIME] >= $oldtemp;
next if substr($old, -4) eq LOCKED_SUFFIX and $stat[ST_MTIME] >= $oldlock;
- warn("* removing too old volatile file: $path/$old\n");
- next if unlink($path . "/" . $old);
- _fatal("cannot unlink(%s/%s): %s", $path, $old, $!) unless $! == ENOENT;
+ warn("* removing too old volatile file: %s\n", catfile($path, $old));
+ next if unlink(catfile($path, $old));
+ _fatal("cannot unlink(%s): %s", catfile($path, $old), $!) unless ! -e catfile($path, $old);
}
}
}
@@ -296,7 +300,7 @@
if (@list > 1) {
pop(@list);
foreach $name (@list) {
- $path = $self->{path} . "/" . $name;
+ $path = catdir($self->{path}, $name);
_special_rmdir($path) unless _special_getdir($path);
}
}
diff -Naur Directory-Queue-1.5.old/lib/Directory/Queue.pm Directory-Queue-1.5.new/lib/Directory/Queue.pm
--- Directory-Queue-1.5.old/lib/Directory/Queue.pm 2012-01-24 09:58:01.000000000 +0100
+++ Directory-Queue-1.5.new/lib/Directory/Queue.pm 2012-03-30 10:06:53.356211900 +0200
@@ -24,11 +24,11 @@
our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
@ISA = qw(Exporter);
@EXPORT = qw();
-@EXPORT_OK = qw(_fatal _name SYSBUFSIZE);
+@EXPORT_OK = qw(_fatal _name _warn SYSBUFSIZE);
%EXPORT_TAGS = (
"DIR" => [qw(_special_mkdir _special_rmdir _special_getdir)],
"FILE" => [qw(_file_read _file_create _file_write)],
- "RE" => [qw($_DirectoryRegexp $_ElementRegexp)],
+ "RE" => [qw($_DirectoryRegexp $_ElementRegexp $_CurdirOrUpdir)],
"ST" => [qw(ST_DEV ST_INO ST_NLINK ST_MTIME)],
);
Exporter::export_tags();
@@ -39,6 +39,8 @@
use POSIX qw(:errno_h :fcntl_h);
use Time::HiRes qw();
+use File::Spec::Functions qw(curdir updir catfile catdir splitdir);
+use File::Basename qw(dirname);
#
# global variables
@@ -76,10 +78,12 @@
our(
$_DirectoryRegexp, # regexp matching an intermediate directory
$_ElementRegexp, # regexp matching an element
+ $_CurdirOrUpdir # regexp matching curdir or updir
);
$_DirectoryRegexp = qr/[0-9a-f]{8}/;
$_ElementRegexp = qr/[0-9a-f]{14}/;
+$_CurdirOrUpdir = ($_ = '^(?:' . join('|', quotemeta(curdir), quotemeta(updir)) . ')$', qr/$_/);
#+++############################################################################
# #
@@ -100,6 +104,18 @@
}
#
+# report a warning with a sprintf() API
+#
+
+sub _warn ($@) {
+ my($message, @arguments) = @_;
+
+ $message = sprintf($message, @arguments) if @arguments;
+ $message =~ s/\s+$//;
+ warn(caller() . ": $message\n");
+}
+
+#
# make sure a module is loaded
#
@@ -155,7 +171,7 @@
$success = mkdir($path);
}
return(1) if $success;
- _fatal("cannot mkdir(%s): %s", $path, $!) unless $! == EEXIST and -d $path;
+ _fatal("cannot mkdir(%s): %s", $path, $!) unless -d $path;
# RACE: someone else may have created it at the the same time
return(0);
}
@@ -171,7 +187,7 @@
my($path) = @_;
return(1) if rmdir($path);
- _fatal("cannot rmdir(%s): %s", $path, $!) unless $! == ENOENT;
+ _fatal("cannot rmdir(%s): %s", $path, $!) unless ! -d $path;
# RACE: someone else may have deleted it at the the same time
return(0);
}
@@ -189,12 +205,12 @@
my($dh, @list);
if (opendir($dh, $path)) {
- @list = grep($_ !~ /^\.\.?$/, readdir($dh));
- closedir($dh) or _fatal("cannot closedir(%s): %s", $path, $!);
+ @list = grep($_ !~ /$_CurdirOrUpdir/, readdir($dh));
+ closedir($dh) or _warn("cannot closedir(%s): %s", $path, $!); # It is not fatal to not being able to close a directory
return(@list);
}
_fatal("cannot opendir(%s): %s", $path, $!)
- unless $! == ENOENT and not $strict;
+ unless ! -d $path and not $strict;
# RACE: someone else may have deleted it at the the same time
return();
}
@@ -224,7 +240,7 @@
$done = sysread($fh, $data, SYSBUFSIZE, length($data));
_fatal("cannot sysread(%s): %s", $path, $!) unless defined($done);
}
- close($fh) or _fatal("cannot close(%s): %s", $path, $!);
+ close($fh) or _warn("cannot close(%s): %s", $path, $!); # It is not fatal to not being able to close a file, although very suspicious
return(\$data);
}
@@ -249,9 +265,9 @@
}
return($fh) if $success;
_fatal("cannot sysopen(%s, O_WRONLY|O_CREAT|O_EXCL): %s", $path, $!)
- unless ($! == EEXIST or $! == ENOENT) and not $strict;
- # RACE: someone else may have created the file (EEXIST)
- # RACE: the containing directory may be mising (ENOENT)
+ unless (-e $path or ! -d dirname($path)) and not $strict;
+ # RACE: someone else may have created the file
+ # RACE: the containing directory may be mising
return(0);
}
@@ -283,7 +299,7 @@
$length -= $done;
$offset += $done;
}
- close($fh) or _fatal("cannot close(%s): %s", $path, $!);
+ close($fh) or _warn("cannot close(%s): %s", $path, $!); # It is not fatal to not being able to close a file, although very suspicious
}
#+++############################################################################
@@ -333,8 +349,8 @@
}
# create the toplevel directory if needed
$path = "";
- foreach $name (split(/\/+/, $self->{path})) {
- $path .= $name . "/";
+ foreach $name (grep {defined($_) && $_} splitdir($path)) {
+ $path .= catdir($path, $name);
_special_mkdir($path, $self->{umask}) unless -d $path;
}
# store the queue unique identifier
@@ -403,11 +419,11 @@
return(shift(@{ $self->{elts} })) if @{ $self->{elts} };
while (@{ $self->{dirs} }) {
$dir = shift(@{ $self->{dirs} });
- foreach $name (_special_getdir($self->{path} . "/" . $dir)) {
+ foreach $name (_special_getdir(catdir($self->{path}, $dir))) {
push(@list, $1) if $name =~ /^($_ElementRegexp)$/o; # untaint
}
next unless @list;
- $self->{elts} = [ map("$dir/$_", sort(@list)) ];
+ $self->{elts} = [ map(catdir($dir, $_), sort(@list)) ];
return(shift(@{ $self->{elts} }));
}
return("");
@@ -438,7 +454,7 @@
my($time, $path);
$time = time();
- $path = $self->{path} . "/" . $element;
+ $path = catfile($self->{path}, $element);
utime($time, $time, $path)
or _fatal("cannot utime(%d, %d, %s): %s", $time, $time, $path, $!);
}