7 B::Xref - Generates cross reference reports for Perl programs
11 perl -MO=Xref[,OPTIONS] foo.pl
15 The B::Xref module is used to generate a cross reference listing of all
16 definitions and uses of variables, subroutines and formats in a Perl program.
17 It is implemented as a backend for the Perl compiler.
19 The report generated is in the following format:
24 object1 C<line numbers>
25 object2 C<line numbers>
30 Each B<File> section reports on a single file. Each B<Subroutine> section
31 reports on a single subroutine apart from the special cases
32 "(definitions)" and "(main)". These report, respectively, on subroutine
33 definitions found by the initial symbol table walk and on the main part of
34 the program or module external to all subroutines.
36 The report is then grouped by the B<Package> of each variable,
37 subroutine or format with the special case "(lexicals)" meaning
38 lexical variables. Each B<object> name (implicitly qualified by its
39 containing B<Package>) includes its type character(s) at the beginning
40 where possible. Lexical variables are easier to track and even
41 included dereferencing information where possible.
43 The C<line numbers> are a comma separated list of line numbers (some
44 preceded by code letters) where that object is used in some way.
45 Simple uses aren't preceded by a code letter. Introductions (such as
46 where a lexical is first defined with C<my>) are indicated with the
47 letter "i". Subroutine and method calls are indicated by the character
48 "&". Subroutine definitions are indicated by "s" and format
53 Option words are separated by commas (not whitespace) and follow the
54 usual conventions of compiler backend options.
60 Directs output to C<FILENAME> instead of standard output.
64 Raw output. Instead of producing a human-readable report, outputs a line
65 in machine-readable form for each definition/use of a variable/sub/format.
69 (Internal) debug options, probably only useful if C<-r> included.
70 The C<t> option prints the object on the top of the stack as it's
71 being tracked. The C<O> option prints each operator as it's being
72 processed in the execution order of the program.
78 Non-lexical variables are quite difficult to track through a program.
79 Sometimes the type of a non-lexical variable's use is impossible to
80 determine. Introductions of non-lexical non-scalars don't seem to be
85 Malcolm Beattie, mbeattie@sable.ox.ac.uk.
91 use B qw(peekop class comppadlist main_start svref_2object walksymtable
92 OPpLVAL_INTRO SVf_POK OPpOUR_INTRO
95 sub UNKNOWN { ["?", "?", "?"] }
97 my @pad; # lexicals in current pad
98 # as ["(lexical)", type, name]
99 my %done; # keyed by $$op: set when each $op is done
100 my $top = UNKNOWN; # shadows top element of stack as
101 # [pack, type, name] (pack can be "(lexical)")
102 my $file; # shadows current filename
103 my $line; # shadows current line number
104 my $subname; # shadows current sub name
105 my %table; # Multi-level hash to record all uses etc.
106 my @todo = (); # List of CVs that need processing
108 my %code = (intro => "i", used => "",
109 subdef => "s", subused => "&",
110 formdef => "f", meth => "->");
114 my ($debug_op, $debug_top, $nodefs, $raw);
117 my ($var, $event) = @_;
118 my ($pack, $type, $name) = @$var;
120 if ($event eq "used") {
122 } elsif ($event eq "subused") {
126 $type =~ s/(.)\*$/$1/g;
128 printf "%-16s %-12s %5d %-12s %4s %-16s %s\n",
129 $file, $subname, $line, $pack, $type, $name, $event;
132 push(@{$table{$file}->{$subname}->{$pack}->{$type.$name}->{$event}},
139 my ($namelistav, $vallistav, @namelist, $ix);
141 return if class($padlist) eq "SPECIAL";
142 ($namelistav,$vallistav) = $padlist->ARRAY;
143 @namelist = $namelistav->ARRAY;
144 for ($ix = 1; $ix < @namelist; $ix++) {
145 my $namesv = $namelist[$ix];
146 next if class($namesv) eq "SPECIAL";
147 my ($type, $name) = $namesv->PV =~ /^(.)([^\0]*)(\0.*)?$/;
148 $pad[$ix] = ["(lexical)", $type, $name];
150 if ($Config{useithreads}) {
152 @vallist = $vallistav->ARRAY;
153 for ($ix = 1; $ix < @vallist; $ix++) {
154 my $valsv = $vallist[$ix];
155 next unless class($valsv) eq "GV";
156 # these pad GVs don't have corresponding names, so same @pad
157 # array can be used without collisions
158 $pad[$ix] = [$valsv->STASH->NAME, "*", $valsv->NAME];
166 for ($op = $start; $$op; $op = $op->next) {
167 last if $done{$$op}++;
168 warn sprintf("top = [%s, %s, %s]\n", @$top) if $debug_top;
169 warn peekop($op), "\n" if $debug_op;
170 my $opname = $op->name;
171 if ($opname =~ /^(or|and|mapwhile|grepwhile|range|cond_expr)$/) {
173 } elsif ($opname eq "match" || $opname eq "subst") {
174 xref($op->pmreplstart);
175 } elsif ($opname eq "substcont") {
176 xref($op->other->pmreplstart);
179 } elsif ($opname eq "enterloop") {
183 } elsif ($opname eq "subst") {
184 xref($op->pmreplstart);
187 my $ppname = "pp_$opname";
188 &$ppname($op) if defined(&$ppname);
195 my $pack = $cv->GV->STASH->NAME;
196 $subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
197 load_pad($cv->PADLIST);
204 xref_cv(svref_2object($cvref));
209 load_pad(comppadlist);
212 xref_cv(shift @todo);
225 $top = $pad[$op->targ];
226 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
229 sub pp_padav { pp_padsv(@_) }
230 sub pp_padhv { pp_padsv(@_) }
233 my ($op, $var, $as) = @_;
234 $var->[1] = $as . $var->[1];
235 process($var, $op->private & OPpOUR_INTRO ? "intro" : "used");
238 sub pp_rv2cv { deref(shift, $top, "&"); }
239 sub pp_rv2hv { deref(shift, $top, "%"); }
240 sub pp_rv2sv { deref(shift, $top, "\$"); }
241 sub pp_rv2av { deref(shift, $top, "\@"); }
242 sub pp_rv2gv { deref(shift, $top, "*"); }
247 if ($Config{useithreads}) {
248 $top = $pad[$op->padix];
249 $top = UNKNOWN unless $top;
254 $top = [$gv->STASH->NAME, '$', $gv->SAFENAME];
256 process($top, $op->private & OPpLVAL_INTRO ||
257 $op->private & OPpOUR_INTRO ? "intro" : "used");
263 if ($Config{useithreads}) {
264 $top = $pad[$op->padix];
265 $top = UNKNOWN unless $top;
270 $top = [$gv->STASH->NAME, "*", $gv->SAFENAME];
272 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
278 # constant could be in the pad (under useithreads)
281 (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"];
284 $top = $pad[$op->targ];
285 $top = UNKNOWN unless $top;
291 $top = ["(method)", "->".$top->[1], $top->[2]];
296 if ($top->[1] eq "m") {
297 process($top, "meth");
299 process($top, "subused");
305 # Stuff for cross referencing definitions of variables and subs
312 #return if $done{$$cv}++;
315 process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
318 my $form = $gv->FORM;
320 return if $done{$$form}++;
323 process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
327 sub xref_definitions {
328 my ($pack, %exclude);
330 $subname = "(definitions)";
331 foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS
332 strict vars FileHandle Exporter Carp PerlIO::Layer
333 attributes utf8 warnings)) {
334 $exclude{$pack."::"} = 1;
336 no strict qw(vars refs);
337 walksymtable(\%{"main::"}, "xref", sub { !defined($exclude{$_[0]}) });
342 my ($file, $subname, $pack, $name, $ev, $perfile, $persubname,
343 $perpack, $pername, $perev);
344 foreach $file (sort(keys(%table))) {
345 $perfile = $table{$file};
346 print "File $file\n";
347 foreach $subname (sort(keys(%$perfile))) {
348 $persubname = $perfile->{$subname};
349 print " Subroutine $subname\n";
350 foreach $pack (sort(keys(%$persubname))) {
351 $perpack = $persubname->{$pack};
352 print " Package $pack\n";
353 foreach $name (sort(keys(%$perpack))) {
354 $pername = $perpack->{$name};
356 foreach $ev (qw(intro formdef subdef meth subused used)) {
357 $perev = $pername->{$ev};
358 if (defined($perev) && @$perev) {
359 my $code = $code{$ev};
360 push(@lines, map("$code$_", @$perev));
363 printf " %-16s %s\n", $name, join(", ", @lines);
372 my ($option, $opt, $arg);
374 while ($option = shift @options) {
375 if ($option =~ /^-(.)(.*)/) {
379 unshift @options, $option;
382 if ($opt eq "-" && $arg eq "-") {
385 } elsif ($opt eq "o") {
386 $arg ||= shift @options;
387 open(STDOUT, ">$arg") or return "$arg: $!\n";
388 } elsif ($opt eq "d") {
390 } elsif ($opt eq "r") {
392 } elsif ($opt eq "D") {
393 $arg ||= shift @options;
394 foreach $arg (split(//, $arg)) {
397 } elsif ($arg eq "O") {
399 } elsif ($arg eq "t") {
409 foreach $objname (@options) {
410 $objname = "main::$objname" unless $objname =~ /::/;
411 eval "xref_object(\\&$objname)";
412 die "xref_object(\\&$objname) failed: $@" if $@;