Alt-Acme-Math-XS-CPP
view release on metacpan or search on metacpan
inc/Capture/Tiny.pm view on Meta::CPAN
use strict;
use warnings;
package Capture::Tiny;
# ABSTRACT: Capture STDOUT and STDERR from Perl, XS or external programs
our $VERSION = '0.22'; # VERSION
use Carp ();
use Exporter ();
use IO::Handle ();
use File::Spec ();
use File::Temp qw/tempfile tmpnam/;
use Scalar::Util qw/reftype blessed/;
# Get PerlIO or fake it
BEGIN {
local $@;
eval { require PerlIO; PerlIO->can('get_layers') }
or *PerlIO::get_layers = sub { return () };
}
#--------------------------------------------------------------------------#
# create API subroutines and export them
# [do STDOUT flag, do STDERR flag, do merge flag, do tee flag]
inc/Capture/Tiny.pm view on Meta::CPAN
sub _capture_tee {
# _debug( "# starting _capture_tee with (@_)...\n" );
my ($do_stdout, $do_stderr, $do_merge, $do_tee, $code, @opts) = @_;
my %do = ($do_stdout ? (stdout => 1) : (), $do_stderr ? (stderr => 1) : ());
Carp::confess("Custom capture options must be given as key/value pairs\n")
unless @opts % 2 == 0;
my $stash = { capture => { @opts } };
for ( keys %{$stash->{capture}} ) {
my $fh = $stash->{capture}{$_};
Carp::confess "Custom handle for $_ must be seekable\n"
unless ref($fh) eq 'GLOB' || (blessed($fh) && $fh->isa("IO::Seekable"));
}
# save existing filehandles and setup captures
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)],
inc/ExtUtils/CppGuess.pm view on Meta::CPAN
=cut
use Config ();
use File::Basename qw();
use Capture::Tiny 'capture_merged';
our $VERSION = '0.07';
sub new {
my( $class, %args ) = @_;
my $self = bless {
cc => $Config::Config{cc},
%args
}, $class;
return $self;
}
sub guess_compiler {
my( $self ) = @_;
return $self->{guess} if $self->{guess};
inc/Inline.pm view on Meta::CPAN
}
elsif ($control =~ /^\S+$/ and $control !~ /\n/) {
my $language_id = $control;
my $option = shift || '';
my @config = @_;
my $next = 0;
for (@config) {
next if $next++ % 2;
croak M02_usage() if /[\s\n]/;
}
$o = bless {}, $class;
$o->{INLINE}{version} = $VERSION;
$o->{API}{pkg} = $pkg;
$o->{API}{script} = $script;
$o->{API}{language_id} = $language_id;
if ($option =~ /^(FILE|BELOW)$/i or
not $option and
defined $INC{File::Spec::Unix->catfile('Inline','Files.pm')} and
Inline::Files::get_filename($pkg)
) {
$o->read_inline_file;
inc/Inline.pm view on Meta::CPAN
croak M03_usage_bind()
unless ($language_id =~ /^\S+$/ and $language_id !~ /\n/);
$code = shift or croak M03_usage_bind();
@config = @_;
my $next = 0;
for (@config) {
next if $next++ % 2;
croak M03_usage_bind() if /[\s\n]/;
}
$o = bless {}, $class;
$o->{INLINE}{version} = $VERSION;
$o->{API}{pkg} = $pkg;
$o->{API}{script} = $script;
$o->{API}{language_id} = $language_id;
$o->receive_code($code);
$o->{CONFIG} = handle_language_config(@config);
$o->glue;
}
inc/Inline.pm view on Meta::CPAN
$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);
}
else {
$o->{CONFIG} = {(%{$o->{CONFIG}}, @config)};
}
$o->print_info if $o->{CONFIG}{PRINT_INFO};
unless ($o->{INLINE}{object_ready} or
not length $o->{INLINE}{ILSM_suffix}) {
$o->build();
$o->write_inl_file() unless $o->{CONFIG}{_INSTALL_};
}
if ($o->{INLINE}{ILSM_suffix} ne 'so' and
$o->{INLINE}{ILSM_suffix} ne 'dll' and
$o->{INLINE}{ILSM_suffix} ne 'bundle' and
$o->{INLINE}{ILSM_suffix} ne 'sl' and
ref($o) eq 'Inline'
) {
eval "require $o->{INLINE}{ILSM_module}";
croak M05_error_eval('glue', $@) if $@;
$o->push_overrides;
bless $o, $o->{INLINE}{ILSM_module};
$o->validate(@config);
}
$o->load;
$o->pop_overrides;
}
#==============================================================================
# Set up the USING overrides
#==============================================================================
sub push_overrides {
inc/Inline/CPP/Parser/RecDescent.pm view on Meta::CPAN
# print "Inline::CPP::Parser::RecDescent::typemap(): typename=$typename\n";
my ($TYPEMAP, $INPUT, $OUTPUT);
$TYPEMAP = "$typename *\t\t$TYPEMAP_KIND\n";
$INPUT = <<"END";
if (sv_isobject(\$arg) && (SvTYPE(SvRV(\$arg)) == SVt_PVMG)) {
\$var = (\$type)SvIV((SV*)SvRV( \$arg ));
}
else {
warn ( \\"\${Package}::\$func_name() -- \$var is not a blessed reference\\" );
XSRETURN_UNDEF;
}
END
$OUTPUT = <<"END";
sv_setref_pv( \$arg, CLASS, (void*)\$var );
END
my $ctypename = $typename . ' *';
$parser->{data}{typeconv}{input_expr}{$TYPEMAP_KIND} ||= $INPUT;
$parser->{data}{typeconv}{output_expr}{$TYPEMAP_KIND} ||= $OUTPUT;
inc/Inline/denter.pm view on Meta::CPAN
package Inline::denter;
use strict;
use Carp;
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 {
}
inc/Inline/denter.pm view on Meta::CPAN
$class = $2 || '';
if ($1 eq '%') {
%$obj = $o->_undent_hash;
}
elsif ($1 eq '@') {
@$obj = $o->_undent_array;
}
else {
$$obj = $o->_undent_scalar;
}
bless $obj, $class if length $class;
}
elsif ($o->{content} =~ /^\?\s*$/) {
$obj = $o->_undent_undef;
}
else {
$obj = $o->_undent_value;
}
while (@refs) {
my $ref = pop @refs;
my $copy = $obj;
inc/Parse/RecDescent.pm view on Meta::CPAN
close OUT
or croak("Can't write to new module file '$modulefile'");
}
#endif
package Parse::RecDescent::LineCounter;
sub TIESCALAR # ($classname, \$text, $thisparser, $prevflag)
{
bless {
text => $_[1],
parser => $_[2],
prev => $_[3]?1:0,
}, $_[0];
}
sub FETCH
{
my $parser = $_[0]->{parser};
my $cache = $parser->{linecounter_cache};
inc/Parse/RecDescent.pm view on Meta::CPAN
+ 1;
$parser->{offsetlinenum} += $parser->{lastlinenum} - $apparently;
return 1;
}
package Parse::RecDescent::ColCounter;
sub TIESCALAR # ($classname, \$text, $thisparser, $prevflag)
{
bless {
text => $_[1],
parser => $_[2],
prev => $_[3]?1:0,
}, $_[0];
}
sub FETCH
{
my $parser = $_[0]->{parser};
my $missing = $parser->{fulltextlen}-length(${$_[0]->{text}})-$_[0]->{prev}+1;
inc/Parse/RecDescent.pm view on Meta::CPAN
sub STORE
{
die "Can't set column number via \$thiscolumn\n";
}
package Parse::RecDescent::OffsetCounter;
sub TIESCALAR # ($classname, \$text, $thisparser, $prev)
{
bless {
text => $_[1],
parser => $_[2],
prev => $_[3]?-1:0,
}, $_[0];
}
sub FETCH
{
my $parser = $_[0]->{parser};
return $parser->{fulltextlen}-length(${$_[0]->{text}})+$_[0]->{prev};
inc/Parse/RecDescent.pm view on Meta::CPAN
my $self = $owner->{"rules"}{$name};
if ($replace && !$self->{"changed"})
{
$self->reset;
}
return $self;
}
else
{
return $owner->{"rules"}{$name} =
bless
{
"name" => $name,
"prods" => [],
"calls" => [],
"changed" => 0,
"line" => $line,
"impcount" => 0,
"opcount" => 0,
"vars" => "",
}, $class;
inc/Parse/RecDescent.pm view on Meta::CPAN
sub describe ($;$)
{
return join ' ', map { $_->describe($_[1]) or () } @{$_[0]->{items}};
}
sub new ($$;$$)
{
my ($self, $line, $uncommit, $error) = @_;
my $class = ref($self) || $self;
bless
{
"items" => [],
"uncommit" => $uncommit,
"error" => $error,
"line" => $line,
strcount => 0,
patcount => 0,
dircount => 0,
actcount => 0,
}, $class;
inc/Parse/RecDescent.pm view on Meta::CPAN
package Parse::RecDescent::Action;
sub describe { undef }
sub sethashname { $_[0]->{hashname} = '__ACTION' . ++$_[1]->{actcount} .'__'; }
sub new
{
my $class = ref($_[0]) || $_[0];
bless
{
"code" => $_[1],
"lookahead" => $_[2],
"line" => $_[3],
}, $class;
}
sub issubrule { undef }
sub isterminal { 0 }
inc/Parse/RecDescent.pm view on Meta::CPAN
sub sethashname { $_[0]->{hashname} = '__DIRECTIVE' . ++$_[1]->{dircount} . '__'; }
sub issubrule { undef }
sub isterminal { 0 }
sub describe { $_[1] ? '' : $_[0]->{name} }
sub new ($$$$$)
{
my $class = ref($_[0]) || $_[0];
bless
{
"code" => $_[1],
"lookahead" => $_[2],
"line" => $_[3],
"name" => $_[4],
}, $class;
}
sub code($$$$)
{
inc/Parse/RecDescent.pm view on Meta::CPAN
package Parse::RecDescent::UncondReject;
sub issubrule { undef }
sub isterminal { 0 }
sub describe { $_[1] ? '' : $_[0]->{name} }
sub sethashname { $_[0]->{hashname} = '__DIRECTIVE' . ++$_[1]->{dircount} . '__'; }
sub new ($$$;$)
{
my $class = ref($_[0]) || $_[0];
bless
{
"lookahead" => $_[1],
"line" => $_[2],
"name" => $_[3],
}, $class;
}
# MARK, YOU MAY WANT TO OPTIMIZE THIS.
inc/Parse/RecDescent.pm view on Meta::CPAN
package Parse::RecDescent::Error;
sub issubrule { undef }
sub isterminal { 0 }
sub describe { $_[1] ? '' : $_[0]->{commitonly} ? '<error?:...>' : '<error...>' }
sub sethashname { $_[0]->{hashname} = '__DIRECTIVE' . ++$_[1]->{dircount} . '__'; }
sub new ($$$$$)
{
my $class = ref($_[0]) || $_[0];
bless
{
"msg" => $_[1],
"lookahead" => $_[2],
"commitonly" => $_[3],
"line" => $_[4],
}, $class;
}
sub code($$$$)
{
inc/Parse/RecDescent.pm view on Meta::CPAN
may not be a valid regular expression",
$_[5]);
$@ =~ s/ at \(eval.*/./;
Parse::RecDescent::_hint($@);
}
# QUIETLY PREVENT (WELL-INTENTIONED) CALAMITY
$mod =~ s/[gc]//g;
$pattern =~ s/(\A|[^\\])\\G/$1/g;
bless
{
"pattern" => $pattern,
"ldelim" => $ldel,
"rdelim" => $rdel,
"mod" => $mod,
"lookahead" => $_[4],
"line" => $_[5],
"description" => $desc,
}, $class;
}
inc/Parse/RecDescent.pm view on Meta::CPAN
{
my $class = ref($_[0]) || $_[0];
my $pattern = $_[1];
my $desc = $pattern;
$desc=~s/\\/\\\\/g;
$desc=~s/}/\\}/g;
$desc=~s/{/\\{/g;
bless
{
"pattern" => $pattern,
"lookahead" => $_[2],
"line" => $_[3],
"description" => "'$desc'",
}, $class;
}
sub code($$$$)
inc/Parse/RecDescent.pm view on Meta::CPAN
my $class = ref($_[0]) || $_[0];
my $pattern = $_[1];
$pattern =~ s#/#\\/#g;
my $desc = $pattern;
$desc=~s/\\/\\\\/g;
$desc=~s/}/\\}/g;
$desc=~s/{/\\{/g;
bless
{
"pattern" => $pattern,
"lookahead" => $_[2],
"line" => $_[3],
"description" => "'$desc'",
}, $class;
}
sub code($$$$)
{
inc/Parse/RecDescent.pm view on Meta::CPAN
}
else
{
return $_[1].$_[0]->{"subrule"};
}
}
sub new ($$$$;$$$)
{
my $class = ref($_[0]) || $_[0];
bless
{
"subrule" => $_[1],
"lookahead" => $_[2],
"line" => $_[3],
"implicit" => $_[4] || undef,
"matchrule" => $_[5],
"argcode" => $_[6] || undef,
}, $class;
}
inc/Parse/RecDescent.pm view on Meta::CPAN
sense.",$line);
Parse::RecDescent::_hint("Lookahead for negated optional
repetitions (such as
\"!$subrule($repspec)\" can never
succeed, since optional items always
match (zero times at worst).
Did you mean a single \"!$subrule\",
instead?");
}
}
bless
{
"subrule" => $subrule,
"repspec" => $repspec,
"min" => $min,
"max" => $max,
"lookahead" => $lookahead,
"line" => $line,
"expected" => $desc,
"argcode" => $argcode || undef,
"matchrule" => $matchrule,
inc/Parse/RecDescent.pm view on Meta::CPAN
package Parse::RecDescent::Result;
sub issubrule { 0 }
sub isterminal { 0 }
sub describe { '' }
sub new
{
my ($class, $pos) = @_;
bless {}, $class;
}
sub code($$$$)
{
my ($self, $namespace, $rule) = @_;
'
$return = $item[-1];
';
}
inc/Parse/RecDescent.pm view on Meta::CPAN
sub isterminal { 0 }
sub describe { $_[0]->{"expected"} }
sub sethashname { $_[0]->{hashname} = '__DIRECTIVE' . ++$_[1]->{dircount} . '__'; }
sub new
{
my ($class, $type, $minrep, $maxrep, $leftarg, $op, $rightarg) = @_;
bless
{
"type" => "${type}op",
"leftarg" => $leftarg,
"op" => $op,
"min" => $minrep,
"max" => $maxrep,
"rightarg" => $rightarg,
"expected" => "<${type}op: ".$leftarg->describe." ".$op->describe." ".$rightarg->describe.">",
}, $class;
}
inc/Parse/RecDescent.pm view on Meta::CPAN
';
return $code;
}
package Parse::RecDescent::Expectation;
sub new ($)
{
bless {
"failed" => 0,
"expected" => "",
"unexpected" => "",
"lastexpected" => "",
"lastunexpected" => "",
"defexpected" => $_[1],
};
}
sub is ($$)
inc/Parse/RecDescent.pm view on Meta::CPAN
if ($::RD_AUTOACTION) {
my $sourcecode = $::RD_AUTOACTION;
$sourcecode = "{ $sourcecode }"
unless $sourcecode =~ /\A\s*\{.*\}\s*\Z/;
$self->{_check}{itempos} =
$sourcecode =~ /\@itempos\b|\$itempos\s*\[/;
$self->{_AUTOACTION}
= new Parse::RecDescent::Action($sourcecode,0,-1)
}
bless $self, $class;
return $self->Replace($_[1])
}
sub Compile($$$$) {
die "Compilation of Parse::RecDescent grammars not yet implemented\n";
}
sub DESTROY {
my ($self) = @_;
my $namespace = $self->{namespace};
inc/Parse/RecDescent.pm view on Meta::CPAN
_error("<autotree> directive not at start of grammar", $line);
_hint("The <autotree> directive can only
be specified at the start of a
grammar (before the first rule
is defined.");
}
else
{
undef $self->{_AUTOACTION};
$self->{_AUTOTREE}{NODE}
= new Parse::RecDescent::Action(q({bless \%item, ').$base.q('.$item[0]}),0,-1);
$self->{_AUTOTREE}{TERMINAL}
= new Parse::RecDescent::Action(q({bless {__VALUE__=>$item[1]}, ').$base.q('.$item[0]}),0,-1);
}
}
elsif ($grammar =~ m/$REJECTMK/gco)
{
_parse("an reject marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$item = new Parse::RecDescent::UncondReject($lookahead,$line,"<reject>");
$prod and $prod->additem($item)
or _no_rule("<reject>",$line);
}
( run in 0.982 second using v1.01-cache-2.11-cpan-de7293f3b23 )