view release on metacpan or  search on metacpan

inc/Inline.pm  view on Meta::CPAN

    push @dirparts, $file;
    my @endparts = splice(@dirparts, 0 - @pkgparts);

    $dirparts[-1] = 'arch'
      if $dirparts[-2] eq 'blib' && $dirparts[-1] eq 'lib';
    File::Spec->catfile(@endparts) eq $realname
      or croak M28_error_grokking_path($realpath);
    $realpath =
      File::Spec->catpath($volume,File::Spec->catdir(@dirparts),"");

    $o->{API}{version} = $o->{CONFIG}{VERSION};
    $o->{API}{module} = $o->{CONFIG}{NAME};
    my @modparts = split(/::/,$o->{API}{module});
    $o->{API}{modfname} = $modparts[-1];
    $o->{API}{modpname} = File::Spec->catdir(@modparts);

    my $suffix = $Config{dlext};
    my $obj = File::Spec->catfile($realpath,'auto',$o->{API}{modpname},
                                  "$o->{API}{modfname}.$suffix");
    croak M30_error_no_obj($o->{CONFIG}{NAME}, $o->{API}{pkg},
                           $realpath) unless -f $obj;

    @{$o->{CONFIG}}{qw( PRINT_INFO
                        REPORTBUG
                        FORCE_BUILD
                        _INSTALL_
                      )} = (0, 0, 0, 0);

    $o->{install_lib} = $realpath;
    $o->{INLINE}{ILSM_type} = 'compiled';
    $o->{INLINE}{ILSM_module} = 'Inline::C';
    $o->{INLINE}{ILSM_suffix} = $suffix;
    $o->{INLINE}{object_ready} = 1;
}

#==============================================================================
# Dynamically load the object module
#==============================================================================
sub load {
    my $o = shift;

    return if $o->{CONFIG}{_INSTALL_};

    my ($pkg, $module) = @{$o->{API}}{qw(pkg module)};
    croak M42_usage_loader() unless $o->{INLINE}{ILSM_type} eq 'compiled';

    require DynaLoader;
    @Inline::ISA = qw(DynaLoader);

    my $global = $o->{CONFIG}{GLOBAL_LOAD} ? '0x01' : '0x00';
    my $version = $o->{API}{version} || '0.00';

    eval <<END;
        package $pkg;
        push \@$ {pkg}::ISA, qw($module)
          unless \$module eq "$pkg";
        local \$$ {module}::VERSION = '$version';

        package $module;
        push \@$ {module}::ISA, qw(Exporter DynaLoader);
        sub dl_load_flags { $global }
        ${module}::->bootstrap;
END
    croak M43_error_bootstrap($module, $@) if $@;
}

#==============================================================================
# Create file that satisfies the Makefile dependency for this object
#==============================================================================

sub satisfy_makefile_dep {
    my $o = shift;

       my $inline = $o->{API}{modinlname};
       open INLINE, "> $inline"
         or croak M24_open_for_output_failed($inline);
       print INLINE "*** AUTOGENERATED by Inline.pm ***\n\n";
       print INLINE "This file satisfies the make dependency for ";
       print INLINE "$o->{API}{module}\n";
       close INLINE;
       return;
}

#==============================================================================
# Process the config options that apply to all Inline sections
#==============================================================================
sub handle_global_config {
    my $pkg = shift;
    while (@_) {
        my ($key, $value) = (uc shift, shift);
        croak M02_usage() if $key =~ /[\s\n]/;
        if ($key =~ /^(ENABLE|DISABLE)$/) {
            ($key, $value) = (uc $value, $key eq 'ENABLE' ? 1 : 0);
        }
        croak M47_invalid_config_option($key)
          unless defined $default_config->{$key};
        $CONFIG{$pkg}{template}{$key} = $value;
    }
}

#==============================================================================
# Process the config options that apply to a particular language
#==============================================================================
sub handle_language_config {
    my @values;
    while (@_) {
        my ($key, $value) = (uc shift, shift);
        croak M02_usage() if $key =~ /[\s\n]/;
        if ($key eq 'ENABLE') {
            push @values, uc $value, 1;
        }
        elsif ($key eq 'DISABLE') {
            push @values, uc $value, 0;
        }
        else {
            push @values, $key, $value;
        }
    }
    return {@values};
}

inc/Inline.pm  view on Meta::CPAN

      unless $o->{CONFIG}{NAME};
    croak M39_usage_install_version()
      unless $o->{CONFIG}{VERSION};
    croak M40_usage_install_badname($o->{CONFIG}{NAME}, $o->{API}{pkg})
      unless $o->{CONFIG}{NAME} eq $o->{API}{pkg};
#             $o->{CONFIG}{NAME} =~ /^$o->{API}{pkg}::\w(\w|::)+$/
#            );

    my ($mod_name, $mod_ver, $ext_name, $ext_ver) =
      ($o->{API}{pkg}, $ARGV[0], @{$o->{CONFIG}}{qw(NAME VERSION)});
    croak M41_usage_install_version_mismatch($mod_name, $mod_ver,
                                             $ext_name, $ext_ver)
      unless ($mod_ver eq $ext_ver);
    $o->{INLINE}{INST_ARCHLIB} = $ARGV[1];

    $o->{API}{version} = $o->{CONFIG}{VERSION};
    $o->{API}{module} = $o->{CONFIG}{NAME};
    my @modparts = split(/::/,$o->{API}{module});
    $o->{API}{modfname} = $modparts[-1];
    $o->{API}{modpname} = File::Spec->catdir(@modparts);
    $o->{API}{modinlname} = join('-',@modparts).'.inl';
    $o->{API}{suffix} = $o->{INLINE}{ILSM_suffix};
    $o->{API}{build_dir} = File::Spec->catdir($o->{INLINE}{DIRECTORY},'build',
                                              $o->{API}{modpname});
    $o->{API}{directory} = $o->{INLINE}{DIRECTORY};
    my $cwd = Cwd::cwd();
    $o->{API}{install_lib} =
      File::Spec->catdir($cwd,$o->{INLINE}{INST_ARCHLIB});
    $o->{API}{location} =
      File::Spec->catfile($o->{API}{install_lib},"auto",$o->{API}{modpname},
                          "$o->{API}{modfname}.$o->{INLINE}{ILSM_suffix}");
    unshift @::INC, $o->{API}{install_lib};
    $o->{INLINE}{object_ready} = 0;
}

#==============================================================================
# Create the .inl file for an object
#==============================================================================
sub write_inl_file {
    my $o = shift;
    my $inl =
      File::Spec->catfile($o->{API}{install_lib},"auto",$o->{API}{modpname},
                          "$o->{API}{modfname}.inl");
    open INL, "> $inl"
      or croak "Can't create Inline validation file $inl: $!";
    my $apiversion = $Config{apiversion} || $Config{xs_apiversion};
    print INL Inline::denter->new()
      ->indent(*md5, $o->{INLINE}{md5},
               *name, $o->{API}{module},
               *version, $o->{CONFIG}{VERSION},
               *language, $o->{API}{language},
               *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} =~ /(.*)/;