view release on metacpan or  search on metacpan

os2/B/Deparse.pm  view on Meta::CPAN

	    $scope_st = $s if !defined($scope_st) || $s < $scope_st;
	    $scope_en = $e if !defined($scope_en) || $e > $scope_en;
	}
	elsif (is_state($o)) {
	    my $c = $o->cop_seq;
	    $scope_st = $c if !defined($scope_st) || $c < $scope_st;
	    $scope_en = $c if !defined($scope_en) || $c > $scope_en;
	}
	elsif ($o->flags & OPf_KIDS) {
	    ($scope_st, $scope_en) =
		$self->find_scope($o, $scope_st, $scope_en)
	}
    }

    return ($scope_st, $scope_en);
}

# Returns a list of subs which should be inserted before the COP
sub cop_subs {
    my ($self, $op, $out_seq) = @_;
    my $seq = $op->cop_seq;
    # If we have nephews, then our sequence number indicates
    # the cop_seq of the end of some sort of scope.
    if (class($op->sibling) ne "NULL" && $op->sibling->flags & OPf_KIDS
	and my $nseq = $self->find_scope_st($op->sibling) ) {
	$seq = $nseq;
    }
    $seq = $out_seq if defined($out_seq) && $out_seq < $seq;
    return $self->seq_subs($seq);
}

sub seq_subs {
    my ($self, $seq) = @_;
    my @text;
#push @text, "# ($seq)\n";

    return "" if !defined $seq;
    while (scalar(@{$self->{'subs_todo'}})
	   and $seq > $self->{'subs_todo'}[0][0]) {
	push @text, $self->next_todo;
    }
    return @text;
}

# Notice how subs and formats are inserted between statements here;
# also $[ assignments and pragmas.
sub pp_nextstate {
    my $self = shift;
    my($op, $cx) = @_;
    $self->{'curcop'} = $op;
    my @text;
    push @text, $self->cop_subs($op);
    push @text, $op->label . ": " if $op->label;
    my $stash = $op->stashpv;
    if ($stash ne $self->{'curstash'}) {
	push @text, "package $stash;\n";
	$self->{'curstash'} = $stash;
    }

    if ($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, declare_warnings($self->{'warnings'}, $warning_bits);
	$self->{'warnings'} = $warning_bits;
    }

    if ($self->{'hints'} != $op->private) {
	push @text, declare_hints($self->{'hints'}, $op->private);
	$self->{'hints'} = $op->private;
    }

    # This should go after of any branches that add statements, to
    # increase the chances that it refers to the same line it did in
    # the original program.
    if ($self->{'linenums'}) {
	push @text, "\f#line " . $op->line .
	  ' "' . $op->file, qq'"\n';
    }

    return join("", @text);
}

sub declare_warnings {
    my ($from, $to) = @_;
    if (($to & WARN_MASK) eq warnings::bits("all")) {
	return "use warnings;\n";
    }
    elsif (($to & WARN_MASK) eq "\0"x length($to)) {
	return "no warnings;\n";
    }
    return "BEGIN {\${^WARNING_BITS} = ".perlstring($to)."}\n";
}

sub declare_hints {
    my ($from, $to) = @_;
    my $use = $to   & ~$from;
    my $no  = $from & ~$to;
    my $decls = "";
    for my $pragma (hint_pragmas($use)) {
	$decls .= "use $pragma;\n";
    }
    for my $pragma (hint_pragmas($no)) {