Alt-Acme-Math-XS-CPP

 view release on metacpan or  search on metacpan

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

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
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

298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
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

520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
    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

557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
       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

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
 
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

1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
        # 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

2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
{
    _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;