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 =~ /^(.)(.*)$/;
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)$/) {
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_cond_expr") {
166 # pp_cond_expr never returns op_next
170 } elsif ($ppname eq "pp_enterloop") {
174 } elsif ($ppname eq "pp_subst") {
175 xref($op->pmreplstart);
178 &$ppname($op) if defined(&$ppname);
185 my $pack = $cv->GV->STASH->NAME;
186 $subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
187 load_pad($cv->PADLIST);
194 xref_cv(svref_2object($cvref));
199 load_pad(comppadlist);
202 xref_cv(shift @todo);
208 $file = $op->filegv->SV->PV;
215 $top = $pad[$op->targ];
216 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
219 sub pp_padav { pp_padsv(@_) }
220 sub pp_padhv { pp_padsv(@_) }
224 $var->[1] = $as . $var->[1];
225 process($var, "used");
228 sub pp_rv2cv { deref($top, "&"); }
229 sub pp_rv2hv { deref($top, "%"); }
230 sub pp_rv2sv { deref($top, "\$"); }
231 sub pp_rv2av { deref($top, "\@"); }
232 sub pp_rv2gv { deref($top, "*"); }
237 $top = [$gv->STASH->NAME, '$', $gv->NAME];
238 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
244 $top = [$gv->STASH->NAME, "*", $gv->NAME];
245 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
252 (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"];
257 $top = ["(method)", "->".$top->[1], $top->[2]];
262 if ($top->[1] eq "m") {
263 process($top, "meth");
265 process($top, "subused");
271 # Stuff for cross referencing definitions of variables and subs
278 #return if $done{$$cv}++;
279 $file = $gv->FILEGV->SV->PV;
281 process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
284 my $form = $gv->FORM;
286 return if $done{$$form}++;
287 $file = $gv->FILEGV->SV->PV;
289 process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
293 sub xref_definitions {
294 my ($pack, %exclude);
296 $subname = "(definitions)";
297 foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS
298 strict vars FileHandle Exporter Carp)) {
299 $exclude{$pack."::"} = 1;
301 no strict qw(vars refs);
302 walksymtable(\%{"main::"}, "xref", sub { !defined($exclude{$_[0]}) });
307 my ($file, $subname, $pack, $name, $ev, $perfile, $persubname,
308 $perpack, $pername, $perev);
309 foreach $file (sort(keys(%table))) {
310 $perfile = $table{$file};
311 print "File $file\n";
312 foreach $subname (sort(keys(%$perfile))) {
313 $persubname = $perfile->{$subname};
314 print " Subroutine $subname\n";
315 foreach $pack (sort(keys(%$persubname))) {
316 $perpack = $persubname->{$pack};
317 print " Package $pack\n";
318 foreach $name (sort(keys(%$perpack))) {
319 $pername = $perpack->{$name};
321 foreach $ev (qw(intro formdef subdef meth subused used)) {
322 $perev = $pername->{$ev};
323 if (defined($perev) && @$perev) {
324 my $code = $code{$ev};
325 push(@lines, map("$code$_", @$perev));
328 printf " %-16s %s\n", $name, join(", ", @lines);
337 my ($option, $opt, $arg);
339 while ($option = shift @options) {
340 if ($option =~ /^-(.)(.*)/) {
344 unshift @options, $option;
347 if ($opt eq "-" && $arg eq "-") {
350 } elsif ($opt eq "o") {
351 $arg ||= shift @options;
352 open(STDOUT, ">$arg") or return "$arg: $!\n";
353 } elsif ($opt eq "d") {
355 } elsif ($opt eq "r") {
357 } elsif ($opt eq "D") {
358 $arg ||= shift @options;
359 foreach $arg (split(//, $arg)) {
362 } elsif ($arg eq "O") {
364 } elsif ($arg eq "t") {
374 foreach $objname (@options) {
375 $objname = "main::$objname" unless $objname =~ /::/;
376 eval "xref_object(\\&$objname)";
377 die "xref_object(\\&$objname) failed: $@" if $@;