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

[sunnavy at bestpractical.com]

The branch, master has been updated
       via  ef7d6d378912676f138d2b19d208ff66d6e81e48 (commit)
       via  dfb2d07c123d3ec4fb897323f2689c950a2d7e71 (commit)
       via  992cb7d014a2111a30d0f0e7735f7bcba227d209 (commit)
      from  871701550dd54d38bbfb50825ed99095677c5d28 (commit)

Summary of changes:
 share/bin/shipwright-filter |  109 +++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 109 insertions(+), 0 deletions(-)
 create mode 100755 share/bin/shipwright-filter

- Log -----------------------------------------------------------------
commit 992cb7d014a2111a30d0f0e7735f7bcba227d209
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Jul 14 12:45:20 2009 +0800

    added shipwright-filter

diff --git a/share/bin/shipwright-filter b/share/bin/shipwright-filter
new file mode 100644
index 0000000..5b5e858
--- /dev/null
+++ b/share/bin/shipwright-filter
@@ -0,0 +1,90 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Getopt::Long;
+use Carp;
+use File::Find;
+
+my %args;
+
+confess "unknown option"
+  unless GetOptions( \%args, 'remove-pod', 'help' );
+
+my $USAGE = <<'END'
+run: ./bin/shipwright-utility --remove-pod
+
+options: 
+
+help: print this usage
+
+remove-pod: remove .pm files' pod
+
+END
+  ;
+
+if ( $args{'help'} ) {
+    print $USAGE;
+    exit 0;
+}
+if ( $args{'remove-pod'} ) {
+    find(
+        sub {
+            return unless -f && /\.pm$/;
+            open my $fh, '<', $_
+              or return;    # die is not cool: it's just a filter
+            my $content = do { local $/; <$fh> };
+            apply( \$content, $_ );
+            chmod oct 755, $_;
+            open $fh, '>', $_ or return;
+            print $fh $content;
+            close $fh;
+            chmod oct 444 , $_;
+        },
+        get_install_base() || @ARGV
+    );
+}
+
+# this sub is stolen from PAR::Filter::PodStrip
+sub apply {
+    my ( $ref, $filename, $name ) = @_;
+
+    no warnings 'uninitialized';
+
+    my $data = '';
+    $data = $1 if $$ref =~ s/((?:^__DATA__\r?\n).*)//ms;
+
+    my $line = 1;
+    if ( $$ref =~ /^=(?:head\d|pod|begin|item|over|for|back|end|cut)\b/ ) {
+        $$ref = "\n$$ref";
+        $line--;
+    }
+    $$ref =~ s{(
+	(.*?\n)
+	(?:=(?:head\d|pod|begin|item|over|for|back|end)\b
+    .*?\n)
+	(?:=cut[\t ]*[\r\n]*?|\Z)
+	(\r?\n)?
+    )}{
+	my ($pre, $post) = ($2, $3);
+        "$pre#line " . (
+	    $line += ( () = ( $1 =~ /\n/g ) )
+	) . $post;
+    }gsex;
+
+    $$ref =~ s{^=encoding\s+\S+\s*$}{\n}mg;
+    $$ref = '#line 1 "' . ($filename) . "\"\n" . $$ref
+      if length $filename;
+    $$ref =~ s/^#line 1 (.*\n)(#!.*\n)/$2#line 2 $1/g;
+    $$ref .= $data;
+}
+
+sub get_install_base {
+    if ( open my $fh, '<', '__install_base' ) {
+        my $install_base = <$fh>;
+        close $fh;
+        chomp $install_base;
+        return $install_base;
+    }
+}
+

commit dfb2d07c123d3ec4fb897323f2689c950a2d7e71
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Jul 14 16:09:36 2009 +0800

    __pod_ignores to ignore pods we do *not* want to erase

diff --git a/share/bin/shipwright-filter b/share/bin/shipwright-filter
old mode 100644
new mode 100755
index 5b5e858..9ea89a4
--- a/share/bin/shipwright-filter
+++ b/share/bin/shipwright-filter
@@ -27,10 +27,20 @@ if ( $args{'help'} ) {
     print $USAGE;
     exit 0;
 }
+
 if ( $args{'remove-pod'} ) {
+    my @regex = get_pod_ignores();
     find(
         sub {
             return unless -f && /\.pm$/;
+            for my $regex (@regex) {
+                my $return = eval { $File::Find::name =~ /$regex/ };
+                if ( $@ ) {
+                    warn "the regex $regex in __pod_ignores is not so right";
+                }
+                return if $return;
+            }
+
             open my $fh, '<', $_
               or return;    # die is not cool: it's just a filter
             my $content = do { local $/; <$fh> };
@@ -88,3 +98,11 @@ sub get_install_base {
     }
 }
 
+sub get_pod_ignores {
+    my @regex;
+    if ( open my $fh, '<', '__pod_ignores' ) {
+        @regex = <$fh>;
+        chomp @regex;
+    }
+    return grep { /\S/ } @regex;
+}

commit ef7d6d378912676f138d2b19d208ff66d6e81e48
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Jul 14 16:11:19 2009 +0800

    print a msg to tell people it's done

diff --git a/share/bin/shipwright-filter b/share/bin/shipwright-filter
index 9ea89a4..1df1c5f 100755
--- a/share/bin/shipwright-filter
+++ b/share/bin/shipwright-filter
@@ -53,6 +53,7 @@ if ( $args{'remove-pod'} ) {
         },
         get_install_base() || @ARGV
     );
+    print "removing pods finished.\n";
 }
 
 # this sub is stolen from PAR::Filter::PodStrip

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