Alt-Acme-Math-XS-CPP

 view release on metacpan or  search on metacpan

inc/Capture/Tiny.pm  view on Meta::CPAN

sub _relayer {
  my ($fh, $layers) = @_;
  # _debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n");
  my %seen = ( unix => 1, perlio => 1 ); # filter these out
  my @unique = grep { !$seen{$_}++ } @$layers;
  # _debug("# applying unique layers (@unique) to @{[fileno $fh]}\n");
  binmode($fh, join(":", ":raw", @unique));
}

sub _name {
  my $glob = shift;
  no strict 'refs'; ## no critic
  return *{$glob}{NAME};
}

sub _open {
  open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
  # _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
}

sub _close {
  # _debug( "# closing " . ( defined $_[0] ? _name($_[0]) : 'undef' )  . " on " . fileno( $_[0] ) . "\n" );
  close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";

inc/Capture/Tiny.pm  view on Meta::CPAN

  local *CT_ORIG_STDIN  = *STDIN ;
  local *CT_ORIG_STDOUT = *STDOUT;
  local *CT_ORIG_STDERR = *STDERR;
  # find initial layers
  my %layers = (
    stdin   => [PerlIO::get_layers(\*STDIN) ],
    stdout  => [PerlIO::get_layers(\*STDOUT, output => 1)],
    stderr  => [PerlIO::get_layers(\*STDERR, output => 1)],
  );
  # _debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
  # get layers from underlying glob of tied filehandles if we can
  # (this only works for things that work like Tie::StdHandle)
  $layers{stdout} = [PerlIO::get_layers(tied *STDOUT)]
    if tied(*STDOUT) && (reftype tied *STDOUT eq 'GLOB');
  $layers{stderr} = [PerlIO::get_layers(tied *STDERR)]
    if tied(*STDERR) && (reftype tied *STDERR eq 'GLOB');
  # _debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
  # bypass scalar filehandles and tied handles
  # localize scalar STDIN to get a proxy to pick up FD0, then restore later to CT_ORIG_STDIN
  my %localize;
  $localize{stdin}++,  local(*STDIN)

inc/Inline.pm  view on Meta::CPAN

    return unless @_;
    &create_config_file(), return 1 if $_[0] eq '_CONFIG_';
    goto &maker_utils if $_[0] =~ /^(install|makedist|makeppd)$/i;

    my $control = shift;

    if (uc $control eq uc 'with') {
        return handle_with($pkg, @_);
    }
    elsif (uc $control eq uc 'Config') {
        return handle_global_config($pkg, @_);
    }
    elsif (exists $shortcuts{uc($control)}) {
        handle_shortcuts($pkg, $control, @_);
        $version_requested = $CONFIG{$pkg}{template}{PRINT_VERSION};
        return;
    }
    elsif ($control =~ /^\S+$/ and $control !~ /\n/) {
        my $language_id = $control;
        my $option = shift || '';
        my @config = @_;

inc/Inline.pm  view on Meta::CPAN

    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 {

inc/Inline.pm  view on Meta::CPAN

       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;

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

sub undent {
    local $/ = "\n";
    my ($o, $text) = @_;
    my ($comma) = $o->{comma};
    my $package = caller;
    $package = caller(1) if $package eq 'Inline::denter';
    %{$o->{xref}} = ();
    @{$o->{objects}} = ();
    @{$o->{context}} = ();
    my $glob = '';
    chomp $text;
    @{$o->{lines}} = split $/, $text;
    $o->{level} = 0;
    $o->{line} ||= 1;
    $o->_setup_line;
    while (not $o->{done}) {
        if ($o->{level} == 0 and
            $o->{content} =~ /^(\w+)\s*$comma\s*(.*)$/) {
            $o->{content} = $2;
            no strict 'refs';

inc/Parse/RecDescent.pm  view on Meta::CPAN

        # such as:
        #   a: 'ID' | b
        #   b: '(' a ')'
        # Unless these references are broken, the subs stay around on
        # stash deletion below.  Iterate through the stash entries and
        # for each defined code reference, set it to reference sub {}
        # instead.
        {
            local $^W; # avoid 'sub redefined' warnings.
            my $blank_sub = sub {};
            while (my ($name, $glob) = each %{"Parse::RecDescent::$namespace\::"}) {
                *$glob = $blank_sub if defined &$glob;
            }
        }

        # Delete the namespace's stash
        delete $Parse::RecDescent::{$namespace.'::'};
    }
}

# BUILDING A GRAMMAR....

inc/Parse/RecDescent.pm  view on Meta::CPAN

            {
                _parse("a skip marker", $aftererror,$line, $code );
                $code =~ /\A\s*<skip:(.*)>\Z/s;
                if ($rule) {
                    $item = new Parse::RecDescent::Directive(
                        'my $oldskip = $skip; $skip='.$1.'; $oldskip',
                        $lookahead,$line,$code);
                    $prod and $prod->additem($item)
                      or  _no_rule($code,$line);
                } else {
                    #global <skip> directive
                    $self->{skip} = $1;
                }
            }
            elsif ($grammar =~ m/(?=$RULEVARPATMK)/gco
                and do { ($code) = extract_codeblock($grammar,'{',undef,'<');
                     $code;
                       } )
            {
                _parse("a rule variable specifier", $aftererror,$line,$code);
                $code =~ /\A\s*<rulevar:(.*)>\Z/s;