Subject: | File-Path-Expand: Patch to fix expansion of '~' and '~foo' |
I've used File::Path::Expand happily in several projects but
just ran into a bug where paths such as '~' and '~foo' -- i.e.,
without a trailing slash -- failed to expand. I attach a patch
that appears to fix this; here's a summary of my changes:
* Changed the regexes to use look-ahead assertions so the
trailing slash may be omitted.
* Changed the pattern for matching ~foo etc. so it doesn't
match empty user names (not that one could exist after the
first subsitution, but what the heck).
* Made the substitutions mutually exclusive.
* Added tests to verify the corrected behavior.
* Bumped the version from 1.01 to 1.02
I've used File::Path::Expand happily in several projects but
just ran into a bug where paths such as '~' and '~foo' -- i.e.,
without a trailing slash -- failed to expand. I attach a patch
that appears to fix this; here's a summary of my changes:
* Changed the regexes to use look-ahead assertions so the
trailing slash may be omitted.
* Changed the pattern for matching ~foo etc. so it doesn't
match empty user names (not that one could exist after the
first subsitution, but what the heck).
* Made the substitutions mutually exclusive.
* Added tests to verify the corrected behavior.
* Bumped the version from 1.01 to 1.02
diff -ur File-Path-Expand-1.01/lib/File/Path/Expand.pm File-Path-Expand-1.02/lib/File/Path/Expand.pm
--- File-Path-Expand-1.01/lib/File/Path/Expand.pm Sun May 11 16:57:47 2003
+++ File-Path-Expand-1.02/lib/File/Path/Expand.pm Fri Jun 3 15:40:12 2005
@@ -6,14 +6,14 @@
use base 'Exporter';
use vars qw( $VERSION @EXPORT @EXPORT_OK );
-$VERSION = '1.01';
+$VERSION = '1.02';
@EXPORT = qw( expand_filename );
@EXPORT_OK = qw( expand_filename home_of );
sub expand_filename {
my $path = shift;
- $path =~ s{^~/}{ $ENV{HOME} ? "$ENV{HOME}/" : home_of( $> )."/" }e;
- $path =~ s{^~(.*?)/}{ home_of( $1 )."/" }e;
+ $path =~ s{^~(?=/|$)}{ $ENV{HOME} ? "$ENV{HOME}" : home_of( $> ) }e
+ or $path =~ s{^~(.+?)(?=/|$)}{ home_of( $1 ) }e;
return $path;
}
diff -ur File-Path-Expand-1.01/t/File-Path-Expand.t File-Path-Expand-1.02/t/File-Path-Expand.t
--- File-Path-Expand-1.01/t/File-Path-Expand.t Sun May 11 16:57:47 2003
+++ File-Path-Expand-1.02/t/File-Path-Expand.t Fri Jun 3 15:31:03 2005
@@ -1,26 +1,30 @@
#!perl -w
use strict;
-use Test::More tests => 5;
+use Test::More tests => 8;
use Sys::Hostname;
BEGIN { use_ok('File::Path::Expand') };
$ENV{HOME} = '/some/path';
is( expand_filename('~/foo'), "/some/path/foo", 'uses $HOME' );
+is( expand_filename('~'), $ENV{HOME}, '...and similarly for ~' );
SKIP: {
- skip "only guaranteed on penfold", 3
+ skip "only guaranteed on penfold", 5
unless hostname eq 'penfold.unixbeard.net';
SKIP: {
- skip "have to be richardc too", 1
+ skip "have to be richardc too", 2
unless $> eq 1000;
$ENV{HOME} = '';
is( expand_filename("~/foo"), "/home/richardc/foo",
'without $HOME ~/' );
+ is( expand_filename("~"), "/home/richardc",
+ '...and similarly for ~' );
}
is( expand_filename('~root/foo'), "/root/foo", 'root' );
+ is( expand_filename('~root'), "/root", '...and similarly for ~root' );
eval { expand_filename('~frooby/') };
like( $@, qr{^no such user 'frooby'}, "failure" );