File Coverage

blib/lib/Module/Build/PM_Filter.pm

Criterion	Covered	Total	%
statement	30	89	33.7
branch	0	24	0.0
condition	0	3	0.0
subroutine	10	16	62.5
pod	3	3	100.0
total	43	135	31.8

package Module::Build::PM_Filter;
use base qw(Module::Build);
use strict;
use warnings;
use Carp;
use utf8;
use English qw(-no_match_vars);
use File::Temp;
use File::Path;
use File::Basename qw(dirname);

use version; our $VERSION = qv(1.21);

sub process_pm_files {
    my  $self   =   shift;
    my  $ext    =   shift;

    ### is there a pm_filter file ? ...
    if (not $self->_check_pm_filter_file( q(pm_filter) )) {
        ### dispatch to super method ...
        return $self->SUPER::process_pm_files( $ext );
    }

    ### build the install directory
    my $target_dir = $self->blib;
    if (not -e $target_dir) {
        File::Path::mkpath( $target_dir );
    }

    ### build the method name for finding files according to the extension
    my $method = "find_${ext}_files";

    ### build a hash with module names and targets.
    my $files = $self->can($method) ? $self->$method() :
                $self->_find_file_by_type($ext,  'lib');

    ### only filter and install the module if it's not updated
    while (my ($file, $dest) = each %{ $files }) {
        my $derived = File::Spec->catfile($target_dir, $dest);

        if (not $self->up_to_date( $file, $derived )) {

            ### filter to a temporary file
            my $temp_source = File::Temp->new();
            $self->_do_filter( $file, $temp_source );

            ### and install into the distribution directory
            $self->copy_if_modified( from => $temp_source, to => $derived );
        }
    }

    return;
}

sub process_script_files {
    my  $self   =   shift;

    ### is there a pm_filter file ? ...
    if (not $self->_check_pm_filter_file( q(pm_filter) )) {
        ### dispatch to super method ...
        return $self->SUPER::process_script_files( );
    }

    # find script files
    my  $files  =   $self->find_script_files;

    # do nothing if not files
    return if not keys %{ $files };

    # make the install directory
    my $script_dir = File::Spec->catdir($self->blib, 'script');
    if (not -e $script_dir) {
        File::Path::mkpath( $script_dir );
    }

    # filter every script and make executable
    foreach my $file (keys %{ $files }) {
        # Isn't it already fresh ?
        if (not $self->up_to_date( $file, $script_dir)) {
            my $tmp_from = File::Temp->new();

            # use a temporary file for filter ...
            $self->_do_filter( $file, $tmp_from );
            $self->fix_shebang_line( $tmp_from );
            $self->make_executable( $tmp_from );

            # ... previous to the canonical installation
            $self->copy_if_modified( from => $tmp_from, to_dir => $script_dir );
        }
    }

    return;
}

sub _do_filter {
    my  $self       =   shift;
    my  $source     =   shift;
    my  $target     =   shift;
    my  $cmd        =   sprintf './pm_filter < %s > %s', $source, $target;

    if (not $self->do_system($cmd)) {
        croak "pm_filter failed: ${ERRNO}";
    }

    return;
}

### INTERNAL UTILITY ###
# Usage         : _check_pm_filter_file( $pm_filter_path )
# Purpose       : Check if there is a valid pm_filter
# Returns       : 0 Not valid
#               : 1 Valid
# Parameters    : - File path
# Throws        : no exceptions
# Commments     : none
# See also      : n/a

sub _check_pm_filter_file {
    my  $self       =   shift;
    my  $file       =   shift;

    if (-e $file) {
        if (not -x $file) {
            croak q(pm_filter exists but is not executable);
        }
    }

    return 1;
}

### CLASS METHOD ###
# Usage         : internal use only
# Purpose       : Verify that a pm_filter exists and it's executable in the
#               : distribution directory.
# Returns       : Some of the inherited method
# Parameters    :
# Throws        : no exceptions
# Commments     : none
# See also      : n/a

sub ACTION_distdir {
    my  ($self, @params)  =   @_;

    # dispatch to up
    $self->SUPER::ACTION_distdir(@params);

    # build the distribution path
    my $dir     = $self->dist_dir();

    # verify that the next files are executables ...
    $self->_make_exec( "${dir}/pm_filter"       );
    $self->_make_exec( "${dir}/debian/rules"    );

    return;
}

sub _make_exec {
    my  $self   =   shift;
    my  $file   =   shift;

    # if the file exists and is not executable ...
    if (-e $file and not -x $file) {
        $self->make_executable( $file );
    }

    return;
}

1;
__END__