Tak
view release on metacpan or search on metacpan
lib/Tak/STDIONode.pm view on Meta::CPAN
) {
$code{$name} = $body;
}
}
foreach my $chunk (@chunks) {
my ($me) = $chunk =~ /^sub.*{\n my \((\$\w+).*\) = \@_;\n/ or next;
my $meq = quotemeta $me;
#warn $meq, $chunk;
my $copy = $chunk;
my ($fixed, $rest);
while ($copy =~ s/^(.*?)${meq}->(\S+)(?=\()//s) {
my ($front, $name) = ($1, $2);
((my $body), $rest) = extract_bracketed($copy, '()');
warn "spotted ${name} - ${body}";
if ($code{$name}) {
warn "replacing";
s/^\(//, s/\)$// for $body;
$body = "${me}, ".$body;
$fixed .= $front.Sub::Quote::inlinify($code{$name}, $body);
} else {
$fixed .= $front.$me.'->'.$name.$body;
}
#warn $fixed; warn $rest;
$copy = $rest;
}
$fixed .= $rest if $fixed;
warn $fixed if $fixed;
$chunk = $fixed if $fixed;
}
print join '', @chunks;
}
1;
METHOD_INLINER
$fatpacked{"Moo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO';
package Moo;
use Moo::_strictures;
use Moo::_Utils;
our $VERSION = '2.000002';
$VERSION = eval $VERSION;
require Moo::sification;
Moo::sification->import;
our %MAKERS;
sub _install_tracked {
my ($target, $name, $code) = @_;
$MAKERS{$target}{exports}{$name} = $code;
_install_coderef "${target}::${name}" => "Moo::${name}" => $code;
}
sub import {
my $target = caller;
my $class = shift;
_set_loaded(caller);
strict->import;
warnings->import;
if ($INC{'Role/Tiny.pm'} and Role::Tiny->is_role($target)) {
die "Cannot import Moo into a role";
}
$MAKERS{$target} ||= {};
_install_tracked $target => extends => sub {
$class->_set_superclasses($target, @_);
$class->_maybe_reset_handlemoose($target);
return;
};
_install_tracked $target => with => sub {
require Moo::Role;
Moo::Role->apply_roles_to_package($target, @_);
$class->_maybe_reset_handlemoose($target);
};
_install_tracked $target => has => sub {
my $name_proto = shift;
my @name_proto = ref $name_proto eq 'ARRAY' ? @$name_proto : $name_proto;
if (@_ % 2 != 0) {
require Carp;
Carp::croak("Invalid options for " . join(', ', map "'$_'", @name_proto)
. " attribute(s): even number of arguments expected, got " . scalar @_)
}
my %spec = @_;
foreach my $name (@name_proto) {
# Note that when multiple attributes specified, each attribute
# needs a separate \%specs hashref
my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec;
$class->_constructor_maker_for($target)
->register_attribute_specs($name, $spec_ref);
$class->_accessor_maker_for($target)
->generate_method($target, $name, $spec_ref);
$class->_maybe_reset_handlemoose($target);
}
return;
};
foreach my $type (qw(before after around)) {
_install_tracked $target => $type => sub {
require Class::Method::Modifiers;
_install_modifier($target, $type, @_);
return;
};
}
return if $MAKERS{$target}{is_class}; # already exported into this package
my $stash = _getstash($target);
my @not_methods = map { *$_{CODE}||() } grep !ref($_), values %$stash;
@{$MAKERS{$target}{not_methods}={}}{@not_methods} = @not_methods;
$MAKERS{$target}{is_class} = 1;
{
no strict 'refs';
@{"${target}::ISA"} = do {
require Moo::Object; ('Moo::Object');
} unless @{"${target}::ISA"};
}
if ($INC{'Moo/HandleMoose.pm'}) {
Moo::HandleMoose::inject_fake_metaclass_for($target);
}
}
lib/Tak/STDIONode.pm view on Meta::CPAN
require Method::Generate::DemolishAll;
Method::Generate::DemolishAll->new
})->generate_method(ref($self)))}(@_);
}
sub does {
return !!0
unless ($INC{'Moose/Role.pm'} || $INC{'Role/Tiny.pm'});
require Moo::Role;
my $does = Moo::Role->can("does_role");
{ no warnings 'redefine'; *does = $does }
goto &$does;
}
# duplicated in Moo::Role
sub meta {
require Moo::HandleMoose::FakeMetaClass;
my $class = ref($_[0])||$_[0];
bless({ name => $class }, 'Moo::HandleMoose::FakeMetaClass');
}
1;
MOO_OBJECT
$fatpacked{"Moo/Role.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO_ROLE';
package Moo::Role;
use Moo::_strictures;
use Moo::_Utils;
use Role::Tiny ();
our @ISA = qw(Role::Tiny);
our $VERSION = '2.000002';
$VERSION = eval $VERSION;
require Moo::sification;
Moo::sification->import;
BEGIN {
*INFO = \%Role::Tiny::INFO;
*APPLIED_TO = \%Role::Tiny::APPLIED_TO;
*ON_ROLE_CREATE = \@Role::Tiny::ON_ROLE_CREATE;
}
our %INFO;
our %APPLIED_TO;
our %APPLY_DEFAULTS;
our @ON_ROLE_CREATE;
sub _install_tracked {
my ($target, $name, $code) = @_;
$INFO{$target}{exports}{$name} = $code;
_install_coderef "${target}::${name}" => "Moo::Role::${name}" => $code;
}
sub import {
my $target = caller;
my ($me) = @_;
_set_loaded(caller);
strict->import;
warnings->import;
if ($Moo::MAKERS{$target} and $Moo::MAKERS{$target}{is_class}) {
die "Cannot import Moo::Role into a Moo class";
}
$INFO{$target} ||= {};
# get symbol table reference
my $stash = _getstash($target);
_install_tracked $target => has => sub {
my $name_proto = shift;
my @name_proto = ref $name_proto eq 'ARRAY' ? @$name_proto : $name_proto;
if (@_ % 2 != 0) {
require Carp;
Carp::croak("Invalid options for " . join(', ', map "'$_'", @name_proto)
. " attribute(s): even number of arguments expected, got " . scalar @_)
}
my %spec = @_;
foreach my $name (@name_proto) {
my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec;
($INFO{$target}{accessor_maker} ||= do {
require Method::Generate::Accessor;
Method::Generate::Accessor->new
})->generate_method($target, $name, $spec_ref);
push @{$INFO{$target}{attributes}||=[]}, $name, $spec_ref;
$me->_maybe_reset_handlemoose($target);
}
};
# install before/after/around subs
foreach my $type (qw(before after around)) {
_install_tracked $target => $type => sub {
require Class::Method::Modifiers;
push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
$me->_maybe_reset_handlemoose($target);
};
}
_install_tracked $target => requires => sub {
push @{$INFO{$target}{requires}||=[]}, @_;
$me->_maybe_reset_handlemoose($target);
};
_install_tracked $target => with => sub {
$me->apply_roles_to_package($target, @_);
$me->_maybe_reset_handlemoose($target);
};
return if $me->is_role($target); # already exported into this package
$INFO{$target}{is_role} = 1;
*{_getglob("${target}::meta")} = $me->can('meta');
# grab all *non-constant* (stash slot is not a scalarref) subs present
# in the symbol table and store their refaddrs (no need to forcibly
# inflate constant subs into real subs) - also add '' to here (this
# is used later) with a map to the coderefs in case of copying or re-use
my @not_methods = ('', map { *$_{CODE}||() } grep !ref($_), values %$stash);
@{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods;
# a role does itself
$APPLIED_TO{$target} = { $target => undef };
$_->($target)
for @ON_ROLE_CREATE;
}
push @ON_ROLE_CREATE, sub {
my $target = shift;
lib/Tak/STDIONode.pm view on Meta::CPAN
sub _name_coderef {
shift if @_ > 2; # three args is (target, name, sub)
can_haz_subutil ? Sub::Util::set_subname(@_) :
can_haz_subname ? Sub::Name::subname(@_) : $_[1];
}
sub _unimport_coderefs {
my ($target, $info) = @_;
return unless $info and my $exports = $info->{exports};
my %rev = reverse %$exports;
my $stash = _getstash($target);
foreach my $name (keys %$exports) {
if ($stash->{$name} and defined(&{$stash->{$name}})) {
if ($rev{$target->can($name)}) {
my $old = delete $stash->{$name};
my $full_name = join('::',$target,$name);
# Copy everything except the code slot back into place (e.g. $has)
foreach my $type (qw(SCALAR HASH ARRAY IO)) {
next unless defined(*{$old}{$type});
no strict 'refs';
*$full_name = *{$old}{$type};
}
}
}
}
}
if ($Config{useithreads}) {
require Moo::HandleMoose::_TypeMap;
}
1;
MOO__UTILS
$fatpacked{"Moo/_mro.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO__MRO';
package Moo::_mro;
use Moo::_strictures;
if ($] >= 5.010) {
require mro;
} else {
require MRO::Compat;
}
1;
MOO__MRO
$fatpacked{"Moo/_strictures.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO__STRICTURES';
package Moo::_strictures;
use strict;
use warnings;
sub import {
if ($ENV{MOO_FATAL_WARNINGS}) {
require strictures;
strictures->VERSION(2);
@_ = ('strictures');
goto &strictures::import;
}
else {
strict->import;
warnings->import;
}
}
1;
MOO__STRICTURES
$fatpacked{"Moo/sification.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO_SIFICATION';
package Moo::sification;
use Moo::_strictures;
no warnings 'once';
use Devel::GlobalDestruction qw(in_global_destruction);
sub unimport {
die "Can't disable Moo::sification after inflation has been done"
if $Moo::HandleMoose::SETUP_DONE;
our $disabled = 1;
}
sub Moo::HandleMoose::AuthorityHack::DESTROY {
unless (our $disabled or in_global_destruction) {
require Moo::HandleMoose;
Moo::HandleMoose->import;
}
}
sub import {
return
if our $setup_done;
if ($INC{"Moose.pm"}) {
require Moo::HandleMoose;
Moo::HandleMoose->import;
} else {
$Moose::AUTHORITY = bless({}, 'Moo::HandleMoose::AuthorityHack');
}
$setup_done = 1;
}
1;
MOO_SIFICATION
$fatpacked{"Sub/Defer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SUB_DEFER';
package Sub::Defer;
use Moo::_strictures;
use Exporter qw(import);
use Moo::_Utils qw(_getglob _install_coderef);
use Scalar::Util qw(weaken);
our $VERSION = '2.000002';
$VERSION = eval $VERSION;
our @EXPORT = qw(defer_sub undefer_sub undefer_all);
our @EXPORT_OK = qw(undefer_package);
our %DEFERRED;
sub undefer_sub {
my ($deferred) = @_;
lib/Tak/STDIONode.pm view on Meta::CPAN
semicolon
taint
threads
uninitialized
umask
unpack
untie
utf8
non_unicode
nonchar
surrogate
void
void_unusual
y2k
);
sub VERSION {
{
no warnings;
local $@;
if (defined $_[1] && eval { &UNIVERSAL::VERSION; 1}) {
$^H |= 0x20000
unless _PERL_LT_5_8_4;
$^H{strictures_enable} = int $_[1];
}
}
_CAN_GOTO_VERSION ? goto &UNIVERSAL::VERSION : &UNIVERSAL::VERSION;
}
our %extra_load_states;
our $Smells_Like_VCS;
sub import {
my $class = shift;
my %opts = ref $_[0] ? %{$_[0]} : @_;
if (!exists $opts{version}) {
$opts{version}
= exists $^H{strictures_enable} ? delete $^H{strictures_enable}
: int $VERSION;
}
$opts{file} = (caller)[1];
$class->_enable(\%opts);
}
sub _enable {
my ($class, $opts) = @_;
my $version = $opts->{version};
$version = 'undef'
if !defined $version;
my $method = "_enable_$version";
if (!$class->can($method)) {
require Carp;
Carp::croak("Major version specified as $version - not supported!");
}
$class->$method($opts);
}
sub _enable_1 {
my ($class, $opts) = @_;
strict->import;
warnings->import(FATAL => 'all');
if (_want_extra($opts->{file})) {
_load_extras(qw(indirect multidimensional bareword::filehandles));
indirect->unimport(':fatal')
if $extra_load_states{indirect};
multidimensional->unimport
if $extra_load_states{multidimensional};
bareword::filehandles->unimport
if $extra_load_states{'bareword::filehandles'};
}
}
our @V2_NONFATAL = grep { exists $warnings::Offsets{$_} } (
'exec', # not safe to catch
'recursion', # will be caught by other mechanisms
'internal', # not safe to catch
'malloc', # not safe to catch
'newline', # stat on nonexistent file with a newline in it
'experimental', # no reason for these to be fatal
'deprecated', # unfortunately can't make these fatal
'portable', # everything worked fine here, just may not elsewhere
);
our @V2_DISABLE = grep { exists $warnings::Offsets{$_} } (
'once' # triggers inconsistently, can't be fatalized
);
sub _enable_2 {
my ($class, $opts) = @_;
strict->import;
warnings->import;
warnings->import(FATAL => @WARNING_CATEGORIES);
warnings->unimport(FATAL => @V2_NONFATAL);
warnings->import(@V2_NONFATAL);
warnings->unimport(@V2_DISABLE);
if (_want_extra($opts->{file})) {
_load_extras(qw(indirect multidimensional bareword::filehandles));
indirect->unimport(':fatal')
if $extra_load_states{indirect};
multidimensional->unimport
if $extra_load_states{multidimensional};
bareword::filehandles->unimport
if $extra_load_states{'bareword::filehandles'};
}
}
sub _want_extra_env {
if (exists $ENV{PERL_STRICTURES_EXTRA}) {
if (_PERL_LT_5_8_4 and $ENV{PERL_STRICTURES_EXTRA}) {
die 'PERL_STRICTURES_EXTRA checks are not available on perls older'
. "than 5.8.4: please unset \$ENV{PERL_STRICTURES_EXTRA}\n";
}
return $ENV{PERL_STRICTURES_EXTRA} ? 1 : 0;
}
return undef;
}
sub _want_extra {
my $file = shift;
my $want_env = _want_extra_env();
return $want_env
if defined $want_env;
return (
!_PERL_LT_5_8_4
and $file =~ /^(?:t|xt|lib|blib)[\\\/]/
and defined $Smells_Like_VCS ? $Smells_Like_VCS
: ( $Smells_Like_VCS = !!(
-e '.git' || -e '.svn' || -e '.hg'
|| (-e '../../dist.ini'
&& (-e '../../.git' || -e '../../.svn' || -e '../../.hg' ))
))
);
}
sub _load_extras {
my @extras = @_;
my @failed;
foreach my $mod (@extras) {
next
if exists $extra_load_states{$mod};
$extra_load_states{$mod} = eval "require $mod; 1;" or do {
push @failed, $mod;
#work around 5.8 require bug
(my $file = $mod) =~ s|::|/|g;
delete $INC{"${file}.pm"};
};
}
( run in 2.743 seconds using v1.01-cache-2.11-cpan-5837b0d9d2c )