#!/usr/bin/env perl
use strict;
use warnings;

use Getopt::Long;
use Carp;
use File::Find;
use File::Spec::Functions qw/catfile catdir splitdir/;
use lib 'inc';

my %args;
@ARGV = '--help' unless @ARGV;

confess "unknown option"
  unless GetOptions( \%args, 'remove-pod', 'squeeze', 'verbose', '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, this will ignore files that match lines in
    file __pod_ignores, which contains a list of regex line by line

squeeze: squeeze lib files. this is done by replace duplicate files by
linking

verbose: show more info to stdout

END
  ;

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> };
            print "removing pod from $File::Find::name\n" if $args{verbose};
            apply( \$content, $_ );
            chmod oct 755, $_;
            open $fh, '>', $_ or return;
            print $fh $content;
            close $fh;
            chmod oct 444 , $_;
        },
        get_install_base() || @ARGV
    );
    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 ) );
                    print "squeeze $another\n" if $args{verbose};
                    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
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;
    }
}

sub get_pod_ignores {
    my @regex;
    if ( open my $fh, '<', '__pod_ignores' ) {
        @regex = <$fh>;
        chomp @regex;
    }
    return grep { /\S/ } @regex;
}