view release on metacpan or  search on metacpan

inc/Inline.pm  view on Meta::CPAN

               *language_id, $o->{API}{language_id},
               *installed, $o->{CONFIG}{_INSTALL_},
               *date_compiled, scalar localtime,
               *inline_version, $Inline::VERSION,
               *ILSM, { map {($_, $o->{INLINE}{"ILSM_$_"})}
                        (qw( module suffix type ))
                      },
               *Config, { (map {($_,$Config{$_})}
                           (qw( archname osname osvers
                                cc ccflags ld so version
                              ))),
                          (apiversion => $apiversion),
                        },
              );
    close INL;
}

#==============================================================================
# Get config hints
#==============================================================================
sub with_configs {
    my $o = shift;
    my @configs;
    for my $mod (@{$o->{CONFIG}{WITH}}) {
        my $ref = eval { $mod->Inline($o->{API}{language}); };
        croak M25_no_WITH_support($mod, $@) if $@;
        croak M65_WITH_not_lang($mod, $o->{API}{language}) unless $ref;
        push @configs, %$ref;
    }
    return @configs;
}

#==============================================================================
# Blindly untaint tainted fields in %ENV.
#==============================================================================
sub env_untaint {
    my $o = shift;
        warn "In Inline::env_untaint() : Blindly untainting tainted fields in %ENV.\n" unless $o->{CONFIG}{NO_UNTAINT_WARN};

    {
    no warnings ('uninitialized'); # In case $ENV{$_} is set to undef.
      for (keys %ENV) {
          ($ENV{$_}) = $ENV{$_} =~ /(.*)/;
      }
    }

    # only accept dirs that are absolute and not world-writable
    $ENV{PATH} = $^O eq 'MSWin32' ?
                 join ';', grep {not /^\./ and -d $_
                                  } split /;/, $ENV{PATH}
                 :
                 join ':', grep {/^\// and -d $_ and $< == $> ? 1 : not (-W $_ or -O $_)
                                  } split /:/, $ENV{PATH};

    map {($_) = /(.*)/} @INC;

    # list cherry-picked from `perldoc perlrun`
    delete @ENV{qw(PERL5OPT PERL5SHELL PERL_ROOT IFS CDPATH ENV BASH_ENV)};
    $ENV{SHELL} = '/bin/sh' if -x '/bin/sh';

    $< = $> if $< != $>; # so child processes retain euid - ignore failure
}
#==============================================================================
# Blindly untaint tainted fields in Inline object.
#==============================================================================
sub obj_untaint {
    my $o = shift;
    warn "In Inline::obj_untaint() : Blindly untainting tainted fields in Inline object.\n" unless $o->{CONFIG}{NO_UNTAINT_WARN};
    ($o->{INLINE}{ILSM_module}) = $o->{INLINE}{ILSM_module} =~ /(.*)/;
    ($o->{API}{directory}) = $o->{API}{directory} =~ /(.*)/;
    ($o->{API}{build_dir}) = $o->{API}{build_dir} =~ /(.*)/;
    ($o->{CONFIG}{DIRECTORY}) = $o->{CONFIG}{DIRECTORY} =~ /(.*)/;
    ($o->{API}{install_lib}) = $o->{API}{install_lib} =~ /(.*)/;
    ($o->{API}{modpname}) = $o->{API}{modpname} =~ /(.*)/;
    ($o->{API}{modfname}) = $o->{API}{modfname} =~ /(.*)/;
    ($o->{API}{language}) = $o->{API}{language} =~ /(.*)/;
    ($o->{API}{pkg}) = $o->{API}{pkg} =~ /(.*)/;
    ($o->{API}{module}) = $o->{API}{module} =~ /(.*)/;
}

#==============================================================================
# Clean the build directory from previous builds
#==============================================================================
sub clean_build {
    use strict;
    my ($prefix, $dir);
    my $o = shift;

    $prefix = $o->{INLINE}{DIRECTORY};
    opendir(BUILD, $prefix)
      or croak "Can't open build directory: $prefix for cleanup $!\n";

    while ($dir = readdir(BUILD)) {
        my $maybedir = File::Spec->catdir($prefix,$dir);
        if (($maybedir and -d $maybedir) and ($dir =~ /\w{36,}/)) {
            $o->rmpath($prefix,$dir);
        }
    }

    close BUILD;
}

#==============================================================================
# Apply a list of filters to the source code
#==============================================================================
sub filter {
    my $o = shift;
    my $new_code = $o->{API}{code};
    for (@_) {
        croak M52_invalid_filter($_) unless ref;
        if (ref eq 'CODE') {
            $new_code = $_->($new_code);
        }
        else {
            $new_code = $_->filter($o, $new_code);
        }
    }
    return $new_code;
}

#==============================================================================
# User wants to report a bug
#==============================================================================
sub reportbug {
    use strict;
    my $o = shift;
    return if $o->{INLINE}{reportbug_handled}++;
    print STDERR <<END;
<-----------------------REPORTBUG Section------------------------------------->

REPORTBUG mode in effect.

Your Inline $o->{API}{language_id} code will be processed in the build directory:

  $o->{API}{build_dir}

A perl-readable bug report including your perl configuration and run-time
diagnostics will also be generated in the build directory.

When the program finishes please bundle up the above build directory with:

  tar czf Inline.REPORTBUG.tar.gz $o->{API}{build_dir}

and send "Inline.REPORTBUG.tar.gz" as an email attachment to the author
of the offending Inline::* module with the subject line:

  REPORTBUG: Inline.pm

Include in the email, a description of the problem and anything else that
you think might be helpful. Patches are welcome! :-\)

<-----------------------End of REPORTBUG Section------------------------------>
END
    my %versions;
    {
        no strict 'refs';
        %versions = map {eval "use $_();"; ($_, $ {$_ . '::VERSION'})}
        qw (Digest::MD5 Parse::RecDescent
            ExtUtils::MakeMaker File::Path FindBin
            Inline
           );
    }

    $o->mkpath($o->{API}{build_dir});
    open REPORTBUG, "> ".File::Spec->catfile($o->{API}{build_dir},"REPORTBUG")
      or croak M24_open_for_output_failed
               (File::Spec->catfile($o->{API}{build_dir},"REPORTBUG"));
    %Inline::REPORTBUG_Inline_Object = ();
    %Inline::REPORTBUG_Perl_Config = ();
    %Inline::REPORTBUG_Module_Versions = ();
    print REPORTBUG Inline::denter->new()
      ->indent(*REPORTBUG_Inline_Object, $o,
               *REPORTBUG_Perl_Config, \%Config::Config,
               *REPORTBUG_Module_Versions, \%versions,
              );
    close REPORTBUG;
}

#==============================================================================
# Print a small report if PRINT_INFO option is set.
#==============================================================================
sub print_info {
    use strict;
    my $o = shift;

    print STDERR <<END;
<-----------------------Information Section----------------------------------->

Information about the processing of your Inline $o->{API}{language_id} code:

END

    print STDERR <<END if ($o->{INLINE}{object_ready});
Your module is already compiled. It is located at:
$o->{API}{location}

END

    print STDERR <<END if ($o->{INLINE}{object_ready} and $o->{CONFIG}{FORCE_BUILD});
But the FORCE_BUILD option is set, so your code will be recompiled.
I\'ll use this build directory:
$o->{API}{build_dir}

and I\'ll install the executable as:
$o->{API}{location}

END
    print STDERR <<END if (not $o->{INLINE}{object_ready});
Your source code needs to be compiled. I\'ll use this build directory:
$o->{API}{build_dir}

and I\'ll install the executable as:
$o->{API}{location}

END

    eval {
        print STDERR $o->info;
    };
    print $@ if $@;

    print STDERR <<END;

<-----------------------End of Information Section---------------------------->
END
}

#==============================================================================
# Hand off this invocation to Inline::MakeMaker
#==============================================================================
sub maker_utils {
    require Inline::MakeMaker;
    goto &Inline::MakeMaker::utils;
}

#==============================================================================
# Utility subroutines
#==============================================================================

#==============================================================================
# Make a path
#==============================================================================
sub mkpath {
    use strict;
    my ($o, $mkpath) = @_;
    my($volume,$dirs,$nofile) = File::Spec->splitpath($mkpath,1);
    my @parts = File::Spec->splitdir($dirs);
    my @done;
    foreach (@parts){

inc/Inline.pm  view on Meta::CPAN

END
}

sub M45_usage_with {
    return <<END;
Syntax error detected using 'use Inline with ...'.
Should be specified as:

    use Inline with => 'module1', 'module2', ..., 'moduleN';

END
}

sub M46_usage_with_bad {
    my $mod = shift;
    return <<END;
Syntax error detected using 'use Inline with => "$mod";'.
'$mod' could not be found.

END
}

sub M47_invalid_config_option {
    my ($option) = @_;
    return <<END;
Invalid Config option '$option'

END
#'
}

sub M48_usage_shortcuts {
    my ($shortcut) = @_;
    return <<END;
Invalid shortcut '$shortcut' specified.

Valid shortcuts are:
    VERSION, INFO, FORCE, NOCLEAN, CLEAN, UNTAINT, SAFE, UNSAFE,
    GLOBAL, NOISY and REPORTBUG

END
}

sub M49_usage_unsafe {
    my ($terminate) = @_;
    return <<END .
You are using the Inline.pm module with the UNTAINT and SAFEMODE options,
but without specifying the DIRECTORY option. This is potentially unsafe.
Either use the DIRECTORY option or turn off SAFEMODE.

END
      ($terminate ? <<END : "");
Since you are running as a privileged user, Inline.pm is terminating.

END
}

sub M51_unused_DATA {
    return <<END;
One or more DATA sections were not processed by Inline.

END
}

sub M52_invalid_filter {
    my ($filter) = @_;
    return <<END;
Invalid filter '$filter' is not a reference.

END
}

sub M53_mkdir_failed {
    my ($dir) = @_;
    return <<END;
Couldn't make directory path '$dir'.

END
#'
}

sub M54_rmdir_failed {
    my ($dir) = @_;
    return <<END;
Can't remove directory '$dir':

$!

END
#'
}

sub M55_unlink_failed {
    my ($file) = @_;
    return <<END;
Can't unlink file '$file':

$!

END
#'
}

sub M56_no_DIRECTORY_found {
    return <<END;
Couldn't find an appropriate DIRECTORY for Inline to use.

END
#'
}

sub M57_wrong_architecture {
    my ($ext, $arch, $thisarch) = @_;
    return <<END;
The extension '$ext'
is built for perl on the '$arch' platform.
This is the '$thisarch' platform.

END
}