Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

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

…ogic isn't present yet
  • Loading branch information...
commit c8a1f78c6bd5b0531c33980dbbee20f953559361 1 parent 4c88676
Joel Berger authored November 17, 2012
122  lib/Moodule/Build/Base_TODO.pm
@@ -542,7 +542,6 @@ __PACKAGE__->add_property($_) for qw(
542 542
   release_status
543 543
   script_files
544 544
   scripts
545  
-  share_dir
546 545
   sign
547 546
   test_files
548 547
   xs_files
@@ -2372,56 +2371,6 @@ sub process_support_files {
2372 2371
   }
2373 2372
 }
2374 2373
 
2375  
-sub process_share_dir_files {
2376  
-  my $self = shift;
2377  
-  my $files = $self->_find_share_dir_files;
2378  
-  return unless $files;
2379  
-
2380  
-  # root for all File::ShareDir paths
2381  
-  my $share_prefix = File::Spec->catdir($self->blib, qw/lib auto share/);
2382  
-
2383  
-  # copy all share files to blib
2384  
-  while (my ($file, $dest) = each %$files) {
2385  
-    $self->copy_if_modified(
2386  
-      from => $file, to => File::Spec->catfile( $share_prefix, $dest )
2387  
-    );
2388  
-  }
2389  
-}
2390  
-
2391  
-sub _find_share_dir_files {
2392  
-  my $self = shift;
2393  
-  my $share_dir = $self->share_dir;
2394  
-  return unless $share_dir;
2395  
-
2396  
-  my @file_map;
2397  
-  if ( $share_dir->{dist} ) {
2398  
-    my $prefix = "dist/".$self->dist_name;
2399  
-    push @file_map, $self->_share_dir_map( $prefix, $share_dir->{dist} );
2400  
-  }
2401  
-
2402  
-  if ( $share_dir->{module} ) {
2403  
-    for my $mod ( keys %{ $share_dir->{module} } ) {
2404  
-      (my $altmod = $mod) =~ s{::}{-}g;
2405  
-      my $prefix = "module/$altmod";
2406  
-      push @file_map, $self->_share_dir_map($prefix, $share_dir->{module}{$mod});
2407  
-    }
2408  
-  }
2409  
-
2410  
-  return { @file_map };
2411  
-}
2412  
-
2413  
-sub _share_dir_map {
2414  
-  my ($self, $prefix, $list) = @_;
2415  
-  my %files;
2416  
-  for my $dir ( @$list ) {
2417  
-    for my $f ( @{ $self->rscan_dir( $dir, sub {-f} )} ) {
2418  
-      $f =~ s{\A.*?\Q$dir\E/}{};
2419  
-      $files{"$dir/$f"} = "$prefix/$f";
2420  
-    }
2421  
-  }
2422  
-  return %files;
2423  
-}
2424  
-
2425 2374
 sub process_PL_files {
2426 2375
   my ($self) = @_;
2427 2376
   my $files = $self->find_PL_files;
@@ -3408,7 +3357,7 @@ sub do_create_readme {
3408 3357
 
3409 3358
   my $docfile = $self->_main_docfile;
3410 3359
   unless ( $docfile ) {
3411  
-    $self->log_warn(<<EOF);
  3360
+    $self->log_warn( <<EOF );
3412 3361
 Cannot create README: can't determine which file contains documentation;
3413 3362
 Must supply either 'dist_version_from', or 'module_name' parameter.
3414 3363
 EOF
@@ -3755,62 +3704,6 @@ sub _files_in {
3755 3704
   return @files;
3756 3705
 }
3757 3706
 
3758  
-sub share_dir {
3759  
-  my $self = shift;
3760  
-  my $p = $self->{properties};
3761  
-
3762  
-  $p->{share_dir} = shift if @_;
3763  
-
3764  
-  # Always coerce to proper hash form
3765  
-  if    ( ! defined $p->{share_dir} ) {
3766  
-    return;
3767  
-  }
3768  
-  elsif ( ! ref $p->{share_dir}  ) {
3769  
-    # scalar -- treat as a single 'dist' directory
3770  
-    $p->{share_dir} = { dist => [ $p->{share_dir} ] };
3771  
-  }
3772  
-  elsif ( ref $p->{share_dir} eq 'ARRAY' ) {
3773  
-    # array -- treat as a list of 'dist' directories
3774  
-    $p->{share_dir} = { dist => $p->{share_dir} };
3775  
-  }
3776  
-  elsif ( ref $p->{share_dir} eq 'HASH' ) {
3777  
-    # hash -- check structure
3778  
-    my $share_dir = $p->{share_dir};
3779  
-    # check dist key
3780  
-    if ( defined $share_dir->{dist} ) {
3781  
-      if ( ! ref $share_dir->{dist} ) {
3782  
-        # scalar, so upgrade to arrayref
3783  
-        $share_dir->{dist} = [ $share_dir->{dist} ];
3784  
-      }
3785  
-      elsif ( ref $share_dir->{dist} ne 'ARRAY' ) {
3786  
-        die "'dist' key in 'share_dir' must be scalar or arrayref";
3787  
-      }
3788  
-    }
3789  
-    # check module key
3790  
-    if ( defined $share_dir->{module} ) {
3791  
-      my $mod_hash = $share_dir->{module};
3792  
-      if ( ref $mod_hash eq 'HASH' ) {
3793  
-        for my $k ( keys %$mod_hash ) {
3794  
-          if ( ! ref $mod_hash->{$k} ) {
3795  
-            $mod_hash->{$k} = [ $mod_hash->{$k} ];
3796  
-          }
3797  
-          elsif( ref $mod_hash->{$k} ne 'ARRAY' ) {
3798  
-            die "modules in 'module' key of 'share_dir' must be scalar or arrayref";
3799  
-          }
3800  
-        }
3801  
-      }
3802  
-      else {
3803  
-          die "'module' key in 'share_dir' must be hashref";
3804  
-      }
3805  
-    }
3806  
-  }
3807  
-  else {
3808  
-    die "'share_dir' must be hashref, arrayref or string";
3809  
-  }
3810  
-
3811  
-  return $p->{share_dir};
3812  
-}
3813  
-
3814 3707
 sub script_files {
3815 3708
   my $self = shift;
3816 3709
 
@@ -4701,19 +4594,6 @@ sub depends_on {
4701 4594
   }
4702 4595
 }
4703 4596
 
4704  
-sub rscan_dir {
4705  
-  my ($self, $dir, $pattern) = @_;
4706  
-  my @result;
4707  
-  local $_; # find() can overwrite $_, so protect ourselves
4708  
-  my $subr = !$pattern ? sub {push @result, $File::Find::name} :
4709  
-             !ref($pattern) || (ref $pattern eq 'Regexp') ? sub {push @result, $File::Find::name if /$pattern/} :
4710  
-             ref($pattern) eq 'CODE' ? sub {push @result, $File::Find::name if $pattern->()} :
4711  
-             die "Unknown pattern type";
4712  
-
4713  
-  File::Find::find({wanted => $subr, no_chdir => 1}, $dir);
4714  
-  return \@result;
4715  
-}
4716  
-
4717 4597
 sub autosplit_file {
4718 4598
   my ($self, $file, $to) = @_;
4719 4599
   require AutoSplit;
21  lib/Moodule/Build/Role/RScanDir.pm
... ...
@@ -0,0 +1,21 @@
  1
+package Moodule::Build::Role::RScanDir;
  2
+
  3
+use Moo::Role;
  4
+
  5
+use File::Find ();
  6
+
  7
+sub rscan_dir {
  8
+  my ($self, $dir, $pattern) = @_;
  9
+  my @result;
  10
+  local $_; # find() can overwrite $_, so protect ourselves
  11
+  my $subr = !$pattern ? sub {push @result, $File::Find::name} :
  12
+             !ref($pattern) || (ref $pattern eq 'Regexp') ? sub {push @result, $File::Find::name if /$pattern/} :
  13
+             ref($pattern) eq 'CODE' ? sub {push @result, $File::Find::name if $pattern->()} :
  14
+             die "Unknown pattern type";
  15
+
  16
+  File::Find::find({wanted => $subr, no_chdir => 1}, $dir);
  17
+  return \@result;
  18
+}
  19
+
  20
+1;
  21
+
131  lib/Moodule/Build/Role/ShareDir.pm
... ...
@@ -0,0 +1,131 @@
  1
+package Moodule::Build::Role::ShareDir;
  2
+
  3
+use Moo::Role;
  4
+
  5
+requires qw/rscan_dir blib copy_if_modified dist_name/;
  6
+
  7
+use File::Spec;
  8
+
  9
+my $coerce = sub {
  10
+  my $share_dir = shift;
  11
+
  12
+  # Always coerce to proper hash form
  13
+  if    ( ! defined $share_dir ) {
  14
+    return;
  15
+  }
  16
+  elsif ( ! ref $share_dir ) {
  17
+    # scalar -- treat as a single 'dist' directory
  18
+    return { dist => [ $share_dir ] };
  19
+  }
  20
+  elsif ( ref $share_dir eq 'ARRAY' ) {
  21
+    # array -- treat as a list of 'dist' directories
  22
+    return { dist => $share_dir };
  23
+  }
  24
+  elsif ( ref $share_dir ne 'HASH' ) {
  25
+    return $share_dir; # dies on isa check
  26
+  }
  27
+
  28
+  # hash -- check structure
  29
+  # check dist key
  30
+  if ( defined $share_dir->{dist} ) {
  31
+    if ( ! ref $share_dir->{dist} ) {
  32
+      # scalar, so upgrade to arrayref
  33
+      $share_dir->{dist} = [ $share_dir->{dist} ];
  34
+    }
  35
+  }
  36
+
  37
+  # check module key
  38
+  if ( defined $share_dir->{module} ) {
  39
+    my $mod_hash = $share_dir->{module};
  40
+    if ( ref $mod_hash eq 'HASH' ) {
  41
+      for my $k ( keys %$mod_hash ) {
  42
+        next if ref $mod_hash->{$k};
  43
+        $mod_hash->{$k} = [ $mod_hash->{$k} ];
  44
+      }
  45
+    }
  46
+  }
  47
+
  48
+  return $share_dir;
  49
+};
  50
+
  51
+my $isa = sub {
  52
+  my $share_dir = shift;
  53
+  return if ! defined $share_dir;
  54
+
  55
+  die "'share_dir' must be hashref, arrayref or string"
  56
+    unless ref $share_dir eq 'HASH';
  57
+
  58
+  if ( 
  59
+    defined $share_dir->{dist}
  60
+    && ref $share_dir->{dist} ne 'ARRAY'
  61
+  ) {
  62
+    die "'dist' key in 'share_dir' must be scalar or arrayref";
  63
+  }
  64
+
  65
+  return unless defined ( my $mod_hash = $share_dir->{module} );
  66
+
  67
+  die "'module' key in 'share_dir' must be hashref"
  68
+    unless ref $mod_hash eq 'HASH';
  69
+
  70
+  die "modules in 'module' key of 'share_dir' must be scalar or arrayref"
  71
+    if grep { ref ne 'ARRAY' } values %$mod_hash;
  72
+};
  73
+
  74
+has 'share_dir' => (
  75
+  is => 'rw',
  76
+  coerce => $coerce,
  77
+  isa => $isa,
  78
+);
  79
+
  80
+sub process_share_dir_files {
  81
+  my $self = shift;
  82
+  my $files = $self->_find_share_dir_files;
  83
+  return unless $files;
  84
+
  85
+  # root for all File::ShareDir paths
  86
+  my $share_prefix = File::Spec->catdir($self->blib, qw/lib auto share/);
  87
+
  88
+  # copy all share files to blib
  89
+  while (my ($file, $dest) = each %$files) {
  90
+    $self->copy_if_modified(
  91
+      from => $file, to => File::Spec->catfile( $share_prefix, $dest )
  92
+    );
  93
+  }
  94
+}
  95
+
  96
+sub _find_share_dir_files {
  97
+  my $self = shift;
  98
+  my $share_dir = $self->share_dir;
  99
+  return unless $share_dir;
  100
+
  101
+  my @file_map;
  102
+  if ( $share_dir->{dist} ) {
  103
+    my $prefix = "dist/".$self->dist_name;
  104
+    push @file_map, $self->_share_dir_map( $prefix, $share_dir->{dist} );
  105
+  }
  106
+
  107
+  if ( $share_dir->{module} ) {
  108
+    for my $mod ( keys %{ $share_dir->{module} } ) {
  109
+      (my $altmod = $mod) =~ s{::}{-}g;
  110
+      my $prefix = "module/$altmod";
  111
+      push @file_map, $self->_share_dir_map($prefix, $share_dir->{module}{$mod});
  112
+    }
  113
+  }
  114
+
  115
+  return { @file_map };
  116
+}
  117
+
  118
+sub _share_dir_map {
  119
+  my ($self, $prefix, $list) = @_;
  120
+  my %files;
  121
+  for my $dir ( @$list ) {
  122
+    for my $f ( @{ $self->rscan_dir( $dir, sub {-f} )} ) {
  123
+      $f =~ s{\A.*?\Q$dir\E/}{};
  124
+      $files{"$dir/$f"} = "$prefix/$f";
  125
+    }
  126
+  }
  127
+  return %files;
  128
+}
  129
+
  130
+1;
  131
+
212  t/share_dir.t
... ...
@@ -0,0 +1,212 @@
  1
+use strict;
  2
+use warnings;
  3
+
  4
+use lib 't';
  5
+use MyTestHelper;
  6
+use File::Temp ();
  7
+use Cwd 'getcwd';
  8
+
  9
+my $old = getcwd;
  10
+my $dir = File::Temp->newdir;
  11
+chdir $dir or die "Cannot chdir into $dir";
  12
+
  13
+use Test::More;
  14
+
  15
+{
  16
+  package MyTestClass;
  17
+  use Moo;
  18
+
  19
+  has 'dist_name' => ( is => 'rw', default => sub { 'Simple-Share' } );
  20
+
  21
+  with 'Moodule::Build::Role::RScanDir';
  22
+  with 'Moodule::Build::Role::ShareDir';
  23
+
  24
+  sub blib { 'blib' }
  25
+  sub copy_if_modified { 1 }
  26
+}
  27
+
  28
+my $module = 'Simple::Share';
  29
+
  30
+# Test without a 'share' dir
  31
+
  32
+my $mb = MyTestClass->new;
  33
+is( $mb->share_dir, undef,
  34
+  "default share_dir undef if no 'share' dir exists"
  35
+);
  36
+
  37
+#ok( ! exists $mb->{properties}{requires}{'File::ShareDir'},
  38
+#  "File::ShareDir not added to 'requires'"
  39
+#);
  40
+
  41
+# Add 'share' dir and an 'other' dir and content
  42
+make_file( qw/share foo.txt/, <<'---', {test => 1} );
  43
+This is foo.txt
  44
+---
  45
+make_file( qw/ share subdir share anotherbar.txt /, <<'---', {test => 1} );
  46
+This is anotherbar.txt in a subdir - test for a bug in M::B 0.38 when full path contains 'share/.../*share/...' subdir
  47
+---
  48
+make_file( qw/ share subdir whatever anotherfoo.txt /, <<'---', {test => 1} );
  49
+This is anotherfoo.txt in a subdir - this shoud work on M::B 0.38
  50
+---
  51
+make_file( qw/ other share bar.txt /, <<'---', {test => 1} );
  52
+This is bar.txt
  53
+---
  54
+
  55
+# Check default when share_dir is not given
  56
+$mb = MyTestClass->new;
  57
+is( $mb->share_dir, undef,
  58
+  "Default share_dir is undef even if 'share' exists"
  59
+);
  60
+
  61
+#ok( ! exists $mb->{properties}{requires}{'File::ShareDir'},
  62
+#  "File::ShareDir not added to 'requires'"
  63
+#);
  64
+
  65
+# share_dir set to scalar
  66
+$mb = MyTestClass->new( share_dir => 'share' );
  67
+is_deeply( $mb->share_dir, { dist => [ 'share' ] },
  68
+  "Scalar share_dir set as dist-type share"
  69
+);
  70
+
  71
+# share_dir set to arrayref
  72
+$mb = MyTestClass->new( share_dir => [ 'share' ] );
  73
+is_deeply( $mb->share_dir, { dist => [ 'share' ] },
  74
+  "Scalar share_dir set as dist-type share"
  75
+);
  76
+
  77
+# share_dir set to hashref w scalar
  78
+$mb = MyTestClass->new( share_dir => { dist => 'share' } );
  79
+is_deeply( $mb->share_dir, { dist => [ 'share' ] },
  80
+  "Hashref share_dir w/ scalar dist set as dist-type share"
  81
+);
  82
+
  83
+# share_dir set to hashref w array
  84
+$mb = MyTestClass->new( share_dir => { dist => [ 'share' ] } );
  85
+is_deeply( $mb->share_dir, { dist => [ 'share' ] },
  86
+  "Hashref share_dir w/ arrayref dist set as dist-type share"
  87
+);
  88
+
  89
+# Generate a module sharedir (scalar)
  90
+$mb = MyTestClass->new(
  91
+  share_dir => {
  92
+    dist => 'share',
  93
+    module => { $module =>  'other/share'  },
  94
+  },
  95
+);
  96
+is_deeply( $mb->share_dir,
  97
+  { dist => [ 'share' ],
  98
+    module => { $module => ['other/share']  },
  99
+  },
  100
+  "Hashref share_dir w/ both dist and module shares (scalar-form)"
  101
+);
  102
+
  103
+# Generate a module sharedir (array)
  104
+$mb = MyTestClass->new(
  105
+  share_dir => {
  106
+    dist => [ 'share' ],
  107
+    module => { $module =>  ['other/share']  },
  108
+  },
  109
+);
  110
+is_deeply( $mb->share_dir,
  111
+  { dist => [ 'share' ],
  112
+    module => { $module => ['other/share']  },
  113
+  },
  114
+  "Hashref share_dir w/ both dist and module shares (array-form)"
  115
+);
  116
+
  117
+#--------------------------------------------------------------------------#
  118
+# test constructing to/from mapping
  119
+#--------------------------------------------------------------------------#
  120
+
  121
+is_deeply( $mb->_find_share_dir_files,
  122
+  {
  123
+    "share/foo.txt" => "dist/Simple-Share/foo.txt",
  124
+    "share/subdir/share/anotherbar.txt" => "dist/Simple-Share/subdir/share/anotherbar.txt",
  125
+    "share/subdir/whatever/anotherfoo.txt" => "dist/Simple-Share/subdir/whatever/anotherfoo.txt",
  126
+    "other/share/bar.txt" => "module/Simple-Share/bar.txt",
  127
+  },
  128
+  "share_dir filemap for copying to lib complete"
  129
+);
  130
+
  131
+done_testing;
  132
+chdir $old;
  133
+
  134
+__END__
  135
+
  136
+#--------------------------------------------------------------------------#
  137
+# test moving files to blib
  138
+#--------------------------------------------------------------------------#
  139
+
  140
+$mb->dispatch('build');
  141
+
  142
+ok( -d 'blib', "Build ran and blib exists" );
  143
+ok( -d 'blib/lib/auto/share', "blib/lib/auto/share exists" );
  144
+
  145
+my $share_list = Module::Build->rscan_dir('blib/lib/auto/share', sub {-f});
  146
+
  147
+SKIP:
  148
+{
  149
+
  150
+skip 'filename case not necessarily preserved', 1 if $^O eq 'VMS';
  151
+
  152
+is_deeply(
  153
+  [ sort @$share_list ], [
  154
+    'blib/lib/auto/share/dist/Simple-Share/foo.txt',
  155
+    'blib/lib/auto/share/dist/Simple-Share/subdir/share/anotherbar.txt',
  156
+    'blib/lib/auto/share/dist/Simple-Share/subdir/whatever/anotherfoo.txt',
  157
+    'blib/lib/auto/share/module/Simple-Share/bar.txt',
  158
+  ],
  159
+  "share_dir files copied to blib"
  160
+);
  161
+
  162
+}
  163
+
  164
+#--------------------------------------------------------------------------#
  165
+# test installing
  166
+#--------------------------------------------------------------------------#
  167
+
  168
+my $temp_install = 'temp_install';
  169
+mkdir $temp_install;
  170
+ok( -d $temp_install, "temp install dir created" );
  171
+
  172
+$mb->install_base($temp_install);
  173
+stdout_of( sub { $mb->dispatch('install') } );
  174
+
  175
+$share_list = Module::Build->rscan_dir(
  176
+  "$temp_install/lib/perl5/auto/share", sub {-f}
  177
+);
  178
+
  179
+SKIP:
  180
+{
  181
+
  182
+skip 'filename case not necessarily preserved', 1 if $^O eq 'VMS';
  183
+
  184
+is_deeply(
  185
+  [ sort @$share_list ], [
  186
+    "$temp_install/lib/perl5/auto/share/dist/Simple-Share/foo.txt",
  187
+    "$temp_install/lib/perl5/auto/share/dist/Simple-Share/subdir/share/anotherbar.txt",
  188
+    "$temp_install/lib/perl5/auto/share/dist/Simple-Share/subdir/whatever/anotherfoo.txt",
  189
+    "$temp_install/lib/perl5/auto/share/module/Simple-Share/bar.txt",
  190
+  ],
  191
+  "share_dir files correctly installed"
  192
+);
  193
+
  194
+}
  195
+
  196
+#--------------------------------------------------------------------------#
  197
+# test with File::ShareDir
  198
+#--------------------------------------------------------------------------#
  199
+
  200
+SKIP: {
  201
+  eval { require File::ShareDir; File::ShareDir->VERSION(1.00) };
  202
+  skip "needs File::ShareDir 1.00", 2 if $@;
  203
+
  204
+  unshift @INC, File::Spec->catdir($temp_install, qw/lib perl5/);
  205
+  require Simple::Share;
  206
+
  207
+  eval {File::ShareDir::dist_file('Simple-Share','foo.txt') };
  208
+  is( $@, q{}, "Found shared dist file" );
  209
+
  210
+  eval {File::ShareDir::module_file('Simple::Share','bar.txt') };
  211
+  is( $@, q{}, "Found shared module file" );
  212
+}

0 notes on commit c8a1f78

Please sign in to comment.
Something went wrong with that request. Please try again.