package B::Terse;
-our $VERSION = '1.00';
+our $VERSION = '1.01';
use strict;
-use B qw(peekop class walkoptree walkoptree_exec walkoptree_slow
- main_start main_root cstring svref_2object SVf_IVisUV);
+use B qw(class);
use B::Asmdata qw(@specialsv_name);
+use B::Concise qw(concise_cv set_style_standard);
+use Carp;
sub terse {
my ($order, $cvref) = @_;
- my $cv = svref_2object($cvref);
+ set_style_standard("terse");
if ($order eq "exec") {
- walkoptree_exec($cv->START, "terse");
+ concise_cv('exec', $cvref);
} else {
- walkoptree_slow($cv->ROOT, "terse");
+ concise_cv('basic', $cvref);
}
+
}
sub compile {
- my $order = @_ ? shift : "";
- my @options = @_;
- B::clearsym();
- if (@options) {
- return sub {
- my $objname;
- foreach $objname (@options) {
- $objname = "main::$objname" unless $objname =~ /::/;
- eval "terse(\$order, \\&$objname)";
- die "terse($order, \\&$objname) failed: $@" if $@;
- }
- }
- } else {
- if ($order eq "exec") {
- return sub { walkoptree_exec(main_start, "terse") }
- } else {
- return sub { walkoptree_slow(main_root, "terse") }
- }
- }
+ my @args = @_;
+ my $order = @args ? shift(@args) : "";
+ $order = "-exec" if $order eq "exec";
+ unshift @args, $order if $order ne "";
+ B::Concise::compile("-terse", @args);
}
sub indent {
return " " x $level;
}
+# Don't use this, at least on OPs in subroutines: it has no way of
+# getting to the pad, and will give wrong answers or crash.
sub B::OP::terse {
- my ($op, $level) = @_;
- my $targ = $op->targ;
- $targ = ($targ > 0) ? " [$targ]" : "";
- print indent($level), peekop($op), $targ, "\n";
+ carp "B::OP::terse is deprecated; use B::Concise instead";
+ B::Concise::b_terse(@_);
}
-sub B::SVOP::terse {
- my ($op, $level) = @_;
- print indent($level), peekop($op), " ";
- $op->sv->terse(0);
-}
-
-sub B::PADOP::terse {
- my ($op, $level) = @_;
- print indent($level), peekop($op), " ", $op->padix, "\n";
-}
-
-sub B::PMOP::terse {
- my ($op, $level) = @_;
- my $precomp = $op->precomp;
- print indent($level), peekop($op),
- defined($precomp) ? " /$precomp/\n" : " (regexp not compiled)\n";
-
-}
-
-sub B::PVOP::terse {
- my ($op, $level) = @_;
- print indent($level), peekop($op), " ", cstring($op->pv), "\n";
-}
-
-sub B::COP::terse {
- my ($op, $level) = @_;
- my $label = $op->label;
- if ($label) {
- $label = " label ".cstring($label);
- }
- print indent($level), peekop($op), $label || "", "\n";
-}
-
-sub B::PV::terse {
- my ($sv, $level) = @_;
- print indent($level);
- printf "%s (0x%lx) %s\n", class($sv), $$sv, cstring($sv->PV);
-}
-
-sub B::AV::terse {
- my ($sv, $level) = @_;
- print indent($level);
- printf "%s (0x%lx) FILL %d\n", class($sv), $$sv, $sv->FILL;
-}
-
-sub B::GV::terse {
- my ($gv, $level) = @_;
- my $stash = $gv->STASH->NAME;
- if ($stash eq "main") {
- $stash = "";
- } else {
- $stash = $stash . "::";
- }
- print indent($level);
- printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->SAFENAME;
-}
-
-sub B::IV::terse {
- my ($sv, $level) = @_;
- print indent($level);
- my $v = $sv->FLAGS & SVf_IVisUV ? "%u" : "%d";
- printf "%s (0x%lx) $v\n", class($sv), $$sv, $sv->int_value;
-}
-
-sub B::NV::terse {
- my ($sv, $level) = @_;
- print indent($level);
- printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV;
-}
-
-sub B::RV::terse {
- my ($rv, $level) = @_;
- print indent($level);
- printf "%s (0x%lx) %s\n", class($rv), $$rv, printref($rv);
-}
-
-sub printref {
- my $rv = shift;
- my $rcl = class($rv->RV);
- if ($rcl eq 'PV') {
- return "\\" . cstring($rv->RV->$rcl);
- } elsif ($rcl eq 'NV') {
- return "\\" . $rv->RV->$rcl;
- } elsif ($rcl eq 'IV') {
- return sprintf "\\%" . ($rv->RV->FLAGS & SVf_IVisUV ? "u" : "d"),
- $rv->RV->int_value;
- } elsif ($rcl eq 'RV') {
- return "\\" . printref($rv->RV);
- }
+sub B::SV::terse {
+ my($sv, $level) = (@_, 0);
+ my %info;
+ B::Concise::concise_sv($sv, \%info);
+ my $s = B::Concise::fmt_line(\%info, "#svclass~(?((#svaddr))?)~#svval", 0);
+ print indent($level), $s, "\n";
}
sub B::NULL::terse {
print indent($level);
printf "%s (0x%lx)\n", class($sv), $$sv;
}
-
+
sub B::SPECIAL::terse {
my ($sv, $level) = @_;
print indent($level);
=head1 DESCRIPTION
-See F<ext/B/README>.
+This version of B::Terse is really just a wrapper that calls B::Concise
+with the B<-terse> option. It is provided for compatibility with old scripts
+(and habits) but using B::Concise directly is now recommended instead.
+
+For compatiblilty with the old B::Terse, this module also adds a
+method named C<terse> to B::OP and B::SV objects. The B::SV method is
+largely compatible with the old one, though authors of new software
+might be advised to choose a more user-friendly output format. The
+B::OP C<terse> method, however, doesn't work well. Since B::Terse was
+first written, much more information in OPs has migrated to the
+scratchpad datastructure, but the C<terse> interface doesn't have any
+way of getting to the correct pad. As a kludge, the new version will
+always use the pad for the main program, but for OPs in subroutines
+this will give the wrong answer or crash.
=head1 AUTHOR
-Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+The original version of B::Terse was written by Malcolm Beattie,
+E<lt>mbeattie@sable.ox.ac.ukE<gt>. This wrapper was written by Stephen
+McCamant, E<lt>smcc@MIT.EDUE<gt>.
=cut