Commit | Line | Data |
---|---|---|
a798dbf2 | 1 | package B::Terse; |
28b605d8 | 2 | |
31b49ad4 | 3 | our $VERSION = '1.01'; |
28b605d8 | 4 | |
ad4997d3 | 5 | use strict; |
31b49ad4 | 6 | use B qw(class); |
ad4997d3 | 7 | use B::Asmdata qw(@specialsv_name); |
31b49ad4 SM |
8 | use B::Concise qw(concise_cv set_style_standard); |
9 | use Carp; | |
ad4997d3 JH |
10 | |
11 | sub terse { | |
12 | my ($order, $cvref) = @_; | |
31b49ad4 | 13 | set_style_standard("terse"); |
ad4997d3 | 14 | if ($order eq "exec") { |
31b49ad4 | 15 | concise_cv('exec', $cvref); |
ad4997d3 | 16 | } else { |
31b49ad4 | 17 | concise_cv('basic', $cvref); |
ad4997d3 | 18 | } |
31b49ad4 | 19 | |
ad4997d3 | 20 | } |
a798dbf2 MB |
21 | |
22 | sub compile { | |
31b49ad4 SM |
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 JH |
28 | } |
29 | ||
30 | sub indent { | |
244826eb | 31 | my $level = @_ ? shift : 0; |
ad4997d3 JH |
32 | return " " x $level; |
33 | } | |
34 | ||
31b49ad4 SM |
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 SM |
38 | carp "B::OP::terse is deprecated; use B::Concise instead"; |
39 | B::Concise::b_terse(@_); | |
ad4997d3 JH |
40 | } |
41 | ||
31b49ad4 SM |
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 RGS |
48 | } |
49 | ||
ad4997d3 JH |
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 JH |
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 MB |
60 | } |
61 | ||
62 | 1; | |
7f20e9dd GS |
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 GS |
73 | |
74 | =head1 DESCRIPTION | |
75 | ||
31b49ad4 SM |
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 GS |
90 | |
91 | =head1 AUTHOR | |
92 | ||
31b49ad4 SM |
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 GS |
96 | |
97 | =cut |