Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

added ShareDir role, testing is partially complete, because install l…

…ogic isn't present yet
  • Loading branch information...
commit c8a1f78c6bd5b0531c33980dbbee20f953559361 1 parent 4c88676
@jberger authored
View
122 lib/Moodule/Build/Base_TODO.pm
@@ -542,7 +542,6 @@ __PACKAGE__->add_property($_) for qw(
release_status
script_files
scripts
- share_dir
sign
test_files
xs_files
@@ -2372,56 +2371,6 @@ sub process_support_files {
}
}
-sub process_share_dir_files {
- my $self = shift;
- my $files = $self->_find_share_dir_files;
- return unless $files;
-
- # root for all File::ShareDir paths
- my $share_prefix = File::Spec->catdir($self->blib, qw/lib auto share/);
-
- # copy all share files to blib
- while (my ($file, $dest) = each %$files) {
- $self->copy_if_modified(
- from => $file, to => File::Spec->catfile( $share_prefix, $dest )
- );
- }
-}
-
-sub _find_share_dir_files {
- my $self = shift;
- my $share_dir = $self->share_dir;
- return unless $share_dir;
-
- my @file_map;
- if ( $share_dir->{dist} ) {
- my $prefix = "dist/".$self->dist_name;
- push @file_map, $self->_share_dir_map( $prefix, $share_dir->{dist} );
- }
-
- if ( $share_dir->{module} ) {
- for my $mod ( keys %{ $share_dir->{module} } ) {
- (my $altmod = $mod) =~ s{::}{-}g;
- my $prefix = "module/$altmod";
- push @file_map, $self->_share_dir_map($prefix, $share_dir->{module}{$mod});
- }
- }
-
- return { @file_map };
-}
-
-sub _share_dir_map {
- my ($self, $prefix, $list) = @_;
- my %files;
- for my $dir ( @$list ) {
- for my $f ( @{ $self->rscan_dir( $dir, sub {-f} )} ) {
- $f =~ s{\A.*?\Q$dir\E/}{};
- $files{"$dir/$f"} = "$prefix/$f";
- }
- }
- return %files;
-}
-
sub process_PL_files {
my ($self) = @_;
my $files = $self->find_PL_files;
@@ -3408,7 +3357,7 @@ sub do_create_readme {
my $docfile = $self->_main_docfile;
unless ( $docfile ) {
- $self->log_warn(<<EOF);
+ $self->log_warn( <<EOF );
Cannot create README: can't determine which file contains documentation;
Must supply either 'dist_version_from', or 'module_name' parameter.
EOF
@@ -3755,62 +3704,6 @@ sub _files_in {
return @files;
}
-sub share_dir {
- my $self = shift;
- my $p = $self->{properties};
-
- $p->{share_dir} = shift if @_;
-
- # Always coerce to proper hash form
- if ( ! defined $p->{share_dir} ) {
- return;
- }
- elsif ( ! ref $p->{share_dir} ) {
- # scalar -- treat as a single 'dist' directory
- $p->{share_dir} = { dist => [ $p->{share_dir} ] };
- }
- elsif ( ref $p->{share_dir} eq 'ARRAY' ) {
- # array -- treat as a list of 'dist' directories
- $p->{share_dir} = { dist => $p->{share_dir} };
- }
- elsif ( ref $p->{share_dir} eq 'HASH' ) {
- # hash -- check structure
- my $share_dir = $p->{share_dir};
- # check dist key
- if ( defined $share_dir->{dist} ) {
- if ( ! ref $share_dir->{dist} ) {
- # scalar, so upgrade to arrayref
- $share_dir->{dist} = [ $share_dir->{dist} ];
- }
- elsif ( ref $share_dir->{dist} ne 'ARRAY' ) {
- die "'dist' key in 'share_dir' must be scalar or arrayref";
- }
- }
- # check module key
- if ( defined $share_dir->{module} ) {
- my $mod_hash = $share_dir->{module};
- if ( ref $mod_hash eq 'HASH' ) {
- for my $k ( keys %$mod_hash ) {
- if ( ! ref $mod_hash->{$k} ) {
- $mod_hash->{$k} = [ $mod_hash->{$k} ];
- }
- elsif( ref $mod_hash->{$k} ne 'ARRAY' ) {
- die "modules in 'module' key of 'share_dir' must be scalar or arrayref";
- }
- }
- }
- else {
- die "'module' key in 'share_dir' must be hashref";
- }
- }
- }
- else {
- die "'share_dir' must be hashref, arrayref or string";
- }
-
- return $p->{share_dir};
-}
-
sub script_files {
my $self = shift;
@@ -4701,19 +4594,6 @@ sub depends_on {
}
}
-sub rscan_dir {
- my ($self, $dir, $pattern) = @_;
- my @result;
- local $_; # find() can overwrite $_, so protect ourselves
- my $subr = !$pattern ? sub {push @result, $File::Find::name} :
- !ref($pattern) || (ref $pattern eq 'Regexp') ? sub {push @result, $File::Find::name if /$pattern/} :
- ref($pattern) eq 'CODE' ? sub {push @result, $File::Find::name if $pattern->()} :
- die "Unknown pattern type";
-
- File::Find::find({wanted => $subr, no_chdir => 1}, $dir);
- return \@result;
-}
-
sub autosplit_file {
my ($self, $file, $to) = @_;
require AutoSplit;
View
21 lib/Moodule/Build/Role/RScanDir.pm
@@ -0,0 +1,21 @@
+package Moodule::Build::Role::RScanDir;
+
+use Moo::Role;
+
+use File::Find ();
+
+sub rscan_dir {
+ my ($self, $dir, $pattern) = @_;
+ my @result;
+ local $_; # find() can overwrite $_, so protect ourselves
+ my $subr = !$pattern ? sub {push @result, $File::Find::name} :
+ !ref($pattern) || (ref $pattern eq 'Regexp') ? sub {push @result, $File::Find::name if /$pattern/} :
+ ref($pattern) eq 'CODE' ? sub {push @result, $File::Find::name if $pattern->()} :
+ die "Unknown pattern type";
+
+ File::Find::find({wanted => $subr, no_chdir => 1}, $dir);
+ return \@result;
+}
+
+1;
+
View
131 lib/Moodule/Build/Role/ShareDir.pm
@@ -0,0 +1,131 @@
+package Moodule::Build::Role::ShareDir;
+
+use Moo::Role;
+
+requires qw/rscan_dir blib copy_if_modified dist_name/;
+
+use File::Spec;
+
+my $coerce = sub {
+ my $share_dir = shift;
+
+ # Always coerce to proper hash form
+ if ( ! defined $share_dir ) {
+ return;
+ }
+ elsif ( ! ref $share_dir ) {
+ # scalar -- treat as a single 'dist' directory
+ return { dist => [ $share_dir ] };
+ }
+ elsif ( ref $share_dir eq 'ARRAY' ) {
+ # array -- treat as a list of 'dist' directories
+ return { dist => $share_dir };
+ }
+ elsif ( ref $share_dir ne 'HASH' ) {
+ return $share_dir; # dies on isa check
+ }
+
+ # hash -- check structure
+ # check dist key
+ if ( defined $share_dir->{dist} ) {
+ if ( ! ref $share_dir->{dist} ) {
+ # scalar, so upgrade to arrayref
+ $share_dir->{dist} = [ $share_dir->{dist} ];
+ }
+ }
+
+ # check module key
+ if ( defined $share_dir->{module} ) {
+ my $mod_hash = $share_dir->{module};
+ if ( ref $mod_hash eq 'HASH' ) {
+ for my $k ( keys %$mod_hash ) {
+ next if ref $mod_hash->{$k};
+ $mod_hash->{$k} = [ $mod_hash->{$k} ];
+ }
+ }
+ }
+
+ return $share_dir;
+};
+
+my $isa = sub {
+ my $share_dir = shift;
+ return if ! defined $share_dir;
+
+ die "'share_dir' must be hashref, arrayref or string"
+ unless ref $share_dir eq 'HASH';
+
+ if (
+ defined $share_dir->{dist}
+ && ref $share_dir->{dist} ne 'ARRAY'
+ ) {
+ die "'dist' key in 'share_dir' must be scalar or arrayref";
+ }
+
+ return unless defined ( my $mod_hash = $share_dir->{module} );
+
+ die "'module' key in 'share_dir' must be hashref"
+ unless ref $mod_hash eq 'HASH';
+
+ die "modules in 'module' key of 'share_dir' must be scalar or arrayref"
+ if grep { ref ne 'ARRAY' } values %$mod_hash;
+};
+
+has 'share_dir' => (
+ is => 'rw',
+ coerce => $coerce,
+ isa => $isa,
+);
+
+sub process_share_dir_files {
+ my $self = shift;
+ my $files = $self->_find_share_dir_files;
+ return unless $files;
+
+ # root for all File::ShareDir paths
+ my $share_prefix = File::Spec->catdir($self->blib, qw/lib auto share/);
+
+ # copy all share files to blib
+ while (my ($file, $dest) = each %$files) {
+ $self->copy_if_modified(
+ from => $file, to => File::Spec->catfile( $share_prefix, $dest )
+ );
+ }
+}
+
+sub _find_share_dir_files {
+ my $self = shift;
+ my $share_dir = $self->share_dir;
+ return unless $share_dir;
+
+ my @file_map;
+ if ( $share_dir->{dist} ) {
+ my $prefix = "dist/".$self->dist_name;
+ push @file_map, $self->_share_dir_map( $prefix, $share_dir->{dist} );
+ }
+
+ if ( $share_dir->{module} ) {
+ for my $mod ( keys %{ $share_dir->{module} } ) {
+ (my $altmod = $mod) =~ s{::}{-}g;
+ my $prefix = "module/$altmod";
+ push @file_map, $self->_share_dir_map($prefix, $share_dir->{module}{$mod});
+ }
+ }
+
+ return { @file_map };
+}
+
+sub _share_dir_map {
+ my ($self, $prefix, $list) = @_;
+ my %files;
+ for my $dir ( @$list ) {
+ for my $f ( @{ $self->rscan_dir( $dir, sub {-f} )} ) {
+ $f =~ s{\A.*?\Q$dir\E/}{};
+ $files{"$dir/$f"} = "$prefix/$f";
+ }
+ }
+ return %files;
+}
+
+1;
+
View
212 t/share_dir.t
@@ -0,0 +1,212 @@
+use strict;
+use warnings;
+
+use lib 't';
+use MyTestHelper;
+use File::Temp ();
+use Cwd 'getcwd';
+
+my $old = getcwd;
+my $dir = File::Temp->newdir;
+chdir $dir or die "Cannot chdir into $dir";
+
+use Test::More;
+
+{
+ package MyTestClass;
+ use Moo;
+
+ has 'dist_name' => ( is => 'rw', default => sub { 'Simple-Share' } );
+
+ with 'Moodule::Build::Role::RScanDir';
+ with 'Moodule::Build::Role::ShareDir';
+
+ sub blib { 'blib' }
+ sub copy_if_modified { 1 }
+}
+
+my $module = 'Simple::Share';
+
+# Test without a 'share' dir
+
+my $mb = MyTestClass->new;
+is( $mb->share_dir, undef,
+ "default share_dir undef if no 'share' dir exists"
+);
+
+#ok( ! exists $mb->{properties}{requires}{'File::ShareDir'},
+# "File::ShareDir not added to 'requires'"
+#);
+
+# Add 'share' dir and an 'other' dir and content
+make_file( qw/share foo.txt/, <<'---', {test => 1} );
+This is foo.txt
+---
+make_file( qw/ share subdir share anotherbar.txt /, <<'---', {test => 1} );
+This is anotherbar.txt in a subdir - test for a bug in M::B 0.38 when full path contains 'share/.../*share/...' subdir
+---
+make_file( qw/ share subdir whatever anotherfoo.txt /, <<'---', {test => 1} );
+This is anotherfoo.txt in a subdir - this shoud work on M::B 0.38
+---
+make_file( qw/ other share bar.txt /, <<'---', {test => 1} );
+This is bar.txt
+---
+
+# Check default when share_dir is not given
+$mb = MyTestClass->new;
+is( $mb->share_dir, undef,
+ "Default share_dir is undef even if 'share' exists"
+);
+
+#ok( ! exists $mb->{properties}{requires}{'File::ShareDir'},
+# "File::ShareDir not added to 'requires'"
+#);
+
+# share_dir set to scalar
+$mb = MyTestClass->new( share_dir => 'share' );
+is_deeply( $mb->share_dir, { dist => [ 'share' ] },
+ "Scalar share_dir set as dist-type share"
+);
+
+# share_dir set to arrayref
+$mb = MyTestClass->new( share_dir => [ 'share' ] );
+is_deeply( $mb->share_dir, { dist => [ 'share' ] },
+ "Scalar share_dir set as dist-type share"
+);
+
+# share_dir set to hashref w scalar
+$mb = MyTestClass->new( share_dir => { dist => 'share' } );
+is_deeply( $mb->share_dir, { dist => [ 'share' ] },
+ "Hashref share_dir w/ scalar dist set as dist-type share"
+);
+
+# share_dir set to hashref w array
+$mb = MyTestClass->new( share_dir => { dist => [ 'share' ] } );
+is_deeply( $mb->share_dir, { dist => [ 'share' ] },
+ "Hashref share_dir w/ arrayref dist set as dist-type share"
+);
+
+# Generate a module sharedir (scalar)
+$mb = MyTestClass->new(
+ share_dir => {
+ dist => 'share',
+ module => { $module => 'other/share' },
+ },
+);
+is_deeply( $mb->share_dir,
+ { dist => [ 'share' ],
+ module => { $module => ['other/share'] },
+ },
+ "Hashref share_dir w/ both dist and module shares (scalar-form)"
+);
+
+# Generate a module sharedir (array)
+$mb = MyTestClass->new(
+ share_dir => {
+ dist => [ 'share' ],
+ module => { $module => ['other/share'] },
+ },
+);
+is_deeply( $mb->share_dir,
+ { dist => [ 'share' ],
+ module => { $module => ['other/share'] },
+ },
+ "Hashref share_dir w/ both dist and module shares (array-form)"
+);
+
+#--------------------------------------------------------------------------#
+# test constructing to/from mapping
+#--------------------------------------------------------------------------#
+
+is_deeply( $mb->_find_share_dir_files,
+ {
+ "share/foo.txt" => "dist/Simple-Share/foo.txt",
+ "share/subdir/share/anotherbar.txt" => "dist/Simple-Share/subdir/share/anotherbar.txt",
+ "share/subdir/whatever/anotherfoo.txt" => "dist/Simple-Share/subdir/whatever/anotherfoo.txt",
+ "other/share/bar.txt" => "module/Simple-Share/bar.txt",
+ },
+ "share_dir filemap for copying to lib complete"
+);
+
+done_testing;
+chdir $old;
+
+__END__
+
+#--------------------------------------------------------------------------#
+# test moving files to blib
+#--------------------------------------------------------------------------#
+
+$mb->dispatch('build');
+
+ok( -d 'blib', "Build ran and blib exists" );
+ok( -d 'blib/lib/auto/share', "blib/lib/auto/share exists" );
+
+my $share_list = Module::Build->rscan_dir('blib/lib/auto/share', sub {-f});
+
+SKIP:
+{
+
+skip 'filename case not necessarily preserved', 1 if $^O eq 'VMS';
+
+is_deeply(
+ [ sort @$share_list ], [
+ 'blib/lib/auto/share/dist/Simple-Share/foo.txt',
+ 'blib/lib/auto/share/dist/Simple-Share/subdir/share/anotherbar.txt',
+ 'blib/lib/auto/share/dist/Simple-Share/subdir/whatever/anotherfoo.txt',
+ 'blib/lib/auto/share/module/Simple-Share/bar.txt',
+ ],
+ "share_dir files copied to blib"
+);
+
+}
+
+#--------------------------------------------------------------------------#
+# test installing
+#--------------------------------------------------------------------------#
+
+my $temp_install = 'temp_install';
+mkdir $temp_install;
+ok( -d $temp_install, "temp install dir created" );
+
+$mb->install_base($temp_install);
+stdout_of( sub { $mb->dispatch('install') } );
+
+$share_list = Module::Build->rscan_dir(
+ "$temp_install/lib/perl5/auto/share", sub {-f}
+);
+
+SKIP:
+{
+
+skip 'filename case not necessarily preserved', 1 if $^O eq 'VMS';
+
+is_deeply(
+ [ sort @$share_list ], [
+ "$temp_install/lib/perl5/auto/share/dist/Simple-Share/foo.txt",
+ "$temp_install/lib/perl5/auto/share/dist/Simple-Share/subdir/share/anotherbar.txt",
+ "$temp_install/lib/perl5/auto/share/dist/Simple-Share/subdir/whatever/anotherfoo.txt",
+ "$temp_install/lib/perl5/auto/share/module/Simple-Share/bar.txt",
+ ],
+ "share_dir files correctly installed"
+);
+
+}
+
+#--------------------------------------------------------------------------#
+# test with File::ShareDir
+#--------------------------------------------------------------------------#
+
+SKIP: {
+ eval { require File::ShareDir; File::ShareDir->VERSION(1.00) };
+ skip "needs File::ShareDir 1.00", 2 if $@;
+
+ unshift @INC, File::Spec->catdir($temp_install, qw/lib perl5/);
+ require Simple::Share;
+
+ eval {File::ShareDir::dist_file('Simple-Share','foo.txt') };
+ is( $@, q{}, "Found shared dist file" );
+
+ eval {File::ShareDir::module_file('Simple::Share','bar.txt') };
+ is( $@, q{}, "Found shared module file" );
+}
Please sign in to comment.
Something went wrong with that request. Please try again.