Attachment 119474 Details for Bug 162016 – get_dir_list.patch

[patch] get_dir_list.patch

get_dir_list.patch (text/plain), 2.92 KB, created by Michael G Schwern on 2011-10-26 01:04:39 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Michael G Schwern

Created: 2011-10-26 01:04:39 UTC

Size: 2.92 KB

patch

obsolete

>diff --git a/BSDPAN/ExtUtils/Packlist.pm b/BSDPAN/ExtUtils/Packlist.pm
>index 19f764e..b659513 100644
>--- a/BSDPAN/ExtUtils/Packlist.pm
>+++ b/BSDPAN/ExtUtils/Packlist.pm
>@@ -17,6 +17,7 @@ use Config;
> use Fcntl;
> use BSDPAN;
> use BSDPAN::Override;
>+use File::Basename qw(dirname basename);
> 
> sub write {
> 	my $orig = shift;	# original ExtUtils::Packlist::write
>@@ -210,18 +211,20 @@ sub get_dir_list {
> 	my %alldirs;
> 
> 	for my $file (@files) {
>-		$file =~ s|/[^/]+$||;
>-		while (-d $file) {
>-			$file =~ s|/([^/]+)$||;
>-			my $last = $1;
>-			last if $last eq "bin";
>-			last if $last eq "auto";
>-			last if $last eq "man1";
>-			last if $last eq "man3";
>-			last if $last eq "site_perl";
>-			last if $last eq "mach";
>+		my $dir = dirname($file);
>+
>+		while( -d $dir ) {
>+			my $last = basename($dir);
>+			last if grep { $last eq $_ } qw(bin auto man1 man3 site_perl mach);
>+
> 			last if $last =~ /^[\d.]+$/;
>-			$alldirs{"$file/$last"}++;
>+
>+			$alldirs{$dir}++;
>+
>+			my $parent = dirname($dir);
>+			last if $parent eq $dir;
>+			last if $parent eq '/';
>+			$dir = $parent;
> 		}
> 	}
> 
>diff --git a/t/get_dir_list.t b/t/get_dir_list.t
>new file mode 100644
>index 0000000..703a78e
>--- /dev/null
>+++ b/t/get_dir_list.t
>@@ -0,0 +1,79 @@
>+#!/usr/bin/env perl -w
>+
>+use strict;
>+use warnings;
>+
>+use autodie;
>+use BSDPAN::ExtUtils::Packlist;
>+use ExtUtils::Packlist;
>+use File::Temp;
>+use File::Spec;
>+use File::Path;
>+use Cwd qw(abs_path);
>+
>+use Test::More;
>+
>+my $Orig_Cwd = abs_path;
>+
>+my $get_dir_list = \&BSDPAN::ExtUtils::Packlist::get_dir_list;
>+
>+my $packlist = ExtUtils::Packlist->new;
>+
>+
>+note "get_dir_list"; {
>+    my $tempdir = File::Temp->newdir;
>+
>+    my @tempdir = grep { length $_ } File::Spec->splitdir($tempdir);
>+    my %want;
>+    for my $depth (0..$#tempdir) {
>+        $want{File::Spec->catdir("", @tempdir[0..$depth])}++;
>+    }
>+
>+    is_deeply
>+      [sort $get_dir_list->($packlist, "$tempdir/.packlist", "$tempdir/lib/perl5/Foo/Bar.pm")],
>+      [sort keys %want];
>+
>+    # Now do it again with the lib directory existing
>+    mkpath "$tempdir/lib/perl5/Foo";
>+
>+    $want{"$tempdir/lib/perl5/Foo"} = 1;
>+    $want{"$tempdir/lib/perl5"} = 1;
>+    $want{"$tempdir/lib"} = 1;
>+
>+    is_deeply
>+      [sort $get_dir_list->($packlist, "$tempdir/.packlist", "$tempdir/lib/perl5/Foo/Bar.pm")],
>+      [sort keys %want];
>+
>+    # Does it ignore bin?
>+    mkpath "$tempdir/bin";
>+
>+    is_deeply
>+      [sort $get_dir_list->(
>+          $packlist,
>+          "$tempdir/.packlist",
>+          "$tempdir/lib/perl5/Foo/Bar.pm",
>+          "$tempdir/bin/foo",
>+      )],
>+      [sort keys %want];
>+}
>+
>+
>+note "With .. and ."; {
>+    my $tempdir = File::Temp->newdir;
>+    mkdir "$tempdir/foo";
>+    chdir "$tempdir/foo";
>+
>+    is_deeply
>+      [sort $get_dir_list->($packlist, "../foo/.packlist")],
>+      ["../foo"];
>+
>+    chdir $tempdir;
>+
>+    is_deeply
>+      [sort $get_dir_list->($packlist, "./foo/.packlist")],
>+      ["./foo"];
>+
>+    chdir $Orig_Cwd;
>+}
>+
>+done_testing;

Actions: View | Diff

Attachments on bug 162016: 119474