App-PerlXLock

 view release on metacpan or  search on metacpan

inc/Inline.pm  view on Meta::CPAN

use Cwd qw(abs_path cwd);
use File::Spec;
use File::Spec::Unix;
use Fcntl qw(LOCK_EX LOCK_UN);

my %CONFIG = ();
my @DATA_OBJS = ();
my $INIT = 0;
my $version_requested = 0;
my $version_printed = 0;
my $untaint = 0;
my $safemode = 0;

our $languages = undef;

our $did = '_Inline'; # Default Inline Directory

# This is the config file written by create_config_file().
our $configuration_file = 'config-' . $Config::Config{'archname'} . '-' . $];

my %shortcuts =

inc/Inline.pm  view on Meta::CPAN

   REWRITE_CONFIG_FILE => 0,
   SAFEMODE => -1,
   GLOBAL_LOAD => 0,
   BUILD_NOISY => 0,
   BUILD_TIMERS => 0,
   WARNINGS => 1,
   _INSTALL_ => 0,
   _TESTING => 0,
  };

sub UNTAINT {$untaint}
sub SAFEMODE {$safemode}

#==============================================================================
# This is where everything starts.
#==============================================================================
sub import {
    my $class = shift;
    $class->import_heavy(@_);
}

inc/Inline.pm  view on Meta::CPAN

    my $o = shift;
    my ($pkg, $language_id) = @{$o->{API}}{qw(pkg language_id)};
    my @config = (%{$CONFIG{$pkg}{template}},
                  %{$CONFIG{$pkg}{$language_id} || {}},
                  %{$o->{CONFIG} || {}},
                 );
    @config = $o->check_config(@config);
    $o->fold_options;

    $o->check_installed;
    $o->env_untaint if UNTAINT;
    if (not $o->{INLINE}{object_ready}) {
        $o->check_config_file;                # Final DIRECTORY set here.
        push @config, $o->with_configs;
        my $language = $o->{API}{language};
        croak M04_error_nocode($language_id) unless $o->{API}{code};
        $o->check_module;
    }
    $o->env_untaint if UNTAINT;
    $o->obj_untaint if UNTAINT;
    print_version() if $version_requested;
    $o->reportbug() if $o->{CONFIG}{REPORTBUG};
    if (not $o->{INLINE}{object_ready}
        or $o->{CONFIG}{PRINT_INFO}
       ) {
        eval "require $o->{INLINE}{ILSM_module}";
        croak M05_error_eval('glue', $@) if $@;
        $o->push_overrides;
        bless $o, $o->{INLINE}{ILSM_module};
        $o->validate(@config);

inc/Inline.pm  view on Meta::CPAN

# reason that I've commented it out. I've left it here (including its associated comments)
# in case it later becomes evident that there *is* good reason to include it. --sisyphus
#
## This bit tries to enable UNTAINT automatically if required when running the test suite.
#    my $env_ha = $ENV{HARNESS_ACTIVE} || 0 ;
#    my ($harness_active) = $env_ha =~ /(.*)/ ;
#    if (($harness_active)&&(! $o->{CONFIG}{UNTAINT})){
#            eval {
#                    require Scalar::Util;
#                    $o->{CONFIG}{UNTAINT} =
#                      (Scalar::Util::tainted(Cwd::cwd()) ? 1 : 0) ;
## Disable SAFEMODE in the test suite, we know what we are doing...
#                    $o->{CONFIG}{SAFEMODE} = 0 ;
#                    warn "\n-[tT] enabled for test suite.
#Automatically setting UNTAINT=1 and SAFEMODE=0.\n"
#                     unless $Inline::_TAINT_WARNING_ ;
#                    $Inline::_TAINT_WARNING_ = 1 ;
#            } ;
#   }
##
    $untaint = $o->{CONFIG}{UNTAINT} || 0;
    $safemode = (($o->{CONFIG}{SAFEMODE} == -1) ?
                 ($untaint ? 1 : 0) :
                 $o->{CONFIG}{SAFEMODE}
                );
    if (UNTAINT and
        SAFEMODE and
        not $o->{CONFIG}{DIRECTORY}) {
        croak M49_usage_unsafe(1) if ($< == 0 or $> == 0);
        warn M49_usage_unsafe(0) if $^W;
    }
    if ($o->{CONFIG}{AUTONAME} == -1) {
        $o->{CONFIG}{AUTONAME} = length($o->{CONFIG}{NAME}) ? 0 : 1;

inc/Inline.pm  view on Meta::CPAN

           my $config = join '', <CONFIG>;
           flock(CONFIG, LOCK_UN) if $^O !~ /^VMS|riscos|VOS$/;
           close CONFIG;

           unless($config =~ /^version :/) {
             warn "\$load_cfg sub: \$config: *${config}*\n";
             croak M62_invalid_config_file(File::Spec->catfile($DIRECTORY,$configuration_file));
           }

           if(UNTAINT) {
             warn "In Inline::check_config_file(): Blindly untainting Inline configuration file information.\n"
               unless $o->{CONFIG}{NO_UNTAINT_WARN};
             ($config) = $config =~ /(.*)/s;
           }

           %config = Inline::denter->new()->undent($config);
       } ;

       $load_cfg->() ;
       if (! defined $config{languages}->{$o->{API}{language_id}}){
        my $unlink = unlink(File::Spec->catfile($DIRECTORY, $configuration_file));

inc/Inline.pm  view on Meta::CPAN

    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' ?

inc/Inline.pm  view on Meta::CPAN

    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} =~ /(.*)/;

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

sub new {
    my $class = shift;
    bless {width => 4,
           comma => " : ",
           level => 0,
           tabwidth => 8,
          }, $class;
}

# Prevent a taint exception being thrown by AutoLoader.pm.
# Serves no other purpose.
sub DESTROY {
}

sub undent {
    local $/ = "\n";
    my ($o, $text) = @_;
    my ($comma) = $o->{comma};
    my $package = caller;
    $package = caller(1) if $package eq 'Inline::denter';