view release on metacpan or  search on metacpan

lib/STD.pm  view on Meta::CPAN

return scalar do { # work around #38809
my $self = shift;
my %args = @_;
last unless exists $args{codes};
my $codes = exists $args{codes} ? delete $args{codes} : undef;
$::RX{'codes'} = $codes;
$self;
};
}
{
local @_ = @_;
return scalar do { # work around #38809
my $self = shift;
my %args = @_;
last unless exists $args{graphs};
my $graphs = exists $args{graphs} ? delete $args{graphs} : undef;
$::RX{'graphs'} = $graphs;
$self;
};
}
{
local @_ = @_;
return scalar do { # work around #38809
my $self = shift;
my %args = @_;
last unless exists $args{chars};
my $chars = exists $args{chars} ? delete $args{chars} : undef;
$::RX{'chars'} = $chars;
$self;
};
}
{
local @_ = @_;
return scalar do { # work around #38809
my $self = shift;
my %args = @_;
last unless exists $args{rw};
my $rw = exists $args{rw} ? delete $args{rw} : undef;
$::RX{'rw'} = $rw;
$self;
};
}
$orig->(@_);
};

1; };
## method require_P5
sub require_P5 {
no warnings 'recursion';
my $self = shift;
require STD_P5;
$self;
};
## method require_P6
sub require_P6 {
no warnings 'recursion';
my $self = shift;
require STD_P6;
$self;
};
## method newlex ($needsig = 0)
sub newlex {
no warnings 'recursion';
my $self = shift;
my $needsig = @_ ? shift() : 0;
my $oid = $::CURLEX->id;
$ALL->{$oid} == $::CURLEX or die "internal error: current lex id is invalid";
my $line = $self->lineof($self->{'_pos'});
my $id;
if ($::NEWLEX) {
$::NEWLEX->{'OUTER::'} = $::CURLEX->idref;
$::CURLEX = $::NEWLEX;
$::NEWLEX = 0;
$id = $::CURLEX->id;
}
else {
$id = 'MY:file<' . $::FILE->{'name'} . '>:line(' . $line . '):pos(' . $self->{'_pos'} . ')';
$::CURLEX = Stash->new(
'OUTER::' => [$oid],
'!file' => $::FILE, '!line' => $line,
'!id' => [$id],
);
};
$::CURLEX->{'!NEEDSIG'} = 1 if $needsig;
$::CURLEX->{'!IN_DECL'} = $::IN_DECL if $::IN_DECL;
$ALL->{$id} = $::CURLEX;
$self->{'LEX'} = $::CURLEX;
$::DECLARAND->{'curlex'} = $::CURLEX if $::DECLARAND;
$self;
};
## method finishlex
sub finishlex {
no warnings 'recursion';
my $self = shift;
my $line = $self->lineof($self->{'_pos'});
$::CURLEX->{'$_'} //= NAME->new( name => '$_', file => $::FILE, line => $line, dynamic => 1, scope => 'my' );
$::CURLEX->{'$/'} //= NAME->new( name => '$/', file => $::FILE, line => $line, dynamic => 1, scope => 'my' );
$::CURLEX->{'$!'} //= NAME->new( name => '$!', file => $::FILE, line => $line, dynamic => 1, scope => 'my' );
$::SIGNUM = 0;
$self;
};
## method getsig
sub getsig {
no warnings 'recursion';
my $self = shift;
my $pv = $::CURLEX->{'%?PLACEHOLDERS'};
my $sig;
if (delete $::CURLEX->{'!NEEDSIG'}) {
if ($pv) {
my $h_ = delete $pv->{'%_'};
my $a_ = delete $pv->{'@_'};
$sig = join ', ', sort {
substr($a,1) cmp substr($b,1) }  keys %$pv;
$sig .= ', *@_' if $a_;
$sig .= ', *%_' if $h_;
}
else {
$sig = '$_ is ref = OUTER::<$_>'};
$::CURLEX->{'$?SIGNATURE'} = $sig;
}
else {
$sig = $::CURLEX->{'$?SIGNATURE'}};
$self->{'sig'} = $self->makestr(TEXT => $sig);
$self->{'lex'} = $::CURLEX->idref;
if (($::DECLARAND->{'mult'}//'') ne 'proto') {
for (keys %$::CURLEX) {
my $desc = $::CURLEX->{$_};
next unless $_ =~ m/(\$|\@|\%|\&)\w/;
next if $_ eq '$_' or $_ eq '@_' or $_ eq '%_';
next if $desc->{'used'};
next if $desc->{'rebind'};
next if $desc->{'dynamic'};
next if $desc->{'scope'} eq 'state';
next if $desc->{'stub'};
my $pos = $desc->{'declaredat'} // $self->{'_pos'};
$self->cursor($pos)->worry("$_ is declared but not used");
}
};
$self;
};
## method getdecl
sub getdecl {
no warnings 'recursion';
my $self = shift;