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