Skip to content

Commit

Permalink
added ShareDir role, testing is partially complete, because install l…
Browse files Browse the repository at this point in the history
…ogic isn't present yet
  • Loading branch information
jberger committed Nov 18, 2012
1 parent 4c88676 commit c8a1f78
Show file tree
Hide file tree
Showing 4 changed files with 365 additions and 121 deletions.
122 changes: 1 addition & 121 deletions lib/Moodule/Build/Base_TODO.pm
Expand Up @@ -542,7 +542,6 @@ __PACKAGE__->add_property($_) for qw(
release_status
script_files
scripts
share_dir
sign
test_files
xs_files
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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;

Expand Down Expand Up @@ -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;
Expand Down
21 changes: 21 additions & 0 deletions 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;

131 changes: 131 additions & 0 deletions 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;

0 comments on commit c8a1f78

Please sign in to comment.