view release on metacpan or  search on metacpan

inc/Inline/Module.pm  view on Meta::CPAN

    my $include = [
        'Inline',
        'Inline::denter',
        'Inline::Module',
        @$ilsm,
    ];
    if (caller eq 'Module::Build::InlineModule') {
        push @$include, 'Module::Build::InlineModule';
    }
    if (grep /:C$/, @$ilsm) {
        push @$include,
            'Inline::C::Parser::RegExp';
    }
    if (grep /:CPP$/, @$ilsm) {
        push @$include, (
            'Inline::C',
            'Inline::CPP::Config',
            'Inline::CPP::Parser::RecDescent',
            'Parse::RecDescent',
            'ExtUtils::CppGuess',
            'Capture::Tiny',
        );
    }
    return $include;
}

sub add_to_distdir {
    my ($class, $distdir, $stub_modules, $included_modules) = @_;
    DEBUG_ON && DEBUG "$class->add_to_distdir($distdir) [@$stub_modules] [@$included_modules]";
    my $manifest = []; # files created under distdir
    for my $module (@$stub_modules) {
        my $code = $class->dyna_module($module);
        $class->write_module("$distdir/lib", $module, $code);
        $code = $class->proxy_module($module);
        $class->write_module("$distdir/inc", $module, $code);
        $module =~ s!::!/!g;
        push @$manifest, "lib/$module.pm"
            unless -e "lib/$module.pm";
        push @$manifest, "inc/$module.pm";
    }
    for my $module (@$included_modules) {
        my $code = $module eq 'Inline::CPP::Config'
        ? $class->read_share_cpp_config
        : $class->read_local_module($module);
        $class->write_module("$distdir/inc", $module, $code);
        $module =~ s!::!/!g;
        push @$manifest, "inc/$module.pm";
    }

    $class->add_to_manifest($distdir, @$manifest);

    return $manifest; # return a list of the files added
}

sub make_stub_modules {
    my ($class, @modules) = @_;
    DEBUG_ON && DEBUG "$class->make_stub_modules(@modules)";

    for my $module (@modules) {
        my $code = $class->proxy_module($module);
        my $path = $class->write_module('lib', $module, $code, 'onchange');
        if ($path) {
            print "Created stub module '$path' (Inline::Module $VERSION)\n";
        }
    }
}

sub read_local_module {
    my ($class, $module) = @_;
    eval "require $module; 1" or die $@;
    my $file = $module;
    $file =~ s!::!/!g;
    $class->read_file($INC{"$file.pm"});
}

sub read_share_cpp_config {
    my ($class) = @_;
    require File::Share;
    my $dir = File::Share::dist_dir('Inline-Module');
    my $path = File::Spec->catfile($dir, 'CPPConfig.pm');
    $class->read_file($path);
}

sub proxy_module {
    my ($class, $module) = @_;
    DEBUG_ON && DEBUG "$class->proxy_module($module)";

    return <<"...";
# DO NOT EDIT. GENERATED BY: Inline::Module
#
# This module is for author-side development only. When this module is shipped
# to CPAN, it will be automagically replaced with content that does not
# require any Inline framework modules (or any other non-core modules).
#
# To regenerate this stub module, run this command:
#
#   perl -MInline::Module=makestub,$module

use strict; use warnings;
package $module;
use Inline::Module stub => '$API_VERSION';
1;
...
}

sub dyna_module {
    my ($class, $module) = @_;
    DEBUG_ON && DEBUG "$class->dyna_module($module)";
    return <<"...";
# DO NOT EDIT. GENERATED BY: Inline::Module $Inline::Module::VERSION

use strict; use warnings;
package $module;
use base 'DynaLoader';
bootstrap $module;
1;
...

# TODO: Add XS VERSION checking support:
# our \$VERSION = '0.0.5';
# bootstrap $module \$VERSION;
}

sub read_file {
    my ($class, $filepath) = @_;
    DEBUG_ON && DEBUG "$class->read_file($filepath)";
    open IN, '<', $filepath
        or die "Can't open '$filepath' for input:\n$!";
    my $code = do {local $/; <IN>};
    close IN;
    return $code;
}

sub write_module {
    my $class = shift;
    my ($dest, $module, $code, $onchange) = @_;
    DEBUG_ON && DEBUG "$class->write_module($dest, $module, ..., $onchange)";
    $onchange ||= 0;

    $code =~ s/\n+__END__\n.*//s;

    my $filepath = $module;
    $filepath =~ s!::!/!g;
    $filepath = "$dest/$filepath.pm";
    my $dirpath = $filepath;
    $dirpath =~ s!(.*)/.*!$1!;
    File::Path::mkpath($dirpath);

    return if $onchange and
        -e $filepath and
        $class->read_file($filepath) eq $code;

    unlink $filepath;
    open OUT, '>', $filepath
        or die "Can't open '$filepath' for output:\n$!";
    print OUT $code;
    close OUT;

    return $filepath;
}

sub add_to_manifest {
    my ($class, $distdir, @files) = @_;
    DEBUG_ON && DEBUG "$class->add_to_manifest($distdir) (@files)";
    my $manifest = "$distdir/MANIFEST";

    if (-w $manifest) {
        open my $out, '>>', $manifest
            or die "Can't open '$manifest' for append:\n$!";
        for my $file (@files) {
            print $out "$file\n";
        }
        close $out;
    }
}

sub smoke_system_info_dump {
    my ($class, @msg) = @_;
    my $msg = sprintf(@msg);
    chomp $msg;
    require Data::Dumper;
    local $Data::Dumper::Sortkeys = 1;
    local $Data::Dumper::Terse = 1;
    local $Data::Dumper::Indent = 1;

    my @path_files;
    File::Find::find({
        wanted => sub {
            push @path_files, $File::Find::name if -f;
        },
    }, File::Spec->path());
    my $dump = Data::Dumper::Dumper(
        {
            'ENV' => \%ENV,
            'Config' => \%Config::Config,
            'Path Files' => \@path_files,
        },
    );
    Carp::confess <<"..."
Error: $msg

System Data:
$dump

Error: $msg
...
}

1;