File Coverage

blib/lib/Module/Build/Pluggable/PDL.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Module::Build::Pluggable::PDL;

# ABSTRACT: Plugin to Module::Build to build PDL projets

use strict;
use warnings;
our $VERSION = '0.23';
use parent qw(Module::Build::Pluggable::Base);

use PDL::Core::Dev;
use List::MoreUtils qw(first_index);
use Config;
use Pod::Perldoc;

sub HOOK_build {
    my ($self) = @_;

    $self->add_before_action_modifier( 'distdir', \&HOOK_distdir );
    $self->add_action( 'forcepdlpp', \&ACTION_forcepdlpp );

    $self->process_pd_files;

    return 1;
}

sub HOOK_configure {
    my ($self) = @_;

    $self->_add_include_dirs( PDL::Core::Dev::whereami_any() . '/Core' );

    $self->_add_extra_linker_flags( $PDL::Config{MALLOCDBG}->{libs} )
      if $PDL::Config{MALLOCDBG}->{libs};

    $self->requires( 'PDL' => '2.006' );
    $self->build_requires( 'PDL'                => '2.006' );
    $self->build_requires( 'ExtUtils::CBuilder' => '0.23' );

    return 1;
}

sub _add_include_dirs {
    my ( $self, @dirs ) = @_;

    my $include_dirs = $self->builder->include_dirs;
    push @$include_dirs, @dirs;
    $self->builder->include_dirs($include_dirs);
}

sub _add_extra_linker_flags {
    my ( $self, @new_flags ) = @_;

    my $linker_flags = $self->builder->extra_linker_flags;
    push @$linker_flags, @new_flags;
    $self->builder->extra_linker_flags($linker_flags);
}

# Allow the person installing to force a PDL::PP rebuild
sub ACTION_forcepdlpp {
    my $self = shift;
    warn "self is " . ref $self;
    $self->log_info("Forcing PDL::PP build\n");
    $self->{FORCE_PDL_PP_BUILD} = 1;
    $self->ACTION_build();
}

# largely based on process_PL_files and process_xs_files in M::B::Base
sub process_pd_files {
    my $self    = shift;
    my $builder = $self->builder;

    warn "# process_pd_files\n";

    # Get all the .pd files in lib
    my $files = $builder->rscan_dir( 'lib', qr/\.pd$/ );

    # process each in turn
    for my $file (@$files) {
        my ( $build_prefix, $prefix, $mod_name ) = $self->_filename2info($file);

        $self->_convert_to_pm( $file, $build_prefix, $prefix, $mod_name );

        $self->_add_to_provides( {
            mod_name => $mod_name,
            file     => $file,
            version  => $builder->dist_version
        } );

        $builder->add_to_cleanup( "$build_prefix.pm", "$build_prefix.xs" );

        # Add the newly created .pm and .xs files to the list of such files?
        # No, because the current build process looks for all such files and
        # processes them, and it doesn't create that list until it's actually
        # processing the .pm and .xs files.
    }
}

sub _convert_to_pm {
    my ( $self, $file, $build_prefix, $prefix, $mod_name ) = @_;
    my $builder = $self->builder;

    # see sub run_perl_command (yet undocumented)
    # PDL::PP's import argument are, in order:
    # Module name -> for example, PDL::Graphics::PLplot
    # Package name -> used in package line of the .pm file; for our purposes,
    #     this is identical to Module name.
    # Prefix -> the extensionless file name, PDL/Graphics/PLplot
    #    .pm and .xs extensions will be added to this when the files are
    #    produced, so this should include a lib/ prefix
    # Callpack -> an optional argument used for the XS PACKAGE keyword;
    #    if left blank, it will be identical to the module name
    my $PDL_arg = "-MPDL::PP qw[$mod_name $mod_name $build_prefix]";

    # Both $self->up_to_date and $self->run_perl_command are undocumented
    # so they could change in the future:
    my $up_to_date =
      $builder->up_to_date( $file, [ "$build_prefix.pm", "$build_prefix.xs" ] );

    if ( $builder->{FORCE_PDL_PP_BUILD} or not $up_to_date ) {
        $builder->run_perl_command( [ $PDL_arg, $file ] );
    }
}

sub _add_to_provides {
    my ( $self, $info ) = @_;

    warn "# provides....$info->{file}\n";
    $self->builder->meta_merge(
        'provides',
        {
            $info->{mod_name} =>
              { file => $info->{file}, version => $info->{version} },
        } );
}

sub _filename2info {
    my ( $self, $file ) = @_;

    # Remove the .pd extension to get the build file prefix, which
    # says where the .xs and .pm files should be placed when we run
    # PDL::PP on the .pd file
    ( my $build_prefix = $file ) =~ s/\.[^.]+$//;

    # Figure out the file's lib-less prefix, which tells perl where it
    # will be installed _within_ lib:
    ( my $prefix = $build_prefix ) =~ s|.*lib/||;

    # Build the module name (Surely there's a M::B function for this?)
    ( my $mod_name = $prefix ) =~ s|/|::|g;

    return ( $build_prefix, $prefix, $mod_name );
}

sub HOOK_distdir {
    my ($self) = @_;    # $self is MyModuleBuilder (not MBP::PDL)

    my $files = $self->rscan_dir( 'lib', qr/\.pd$/ );
    for my $file (@$files) {
        ( my $build_prefix = $file ) =~ s{\.pd$}{};
        ( my $prefix       = $build_prefix ) =~ s{/?lib/}{};
        ( my $package      = $build_prefix ) =~ s{/}{::}g;

        # Process .pd into a .pm file with embedded POD
        # perl -MPDL::PP=PDL::Opt::QP,PDL::Opt::QP,lib/PDL/Opt/QP lib/PDL/Opt/QP.pd
        my $cmd = sprintf "%s -MPDL::PP=%s,%s,%s %s",
          $Config{perlpath}, $package, $package, $build_prefix, $file;
        $self->do_system($cmd) or die "Error running PDL::PP : $@";

        # Process .pm into .pod using perldoc as an object
        # && perldoc -u lib/PDL/Opt/QP.pm > lib/PDL/Opt/QP.pod
        my $poddoc =
          Pod::Perldoc->new(
            args => ['-u', '-d', "$build_prefix.pod", "$build_prefix.pm"] );
        $poddoc->process();

        $self->add_to_cleanup("$build_prefix.pod");
    }

    return 1;
}

1;

__END__