5 B::Xref - Generates cross reference reports for Perl programs
9 perl -MO=Xref[,OPTIONS] foo.pl
13 The B::Xref module is used to generate a cross reference listing of all
14 definitions and uses of variables, subroutines and formats in a Perl program.
15 It is implemented as a backend for the Perl compiler.
17 The report generated is in the following format:
22 object1 C<line numbers>
23 object2 C<line numbers>
28 Each B<File> section reports on a single file. Each B<Subroutine> section
29 reports on a single subroutine apart from the special cases
30 "(definitions)" and "(main)". These report, respectively, on subroutine
31 definitions found by the initial symbol table walk and on the main part of
32 the program or module external to all subroutines.
34 The report is then grouped by the B<Package> of each variable,
35 subroutine or format with the special case "(lexicals)" meaning
36 lexical variables. Each B<object> name (implicitly qualified by its
37 containing B<Package>) includes its type character(s) at the beginning
38 where possible. Lexical variables are easier to track and even
39 included dereferencing information where possible.
41 The C<line numbers> are a comma separated list of line numbers (some
42 preceded by code letters) where that object is used in some way.
43 Simple uses aren't preceded by a code letter. Introductions (such as
44 where a lexical is first defined with C<my>) are indicated with the
45 letter "i". Subroutine and method calls are indicated by the character
46 "&". Subroutine definitions are indicated by "s" and format
51 Option words are separated by commas (not whitespace) and follow the
52 usual conventions of compiler backend options.
58 Directs output to C<FILENAME> instead of standard output.
62 Raw output. Instead of producing a human-readable report, outputs a line
63 in machine-readable form for each definition/use of a variable/sub/format.
67 (Internal) debug options, probably only useful if C<-r> included.
68 The C<t> option prints the object on the top of the stack as it's
69 being tracked. The C<O> option prints each operator as it's being
70 processed in the execution order of the program.
76 Non-lexical variables are quite difficult to track through a program.
77 Sometimes the type of a non-lexical variable's use is impossible to
78 determine. Introductions of non-lexical non-scalars don't seem to be
83 Malcolm Beattie, mbeattie@sable.ox.ac.uk.
88 use B qw(peekop class comppadlist main_start svref_2object walksymtable
92 sub UNKNOWN { ["?", "?", "?"] }
94 my @pad; # lexicals in current pad
95 # as ["(lexical)", type, name]
96 my %done; # keyed by $$op: set when each $op is done
97 my $top = UNKNOWN; # shadows top element of stack as
98 # [pack, type, name] (pack can be "(lexical)")
99 my $file; # shadows current filename
100 my $line; # shadows current line number
101 my $subname; # shadows current sub name
102 my %table; # Multi-level hash to record all uses etc.
103 my @todo = (); # List of CVs that need processing
105 my %code = (intro => "i", used => "",
106 subdef => "s", subused => "&",
107 formdef => "f", meth => "->");
111 my ($debug_op, $debug_top, $nodefs, $raw);
114 my ($var, $event) = @_;
115 my ($pack, $type, $name) = @$var;
117 if ($event eq "used") {
119 } elsif ($event eq "subused") {
123 $type =~ s/(.)\*$/$1/g;
125 printf "%-16s %-12s %5d %-12s %4s %-16s %s\n",
126 $file, $subname, $line, $pack, $type, $name, $event;
129 push(@{$table{$file}->{$subname}->{$pack}->{$type.$name}->{$event}},
136 my ($namelistav, @namelist, $ix);
138 return if class($padlist) eq "SPECIAL";
139 ($namelistav) = $padlist->ARRAY;
140 @namelist = $namelistav->ARRAY;
141 for ($ix = 1; $ix < @namelist; $ix++) {
142 my $namesv = $namelist[$ix];
143 next if class($namesv) eq "SPECIAL";
144 my ($type, $name) = $namesv->PV =~ /^(.)([^\0]*)(\0.*)?$/;
145 $pad[$ix] = ["(lexical)", $type, $name];
152 for ($op = $start; $$op; $op = $op->next) {
153 last if $done{$$op}++;
154 warn sprintf("top = [%s, %s, %s]\n", @$top) if $debug_top;
155 warn peekop($op), "\n" if $debug_op;
156 my $ppname = $op->ppaddr;
157 if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile|range|cond_expr)$/) {
159 } elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
160 xref($op->pmreplstart);
161 } elsif ($ppname eq "pp_substcont") {
162 xref($op->other->pmreplstart);
165 } elsif ($ppname eq "pp_enterloop") {
169 } elsif ($ppname eq "pp_subst") {
170 xref($op->pmreplstart);
173 &$ppname($op) if defined(&$ppname);
180 my $pack = $cv->GV->STASH->NAME;
181 $subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
182 load_pad($cv->PADLIST);
189 xref_cv(svref_2object($cvref));
194 load_pad(comppadlist);
197 xref_cv(shift @todo);
203 $file = $op->filegv->SV->PV;
210 $top = $pad[$op->targ];
211 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
214 sub pp_padav { pp_padsv(@_) }
215 sub pp_padhv { pp_padsv(@_) }
219 $var->[1] = $as . $var->[1];
220 process($var, "used");
223 sub pp_rv2cv { deref($top, "&"); }
224 sub pp_rv2hv { deref($top, "%"); }
225 sub pp_rv2sv { deref($top, "\$"); }
226 sub pp_rv2av { deref($top, "\@"); }
227 sub pp_rv2gv { deref($top, "*"); }
232 $top = [$gv->STASH->NAME, '$', $gv->NAME];
233 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
239 $top = [$gv->STASH->NAME, "*", $gv->NAME];
240 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
247 (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"];
252 $top = ["(method)", "->".$top->[1], $top->[2]];
257 if ($top->[1] eq "m") {
258 process($top, "meth");
260 process($top, "subused");
266 # Stuff for cross referencing definitions of variables and subs
273 #return if $done{$$cv}++;
274 $file = $gv->FILEGV->SV->PV;
276 process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
279 my $form = $gv->FORM;
281 return if $done{$$form}++;
282 $file = $gv->FILEGV->SV->PV;
284 process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
288 sub xref_definitions {
289 my ($pack, %exclude);
291 $subname = "(definitions)";
292 foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS
293 strict vars FileHandle Exporter Carp)) {
294 $exclude{$pack."::"} = 1;
296 no strict qw(vars refs);
297 walksymtable(\%{"main::"}, "xref", sub { !defined($exclude{$_[0]}) });
302 my ($file, $subname, $pack, $name, $ev, $perfile, $persubname,
303 $perpack, $pername, $perev);
304 foreach $file (sort(keys(%table))) {
305 $perfile = $table{$file};
306 print "File $file\n";
307 foreach $subname (sort(keys(%$perfile))) {
308 $persubname = $perfile->{$subname};
309 print " Subroutine $subname\n";
310 foreach $pack (sort(keys(%$persubname))) {
311 $perpack = $persubname->{$pack};
312 print " Package $pack\n";
313 foreach $name (sort(keys(%$perpack))) {
314 $pername = $perpack->{$name};
316 foreach $ev (qw(intro formdef subdef meth subused used)) {
317 $perev = $pername->{$ev};
318 if (defined($perev) && @$perev) {
319 my $code = $code{$ev};
320 push(@lines, map("$code$_", @$perev));
323 printf " %-16s %s\n", $name, join(", ", @lines);
332 my ($option, $opt, $arg);
334 while ($option = shift @options) {
335 if ($option =~ /^-(.)(.*)/) {
339 unshift @options, $option;
342 if ($opt eq "-" && $arg eq "-") {
345 } elsif ($opt eq "o") {
346 $arg ||= shift @options;
347 open(STDOUT, ">$arg") or return "$arg: $!\n";
348 } elsif ($opt eq "d") {
350 } elsif ($opt eq "r") {
352 } elsif ($opt eq "D") {
353 $arg ||= shift @options;
354 foreach $arg (split(//, $arg)) {
357 } elsif ($arg eq "O") {
359 } elsif ($arg eq "t") {
369 foreach $objname (@options) {
370 $objname = "main::$objname" unless $objname =~ /::/;
371 eval "xref_object(\\&$objname)";
372 die "xref_object(\\&$objname) failed: $@" if $@;