[Bps-public-commit] Shipwright branch, master, updated. 18e9a9490e31ac8afabd97607c143d27284492b4

[sunnavy at bestpractical.com]

The branch, master has been updated
       via  18e9a9490e31ac8afabd97607c143d27284492b4 (commit)
       via  26bc454e2f5fa8ff0134ac7b5bf10d11dd68de6c (commit)
      from  818410801983fe8caa8546c448e1b1a52bdcc429 (commit)

Summary of changes:
 Makefile.PL                    |    1 +
 lib/Shipwright/Backend/Base.pm |   11 +++++++++
 share/bin/shipwright-filter    |   47 ++++++++++++++++++++++++++++++++++++++-
 3 files changed, 57 insertions(+), 2 deletions(-)

- Log -----------------------------------------------------------------
commit 26bc454e2f5fa8ff0134ac7b5bf10d11dd68de6c
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Thu Jul 23 17:11:36 2009 +0800

    added --squeeze arg for shipwright-filter

diff --git a/Makefile.PL b/Makefile.PL
index 2b63830..668c885 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -32,6 +32,7 @@ requires 'IO::Uncompress::Bunzip2' => 0;
 requires 'IO::Uncompress::RawInflate' => '2.012';
 requires 'Archive::Tar' => 0;
 requires 'Archive::Extract' => 0;
+requires 'File::Compare' => 0;
 
 
 if ( can_cc() ) {
diff --git a/lib/Shipwright/Backend/Base.pm b/lib/Shipwright/Backend/Base.pm
index 9f7f055..4711225 100644
--- a/lib/Shipwright/Backend/Base.pm
+++ b/lib/Shipwright/Backend/Base.pm
@@ -67,6 +67,7 @@ sub initialize {
     $self->_install_yaml_tiny($dir);
     $self->_install_clean_inc($dir);
     $self->_install_module_build($dir);
+    $self->_install_file_compare($dir);
 
     # set proper permissions for yml under /shipwright/
     my $sw_dir = catdir( $dir, 'shipwright' );
@@ -131,6 +132,16 @@ sub _install_clean_inc {
     }
 }
 
+sub _install_file_compare {
+    my $self = shift;
+    my $dir = shift;
+
+    my $path = catdir( $dir, 'inc', 'File' );
+    mkpath $path;
+    copy( Module::Info->new_from_module('File::Compare')->file, $path )
+      or confess "copy File/Compare.pm failed: $!";
+}
+
 =item import
 
 import a dist.
diff --git a/share/bin/shipwright-filter b/share/bin/shipwright-filter
index ec11c4f..4288fdd 100755
--- a/share/bin/shipwright-filter
+++ b/share/bin/shipwright-filter
@@ -5,20 +5,25 @@ use warnings;
 use Getopt::Long;
 use Carp;
 use File::Find;
+use File::Spec::Functions qw/catfile catdir splitdir/;
+use lib 'inc';
 
 my %args;
 
 confess "unknown option"
-  unless GetOptions( \%args, 'remove-pod', 'help' );
+  unless GetOptions( \%args, 'remove-pod', 'squeeze', 'help' );
 
 my $USAGE = <<'END'
 run: ./bin/shipwright-filter --remove-pod
+run: ./bin/shipwright-filter --squeeze
 
 options: 
 
 help: print this usage
 
 remove-pod: remove .pm files' pod
+squeeze: squeeze lib files. this is done by replace duplicate files by
+linking
 
 END
   ;
@@ -53,7 +58,42 @@ if ( $args{'remove-pod'} ) {
         },
         get_install_base() || @ARGV
     );
-    print "removing pods finished.\n";
+    print "removing pod finished.\n";
+}
+elsif ( $args{'squeeze'} ) {
+    my $as_dir = catdir( get_install_base(), 'as' );
+    my $dh;
+    opendir $dh, $as_dir or die $!;
+    my @as = grep { $_ !~ /^\.\.?$/ } readdir $dh;
+    if ( @as >= 1 ) {
+        require File::Compare
+          or die "can't require File::Compare, you need to install this module";
+
+        my $first_as = shift @as;
+        my $sub = sub {
+            my $name = $File::Find::name;
+            return unless -f $name;
+            my $name_under_lib = $name;
+            $name_under_lib =~ s!\Q$as_dir\E[/\\]\Q$first_as\E[/\\]lib[/\\]!!;
+            for my $as ( @as ) {
+                my $another = $name;
+                $another =~ s!(?<=\Q$as_dir\E[/\\])\Q$first_as\E!$as!;
+                # compare return 0 to indicate the two files are equal
+                unless ( File::Compare::compare( $name, $another ) ) {
+                    my $depth = scalar( splitdir($File::Find::dir) ) -
+                        scalar( splitdir( $as_dir ) );
+                    unlink $another;
+                    link catfile( ('..') x $depth,
+                        $first_as, 'lib', $name_under_lib ),
+                      $another;
+                }
+            }
+        };
+        find( $sub, catdir( $as_dir, $first_as, 'lib' ) );
+    }
+
+
+    print "sequeeze finished.\n";
 }
 
 # this sub is stolen from PAR::Filter::PodStrip

commit 18e9a9490e31ac8afabd97607c143d27284492b4
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Thu Jul 23 17:12:10 2009 +0800

    added --verbose arg for shipwright-filter

diff --git a/share/bin/shipwright-filter b/share/bin/shipwright-filter
index 4288fdd..32a60a0 100755
--- a/share/bin/shipwright-filter
+++ b/share/bin/shipwright-filter
@@ -11,7 +11,7 @@ use lib 'inc';
 my %args;
 
 confess "unknown option"
-  unless GetOptions( \%args, 'remove-pod', 'squeeze', 'help' );
+  unless GetOptions( \%args, 'remove-pod', 'squeeze', 'verbose', 'help' );
 
 my $USAGE = <<'END'
 run: ./bin/shipwright-filter --remove-pod
@@ -24,6 +24,7 @@ help: print this usage
 remove-pod: remove .pm files' pod
 squeeze: squeeze lib files. this is done by replace duplicate files by
 linking
+verbose: show more info to stdout
 
 END
   ;
@@ -49,6 +50,7 @@ if ( $args{'remove-pod'} ) {
             open my $fh, '<', $_
               or return;    # die is not cool: it's just a filter
             my $content = do { local $/; <$fh> };
+            print "removing pod from $File::Find::name\n" if $args{verbose};
             apply( \$content, $_ );
             chmod oct 755, $_;
             open $fh, '>', $_ or return;
@@ -82,6 +84,7 @@ elsif ( $args{'squeeze'} ) {
                 unless ( File::Compare::compare( $name, $another ) ) {
                     my $depth = scalar( splitdir($File::Find::dir) ) -
                         scalar( splitdir( $as_dir ) );
+                    print "squeeze $another\n" if $args{verbose};
                     unlink $another;
                     link catfile( ('..') x $depth,
                         $first_as, 'lib', $name_under_lib ),

-----------------------------------------------------------------------