Commit | Line | Data |
a798dbf2 |
1 | package B::Terse; |
28b605d8 |
2 | |
8ec8fbef |
3 | our $VERSION = '1.02'; |
28b605d8 |
4 | |
ad4997d3 |
5 | use strict; |
31b49ad4 |
6 | use B qw(class); |
ad4997d3 |
7 | use B::Asmdata qw(@specialsv_name); |
8ec8fbef |
8 | use B::Concise qw(concise_subref set_style_standard); |
31b49ad4 |
9 | use Carp; |
ad4997d3 |
10 | |
11 | sub terse { |
8ec8fbef |
12 | my ($order, $subref) = @_; |
31b49ad4 |
13 | set_style_standard("terse"); |
ad4997d3 |
14 | if ($order eq "exec") { |
8ec8fbef |
15 | concise_subref('exec', $subref); |
ad4997d3 |
16 | } else { |
8ec8fbef |
17 | concise_subref('basic', $subref); |
ad4997d3 |
18 | } |
31b49ad4 |
19 | |
ad4997d3 |
20 | } |
a798dbf2 |
21 | |
22 | sub compile { |
31b49ad4 |
23 | my @args = @_; |
24 | my $order = @args ? shift(@args) : ""; |
25 | $order = "-exec" if $order eq "exec"; |
26 | unshift @args, $order if $order ne ""; |
27 | B::Concise::compile("-terse", @args); |
ad4997d3 |
28 | } |
29 | |
30 | sub indent { |
244826eb |
31 | my $level = @_ ? shift : 0; |
ad4997d3 |
32 | return " " x $level; |
33 | } |
34 | |
31b49ad4 |
35 | # Don't use this, at least on OPs in subroutines: it has no way of |
36 | # getting to the pad, and will give wrong answers or crash. |
ad4997d3 |
37 | sub B::OP::terse { |
31b49ad4 |
38 | carp "B::OP::terse is deprecated; use B::Concise instead"; |
39 | B::Concise::b_terse(@_); |
ad4997d3 |
40 | } |
41 | |
31b49ad4 |
42 | sub B::SV::terse { |
43 | my($sv, $level) = (@_, 0); |
44 | my %info; |
45 | B::Concise::concise_sv($sv, \%info); |
46 | my $s = B::Concise::fmt_line(\%info, "#svclass~(?((#svaddr))?)~#svval", 0); |
47 | print indent($level), $s, "\n"; |
d333a217 |
48 | } |
49 | |
ad4997d3 |
50 | sub B::NULL::terse { |
51 | my ($sv, $level) = @_; |
52 | print indent($level); |
53 | printf "%s (0x%lx)\n", class($sv), $$sv; |
54 | } |
31b49ad4 |
55 | |
ad4997d3 |
56 | sub B::SPECIAL::terse { |
57 | my ($sv, $level) = @_; |
58 | print indent($level); |
59 | printf "%s #%d %s\n", class($sv), $$sv, $specialsv_name[$$sv]; |
a798dbf2 |
60 | } |
61 | |
62 | 1; |
7f20e9dd |
63 | |
64 | __END__ |
65 | |
66 | =head1 NAME |
67 | |
68 | B::Terse - Walk Perl syntax tree, printing terse info about ops |
69 | |
70 | =head1 SYNOPSIS |
71 | |
ad4997d3 |
72 | perl -MO=Terse[,OPTIONS] foo.pl |
7f20e9dd |
73 | |
74 | =head1 DESCRIPTION |
75 | |
31b49ad4 |
76 | This version of B::Terse is really just a wrapper that calls B::Concise |
77 | with the B<-terse> option. It is provided for compatibility with old scripts |
78 | (and habits) but using B::Concise directly is now recommended instead. |
79 | |
80 | For compatiblilty with the old B::Terse, this module also adds a |
81 | method named C<terse> to B::OP and B::SV objects. The B::SV method is |
82 | largely compatible with the old one, though authors of new software |
83 | might be advised to choose a more user-friendly output format. The |
84 | B::OP C<terse> method, however, doesn't work well. Since B::Terse was |
85 | first written, much more information in OPs has migrated to the |
86 | scratchpad datastructure, but the C<terse> interface doesn't have any |
87 | way of getting to the correct pad. As a kludge, the new version will |
88 | always use the pad for the main program, but for OPs in subroutines |
89 | this will give the wrong answer or crash. |
7f20e9dd |
90 | |
91 | =head1 AUTHOR |
92 | |
31b49ad4 |
93 | The original version of B::Terse was written by Malcolm Beattie, |
94 | E<lt>mbeattie@sable.ox.ac.ukE<gt>. This wrapper was written by Stephen |
95 | McCamant, E<lt>smcc@MIT.EDUE<gt>. |
7f20e9dd |
96 | |
97 | =cut |