view release on metacpan or  search on metacpan

lib/B/Stats.pm  view on Meta::CPAN

=head1 NAME

B::Stats - print optree statistics

=head1 SYNOPSIS

  perl -MB::Stats myprog.pl # all
  perl -MO=Stats myprog.pl  # compile-time only
  perl -MB::Stats[,OPTIONS] myprog.pl

=head1 DESCRIPTION

Print statistics for all generated ops.

static analysis at compile-time,
static analysis at end-time to include all runtime added modules,
and dynamic analysis at run-time, as with a profiler.

The purpose is to help you in your goal:

    no bloat;

=head1 OPTIONS

Options can be bundled: C<-c,-e,-r> eq C<-cer>

=over

=item -c I<static>

Do static analysis at compile-time. This does not include all run-time require packages.
Invocation via -MO=Stats does this automatically.

=item -e I<end>

Do static analysis at end-time. This is includes all run-time require packages.
This calculates the heap space for the optree.

=item -r I<run>

Do dynamic run-time analysis of all actually visited ops, similar to a profiler.
Single ops can be called multiple times.

=item -a I<all (default)>

Same as -cer: static compile-time, end-time and dynamic run-time.

=item -t I<table>

Tabular list of -c, -e and -r results.

=item -u I<summary>

Short summary only, no op class.
With -t only the final table(s).

=item -F I<Files>

Prints included file names

=item -x I<fragmentation>  B<NOT YET>

Calculates the optree I<fragmentation>. 0.0 is perfect, 1.0 is very bad.

A perfect optree has no null ops and every op->next is immediately next
to the op.

=item -f<op,...> I<filter>  B<NOT YET>

Filter for op names and classes. Only calculate the given ops, resp. op class.

  perl -MB::Stats,-fLOGOP,-fCOP,-fconcat myprog.pl

=item -lF<logfile>

Print output only to this file. Default: STDERR

  perl -MB::Stats,-llog myprog.pl

=back

=head1 METHODS

=over

=cut

our (%B_inc, %B_env);
BEGIN { %B_inc = %INC; }

use strict;
# B includes 14 files and 3821 lines. overhead subtracted with B::Stats::Minus
use B;
use B::Stats::Minus;
# XSLoader adds 0 files and 0 lines, already with B.
# Changed to DynaLoader
# Opcodes-0.10 adds 6 files and 5303-3821 lines: Carp, AutoLoader, subs
# Opcodes-0.11 adds 2 files and 4141-3821 lines: subs
# use Opcodes; # deferred to run-time below
our ($static, @runtime, $compiled, $imported, $LOG);
my (%opt, $nops, $rops, @all_subs, $frag, %roots);
my ($c_count, $e_count, $r_count);

# check options
sub import {
  $DB::single = 1 if defined &DB::DB;
#print STDERR "opt: ",join(',',@_),"; "; # for Debugging
  for (@_) { # switch bundling without Getopt bloat
    if (/^-?([acerxtFu])(.*)$/) {
      $opt{$1} = 1;
      my $rest = $2;
      do {
	if ($rest =~ /^-?([acerxtFu])(.*)$/) {
	  $opt{$1} = 1;
	  $rest = $2;
	}
      } while $rest;
    }
    # taking multiple arguments: -ffilter
    if (/^-?f(.*)$/) {
      my $arg = $1;
      if ($arg =~ /^[A-Z_]*OP$/) {
        my @optype = qw(BASEOP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP_OR_SVOP
                        LOOP COP BASEOP_OR_UNOP FILESTATOP LOOPEXOP);
	$opt{f}->{class}->{$arg} = 1;
	die "invalid B::Stats,-fOPCLASS argument: $arg\n"
	  unless grep {$arg eq $_} @optype;
	# pre-expand names for the class
	require Opcodes;
	my $maxo = Opcodes::opcodes();
	for my $i (0..$maxo-1) {
	  my $name = Opcodes::opname($i);
	  my $class = $optype[ Opcodes::opclass($i) ];
	  if ($class eq $arg) {
	    $opt{f}->{name}->{$name} = 1;
	  }
	}
      } elsif ($arg =~ /^[a-z_]+$/) {
	$opt{f}->{name}->{$arg} = 1;
      } else {
	die "invalid B::Stats,-ffilter argument: $arg\n";
      }
    }
    if (/^-?(l)(.*)$/) { # taking arguments: -llogfile
      $opt{$1} = $2;
      open $LOG, ">", $opt{l} or die "Cannot write to B::Stats,-llogfile: $opt{l}\n";
    }
  }

  $opt{a} = 1 if !$opt{c} and !$opt{e} and !$opt{r}; # default
  $opt{c} = $opt{e} = $opt{r} = 1 if $opt{a};
#warn "%opt: ",keys %opt,"\n"; # for Debugging
  $LOG = \*STDERR unless $opt{l};
  $imported = 1;
}

sub _class {
    my $name = ref shift;
    $name =~ s/^.*:://;
    return $name;
}