B::Xref - Generates cross reference reports for Perl programs
perl -MO=Xref[,OPTIONS] foo.pl
The B::Xref module is used to generate a cross reference listing of all
definitions and uses of variables, subroutines and formats in a Perl program.
It is implemented as a backend for the Perl compiler.
The report generated is in the following format:
Each B<File> section reports on a single file. Each B<Subroutine> section
reports on a single subroutine apart from the special cases
"(definitions)" and "(main)". These report, respectively, on subroutine
definitions found by the initial symbol table walk and on the main part of
the program or module external to all subroutines.
The report is then grouped by the B<Package> of each variable,
subroutine or format with the special case "(lexicals)" meaning
lexical variables. Each B<object> name (implicitly qualified by its
containing B<Package>) includes its type character(s) at the beginning
where possible. Lexical variables are easier to track and even
included dereferencing information where possible.
The C<line numbers> are a comma separated list of line numbers (some
preceded by code letters) where that object is used in some way.
Simple uses aren't preceded by a code letter. Introductions (such as
where a lexical is first defined with C<my>) are indicated with the
letter "i". Subroutine and method calls are indicated by the character
"&". Subroutine definitions are indicated by "s" and format
Option words are separated by commas (not whitespace) and follow the
usual conventions of compiler backend options.
Directs output to C<FILENAME> instead of standard output.
Raw output. Instead of producing a human-readable report, outputs a line
in machine-readable form for each definition/use of a variable/sub/format.
Don't output the "(definitions)" sections.
(Internal) debug options, probably only useful if C<-r> included.
The C<t> option prints the object on the top of the stack as it's
being tracked. The C<O> option prints each operator as it's being
processed in the execution order of the program.
Non-lexical variables are quite difficult to track through a program.
Sometimes the type of a non-lexical variable's use is impossible to
determine. Introductions of non-lexical non-scalars don't seem to be
Malcolm Beattie, mbeattie@sable.ox.ac.uk.
use B
qw(peekop class comppadlist main_start svref_2object walksymtable
OPpLVAL_INTRO SVf_POK OPpOUR_INTRO cstring
sub UNKNOWN
{ ["?", "?", "?"] }
my @pad; # lexicals in current pad
# as ["(lexical)", type, name]
my %done; # keyed by $$op: set when each $op is done
my $top = UNKNOWN
; # shadows top element of stack as
# [pack, type, name] (pack can be "(lexical)")
my $file; # shadows current filename
my $line; # shadows current line number
my $subname; # shadows current sub name
my %table; # Multi-level hash to record all uses etc.
my @todo = (); # List of CVs that need processing
my %code = (intro
=> "i", used
=> "",
subdef
=> "s", subused
=> "&",
formdef
=> "f", meth
=> "->");
my ($debug_op, $debug_top, $nodefs, $raw);
my ($pack, $type, $name) = @
$var;
} elsif ($event eq "subused") {
printf "%-16s %-12s %5d %-12s %4s %-16s %s\n",
$file, $subname, $line, $pack, $type, $name, $event;
push(@
{$table{$file}->{$subname}->{$pack}->{$type.$name}->{$event}},
my ($namelistav, $vallistav, @namelist, $ix);
return if class($padlist) eq "SPECIAL";
($namelistav,$vallistav) = $padlist->ARRAY;
@namelist = $namelistav->ARRAY;
for ($ix = 1; $ix < @namelist; $ix++) {
my $namesv = $namelist[$ix];
next if class($namesv) eq "SPECIAL";
my ($type, $name) = $namesv->PV =~ /^(.)([^\0]*)(\0.*)?$/;
$pad[$ix] = ["(lexical)", $type || '?', $name || '?'];
if ($Config{useithreads
}) {
@vallist = $vallistav->ARRAY;
for ($ix = 1; $ix < @vallist; $ix++) {
my $valsv = $vallist[$ix];
next unless class($valsv) eq "GV";
# these pad GVs don't have corresponding names, so same @pad
# array can be used without collisions
$pad[$ix] = [$valsv->STASH->NAME, "*", $valsv->NAME];
for ($op = $start; $$op; $op = $op->next) {
warn sprintf("top = [%s, %s, %s]\n", @
$top) if $debug_top;
warn peekop
($op), "\n" if $debug_op;
if ($opname =~ /^(or|and|mapwhile|grepwhile|range|cond_expr)$/) {
} elsif ($opname eq "match" || $opname eq "subst") {
} elsif ($opname eq "substcont") {
xref
($op->other->pmreplstart);
} elsif ($opname eq "enterloop") {
} elsif ($opname eq "subst") {
my $ppname = "pp_$opname";
&$ppname($op) if defined(&$ppname);
my $pack = $cv->GV->STASH->NAME;
$subname = ($pack eq "main" ?
"" : "$pack\::") . $cv->GV->NAME;
xref_cv
(svref_2object
($cvref));
process
($top, $op->private & OPpLVAL_INTRO ?
"intro" : "used");
sub pp_padav
{ pp_padsv
(@_) }
sub pp_padhv
{ pp_padsv
(@_) }
my ($op, $var, $as) = @_;
$var->[1] = $as . $var->[1];
process
($var, $op->private & OPpOUR_INTRO ?
"intro" : "used");
sub pp_rv2cv
{ deref
(shift, $top, "&"); }
sub pp_rv2hv
{ deref
(shift, $top, "%"); }
sub pp_rv2sv
{ deref
(shift, $top, "\$"); }
sub pp_rv2av
{ deref
(shift, $top, "\@"); }
sub pp_rv2gv
{ deref
(shift, $top, "*"); }
if ($Config{useithreads
}) {
$top = UNKNOWN
unless $top;
$top = [$gv->STASH->NAME, '$', $gv->SAFENAME];
process
($top, $op->private & OPpLVAL_INTRO
||
$op->private & OPpOUR_INTRO ?
"intro" : "used");
if ($Config{useithreads
}) {
$top = UNKNOWN
unless $top;
$top = [$gv->STASH->NAME, "*", $gv->SAFENAME];
process
($top, $op->private & OPpLVAL_INTRO ?
"intro" : "used");
# constant could be in the pad (under useithreads)
(class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK
)
? cstring
($sv->PV) : "?"];
$top = UNKNOWN
unless $top;
$top = ["(method)", "->".$top->[1], $top->[2]];
process
($top, "subused");
# Stuff for cross referencing definitions of variables and subs
#return if $done{$$cv}++;
process
([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
return if $done{$$form}++;
process
([$gv->STASH->NAME, "", $gv->NAME], "formdef");
$subname = "(definitions)";
foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS
strict vars FileHandle Exporter Carp PerlIO::Layer
attributes utf8 warnings)) {
$exclude{$pack."::"} = 1;
walksymtable
(\
%{"main::"}, "xref", sub { !defined($exclude{$_[0]}) });
my ($file, $subname, $pack, $name, $ev, $perfile, $persubname,
$perpack, $pername, $perev);
foreach $file (sort(keys(%table))) {
$perfile = $table{$file};
foreach $subname (sort(keys(%$perfile))) {
$persubname = $perfile->{$subname};
print " Subroutine $subname\n";
foreach $pack (sort(keys(%$persubname))) {
$perpack = $persubname->{$pack};
print " Package $pack\n";
foreach $name (sort(keys(%$perpack))) {
$pername = $perpack->{$name};
foreach $ev (qw(intro formdef subdef meth subused used)) {
$perev = $pername->{$ev};
if (defined($perev) && @
$perev) {
push(@lines, map("$code$_", @
$perev));
printf " %-16s %s\n", $name, join(", ", @lines);
my ($option, $opt, $arg);
while ($option = shift @options) {
if ($option =~ /^-(.)(.*)/) {
unshift @options, $option;
if ($opt eq "-" && $arg eq "-") {
open(STDOUT
, ">$arg") or return "$arg: $!\n";
foreach $arg (split(//, $arg)) {
foreach $objname (@options) {
$objname = "main::$objname" unless $objname =~ /::/;
eval "xref_object(\\&$objname)";
die "xref_object(\\&$objname) failed: $@" if $@
;