Attachment #119474 for bug #162016

View | Details | Raw Unified | Return to bug 162016
Collapse All | Expand All




use Fcntl;
use BSDPAN;
use BSDPAN::Override;
use File::Basename qw(dirname basename);

sub write {
	my $orig = shift;	# original ExtUtils::Packlist::write

	my %alldirs;

	for my $file (@files) {
		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 eq "man1";
			last if $last eq "man3";
			last if $last eq "site_perl";
			last if $last eq "mach";
			last if $last =~ /^[\d.]+$/;

			$alldirs{$dir}++;

			my $parent = dirname($dir);
			last if $parent eq $dir;
			last if $parent eq '/';
			$dir = $parent;
		}
	}





#!/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;

Return to bug 162016

Lines 17-22 use Config; Link Here

(-)b/BSDPAN/ExtUtils/Packlist.pm (-11 / +14 lines)
17	use Fcntl;	17	use Fcntl;
18	use BSDPAN;	18	use BSDPAN;
19	use BSDPAN::Override;	19	use BSDPAN::Override;
		20	use File::Basename qw(dirname basename);
20		21
21	sub write {	22	sub write {
22	my $orig = shift; # original ExtUtils::Packlist::write	23	my $orig = shift; # original ExtUtils::Packlist::write
Lines 210-227 sub get_dir_list { Link Here
210	my %alldirs;	211	my %alldirs;
211		212
212	for my $file (@files) {	213	for my $file (@files) {
213	$file =~ s\|/[^/]+$\|\|;	214	my $dir = dirname($file);
214	while (-d $file) {	215
215	$file =~ s\|/([^/]+)$\|\|;	216	while( -d $dir ) {
216	my $last = $1;	217	my $last = basename($dir);
217	last if $last eq "bin";	218	last if grep { $last eq $_ } qw(bin auto man1 man3 site_perl mach);
218	last if $last eq "auto";	219
219	last if $last eq "man1";
220	last if $last eq "man3";
221	last if $last eq "site_perl";
222	last if $last eq "mach";
223	last if $last =~ /^[\d.]+$/;	220	last if $last =~ /^[\d.]+$/;
224	$alldirs{"$file/$last"}++;	221
		222	$alldirs{$dir}++;
		223
		224	my $parent = dirname($dir);
		225	last if $parent eq $dir;
		226	last if $parent eq '/';
		227	$dir = $parent;
225	}	228	}
226	}	229	}
227		230

Added Link Here

(-)b/t/get_dir_list.t (+79 lines)
1	#!/usr/bin/env perl -w
2
3	use strict;
4	use warnings;
5
6	use autodie;
7	use BSDPAN::ExtUtils::Packlist;
8	use ExtUtils::Packlist;
9	use File::Temp;
10	use File::Spec;
11	use File::Path;
12	use Cwd qw(abs_path);
13
14	use Test::More;
15
16	my $Orig_Cwd = abs_path;
17
18	my $get_dir_list = \&BSDPAN::ExtUtils::Packlist::get_dir_list;
19
20	my $packlist = ExtUtils::Packlist->new;
21
22
23	note "get_dir_list"; {
24	my $tempdir = File::Temp->newdir;
25
26	my @tempdir = grep { length $_ } File::Spec->splitdir($tempdir);
27	my %want;
28	for my $depth (0..$#tempdir) {
29	$want{File::Spec->catdir("", @tempdir[0..$depth])}++;
30	}
31
32	is_deeply
33	[sort $get_dir_list->($packlist, "$tempdir/.packlist", "$tempdir/lib/perl5/Foo/Bar.pm")],
34	[sort keys %want];
35
36	# Now do it again with the lib directory existing
37	mkpath "$tempdir/lib/perl5/Foo";
38
39	$want{"$tempdir/lib/perl5/Foo"} = 1;
40	$want{"$tempdir/lib/perl5"} = 1;
41	$want{"$tempdir/lib"} = 1;
42
43	is_deeply
44	[sort $get_dir_list->($packlist, "$tempdir/.packlist", "$tempdir/lib/perl5/Foo/Bar.pm")],
45	[sort keys %want];
46
47	# Does it ignore bin?
48	mkpath "$tempdir/bin";
49
50	is_deeply
51	[sort $get_dir_list->(
52	$packlist,
53	"$tempdir/.packlist",
54	"$tempdir/lib/perl5/Foo/Bar.pm",
55	"$tempdir/bin/foo",
56	)],
57	[sort keys %want];
58	}
59
60
61	note "With .. and ."; {
62	my $tempdir = File::Temp->newdir;
63	mkdir "$tempdir/foo";
64	chdir "$tempdir/foo";
65
66	is_deeply
67	[sort $get_dir_list->($packlist, "../foo/.packlist")],
68	["../foo"];
69
70	chdir $tempdir;
71
72	is_deeply
73	[sort $get_dir_list->($packlist, "./foo/.packlist")],
74	["./foo"];
75
76	chdir $Orig_Cwd;
77	}
78
79	done_testing;