home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / Terse.pm < prev    next >
Text File  |  2005-01-27  |  3KB  |  104 lines
  1. package B::Terse;
  2.  
  3. our $VERSION = '1.02';
  4.  
  5. use strict;
  6. use B qw(class);
  7. use B::Asmdata qw(@specialsv_name);
  8. use B::Concise qw(concise_subref set_style_standard);
  9. use Carp;
  10.  
  11. sub terse {
  12.     my ($order, $subref) = @_;
  13.     set_style_standard("terse");
  14.     if ($order eq "exec") {
  15.     concise_subref('exec', $subref);
  16.     } else {
  17.     concise_subref('basic', $subref);
  18.     }
  19. }
  20.  
  21. sub compile {
  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);
  27. }
  28.  
  29. sub indent {
  30.     my ($level) = @_ ? shift : 0;
  31.     return "    " x $level;
  32. }
  33.  
  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.
  36. sub B::OP::terse {
  37.     carp "B::OP::terse is deprecated; use B::Concise instead";
  38.     B::Concise::b_terse(@_);
  39. }
  40.  
  41. sub B::SV::terse {
  42.     my($sv, $level) = (@_, 0);
  43.     my %info;
  44.     B::Concise::concise_sv($sv, \%info);
  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;
  51. }
  52.  
  53. sub B::NULL::terse {
  54.     my ($sv, $level) = @_;
  55.     my $s = indent($level) . sprintf "%s (0x%lx)", class($sv), $$sv;
  56.     print "$s\n" unless defined wantarray;
  57.     $s;
  58. }
  59.  
  60. sub B::SPECIAL::terse {
  61.     my ($sv, $level) = @_;
  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;
  66. }
  67.  
  68. 1;
  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.  
  78.     perl -MO=Terse[,OPTIONS] foo.pl
  79.  
  80. =head1 DESCRIPTION
  81.  
  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.
  96.  
  97. =head1 AUTHOR
  98.  
  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>.
  102.  
  103. =cut
  104.