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