B-DeparseTree
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/B/DeparseTree/TreeMain.pm view on Meta::CPAN
if (!exists $from->{$key} or $from->{$key} ne $to->{$key}) {
if ($is_cperl){
next if $key eq 'feature_lexsubs';
next if $key eq 'feature_signatures';
}
push(@features, $key), next if $is_feature;
push @decls,
qq(\$^H{) . single_delim($self, "q", "'", $key, "'") . qq(} = )
. (
defined $to->{$key}
? single_delim($self, "q", "'", $to->{$key}, "'")
: 'undef'
)
. qq(;);
}
}
for my $key (sort keys %$from) {
next if $ignored_hints{$key};
my $is_feature = $key =~ /^feature_/ && $^V ge 5.15.6;
next if $is_feature and not $doing_features;
if (!exists $to->{$key}) {
push(@unfeatures, $key), next if $is_feature;
push @decls, qq(delete \$^H{'$key'};);
}
}
my @ret;
if (@features || @unfeatures) {
if (!%rev_feature) { %rev_feature = reverse %feature::feature }
}
if (@features) {
push @ret, $self->keyword("use") . " feature "
. join(", ", map "'$rev_feature{$_}'", @features) . ";\n";
}
if (@unfeatures) {
push @ret, $self->keyword("no") . " feature "
. join(", ", map "'$rev_feature{$_}'", @unfeatures)
. ";\n";
}
@decls and
push @ret,
join("\n" . (" " x $indent), "BEGIN {", @decls) . "\n}\n";
return @ret;
}
# generate any pragmas, 'package foo' etc needed to synchronise
# with the given cop
sub pragmata {
my $self = shift;
my($op) = @_;
my @text;
my $stash = $op->stashpv;
if ($stash ne $self->{'curstash'}) {
push @text, $self->keyword("package") . " $stash;\n";
$self->{'curstash'} = $stash;
}
if (OPpCONST_ARYBASE && $self->{'arybase'} != $op->arybase) {
push @text, '$[ = '. $op->arybase .";\n";
$self->{'arybase'} = $op->arybase;
}
my $warnings = $op->warnings;
my $warning_bits;
if ($warnings->isa("B::SPECIAL") && $$warnings == 4) {
$warning_bits = $warnings::Bits{"all"} & WARN_MASK;
}
elsif ($warnings->isa("B::SPECIAL") && $$warnings == 5) {
$warning_bits = $warnings::NONE;
}
elsif ($warnings->isa("B::SPECIAL")) {
$warning_bits = undef;
}
else {
$warning_bits = $warnings->PV & WARN_MASK;
}
if (defined ($warning_bits) and
!defined($self->{warnings}) || $self->{'warnings'} ne $warning_bits) {
push @text,
$self->declare_warnings($self->{'warnings'}, $warning_bits);
$self->{'warnings'} = $warning_bits;
}
my $hints = $] < 5.008009 ? $op->private : $op->hints;
my $old_hints = $self->{'hints'};
if ($self->{'hints'} != $hints) {
push @text, $self->declare_hints($self->{'hints'}, $hints);
$self->{'hints'} = $hints;
}
my $newhh;
if ($] > 5.009) {
$newhh = $op->hints_hash->HASH;
}
if ($] >= 5.015006) {
# feature bundle hints
my $from = $old_hints & $feature::hint_mask;
my $to = $ hints & $feature::hint_mask;
if ($from != $to) {
if ($to == $feature::hint_mask) {
if ($self->{'hinthash'}) {
delete $self->{'hinthash'}{$_}
for grep /^feature_/, keys %{$self->{'hinthash'}};
}
else { $self->{'hinthash'} = {} }
$self->{'hinthash'}
= _features_from_bundle($from, $self->{'hinthash'});
}
else {
my $bundle =
$feature::hint_bundles[$to >> $feature::hint_shift];
$bundle =~ s/(\d[13579])\z/$1+1/e; # 5.11 => 5.12
push @text,
$self->keyword("no") . " feature ':all';\n",
$self->keyword("use") . " feature ':$bundle';\n";
}
}
view all matches for this distributionview release on metacpan - search on metacpan
( run in 1.372 second using v1.00-cache-2.02-grep-82fe00e-cpan-1925d2aa809 )