lib/Sepia/Xref.pm

   1 #!/usr/bin/env perl
   2 package Sepia::Xref;
   3
   4 =head1 NAME
   5
   6 Sepia::Xref - Generates cross reference database for use by Perl programs.
   7
   8 =head1 SYNOPSIS
   9
  10     use Sepia::Xref qw(rebuild defs callers);
  11
  12     rebuild;
  13     for (defs 'foo') {
  14         printf "%s:%d: sub %s\::foo() defined\n", @{$_}[0..2];
  15     }
  16
  17     for (callers 'foo') {
  18         printf "%s:%d: sub foo() called by %s\::%s().\n", @{$_}[0..3];
  19     }
  20
  21 =head1 DESCRIPTION
  22
  23 C<Sepia::Xref> is intended as a programmatic interface to the
  24 information supplied by L<B::Xref>.  It is intended to be a component
  25 for interactive Perl development, with other packages providing a
  26 friendly interface to the raw information it extracts.  C<B::Xref>
  27 could be seen as an example of this sort of user-level tool, if it
  28 weren't for the fact that this module was created later, and stole
  29 most of its code.
  30
  31 =cut
  32
  33 # use Sepia '_apropos_re';
  34 require Sepia;
  35 BEGIN { *_apropos_re = *Sepia::_apropos_re; }
  36
  37 # uncomment for development
  38 # use strict;
  39 use Config;
  40 use Cwd 'abs_path';
  41 use B qw(peekop class comppadlist main_start svref_2object walksymtable
  42          OPpLVAL_INTRO SVf_POK OPpOUR_INTRO OPf_MOD OPpDEREF_HV OPpDEREF_AV
  43          cstring);
  44 # stupid warnings...
  45 no warnings 'uninitialized';
  46
  47 =head2 Variables
  48
  49 =over
  50
  51 =item C<%call>
  52
  53 A map of subs to call locations and callers
  54
  55 =item C<%callby>
  56
  57 A map of subs to subs called.
  58
  59 =item C<%var_use>
  60
  61 A map of global/package variables to uses.
  62
  63 =item C<%var_def>
  64
  65 A map of global/package variables to definitions (usually empty, since
  66 it only picks up local (...) declarations.
  67
  68 =back
  69
  70 =cut
  71
  72 our %call;
  73 our %callby;
  74 our %var_def;
  75 our %var_use;
  76
  77 require Exporter;
  78 our @ISA = 'Exporter';
  79 my @most = qw(redefined forget rebuild callers callees
  80               var_defs var_uses
  81               var_apropos);
  82 our @EXPORT_OK = (@most,
  83     qw(xref_definitions xref_object xref_main
  84        %call %callby %var_use %var_def));
  85
  86 our %EXPORT_TAGS =
  87     (':all' => \@EXPORT_OK,
  88      ':most' => \@most);
  89
  90 ######################################################################
  91 ## Xref state variables:
  92
  93 sub UNKNOWN { ["?", "?", "?"] }
  94
  95 my @pad;                        # lexicals in current pad
  96                                 # as ["(lexical)", type, name]
  97 my @padval;
  98 our %done;                      # keyed by $$op: set when each $op is done
  99 my $top = UNKNOWN;              # shadows top element of stack as
 100                                 # [pack, type, name] (pack can be "(lexical)")
 101 our $file;                      # shadows current filename
 102 my $line;                       # shadows current line number
 103 our $subname;                   # shadows current sub name
 104 our @todo = ();                 # List of CVs that need processing
 105 my $lastclass;                  # last bareword seen after entersub.
 106
 107 our $DEBUG = 0;
 108 sub dprint {
 109     my $type = shift;
 110     my $res = "@_";
 111     $res =~ s/%//g;             # XXX: work around EPL's misuse of (message)
 112     print STDERR "@_" if $DEBUG =~ /$type/;
 113 }
 114
 115 my %code = (intro => "i", used => "",
 116             subdef => "s", subused => "&",
 117             formdef => "f", meth => "->");
 118
 119 =head2 Functions
 120
 121 =over 4
 122
 123 =item C<guess_module_file($pack, $ofile)>
 124
 125 XXX: it turns out that rooting around trying to figure out the file
 126 ourselves is more reliable than what we grab from the op.  Are we
 127 doing this wrong?
 128
 129 =cut
 130
 131 sub guess_module_file {
 132     my ($pack, $ofile) = @_;
 133     my $file;
 134
 135     # XXX: is this why we get the bogus defs?
 136     return undef if $ofile =~ /Exporter\.pm$/;
 137     # Try for standard translation in %INC:
 138     (my $fn = $pack) =~ s/::/\//g;
 139     return unless $fn;          # stupid warnings...
 140     if (exists $INC{"$fn.pm"}) {
 141         return $INC{"$fn.pm"};
 142     }
 143
 144     # Try what they told us:
 145     chomp $ofile;
 146     return $ofile if -f $ofile;
 147
 148     # Try "parent" packages:
 149     while ($fn =~ s|/?[^/]+$|| && !$file) {
 150         $file ||= $INC{"$fn.pm"};
 151     }
 152
 153     if ($file && $file !~ /^\//) {
 154         $file = abs_path($file);
 155     }
 156
 157     if (!$file || !-f $file) {
 158         undef $file;
 159     }
 160     $file;
 161 }
 162
 163 # XXX: should weed through the code below so it only generates decent
 164 # package names, but this will fix it for now.
 165 sub realpack {
 166     my $p = shift;
 167     if (!defined $p || $p eq '?' || $p eq '(method)') {
 168         return undef;
 169     } elsif ($p eq '') {
 170         return 'main';
 171     } else {
 172         return $p;
 173     }
 174 }
 175
 176 # Turn a possibly-qualified name into a package and basename.
 177 sub split_name {
 178     local $_ = shift;
 179     my ($p, $s);
 180     if (/^(.*)::(.+)$/) {
 181         ($p, $s) = ($1, $2);
 182     } else {
 183         ($p, $s) = ('main', $_);
 184     }
 185     undef $s if $s eq '?';
 186     ($p, $s);
 187 }
 188
 189 sub process {
 190     my ($var, $event) = @_;
 191     my ($pack, $type, $name) = @$var;
 192     $pack = realpack($pack);
 193     dprint 'loud', "Processing $event: @$var ($subname)";
 194     if ($type eq "*") {
 195         if ($event eq "used" || $event eq 'set') {
 196             return;
 197         } elsif ($event eq "subused") {
 198             $type = "&";
 199         } elsif ($event eq "meth") {
 200             $type = '->';
 201         }
 202     }
 203     $type =~ s/(.)\*$/$1/g;
 204     $file = guess_module_file($pack, $file);
 205
 206     if (($type eq '&' || $type eq '->') && $subname ne '(definitions)') {
 207         # Handle caller/callee relations
 208         my ($spack, $sname) = split_name($subname);
 209
 210         $call{$name}{$pack}{$subname} = 1;
 211         $callby{$sname}{$spack}{"$pack\::$name"} = 1;
 212     } elsif ($type eq 's' || $subname eq '(definitions)') {
 213         # definition
 214     } elsif ($name !~ /^[\x00-\x1f^] | ^\d+$ | ^[\W_]$
 215                        | ^(?:ENV|INC|STD(?:IN|OUT|ERR)|SIG)$ /x
 216              && realpack($pack)) {
 217         # Variables, but ignore specials and lexicals
 218         my ($spack, $sname) = split_name($subname);
 219         if ($event eq 'intro') {
 220             $var_def{$name}{$pack} =
 221             { file => $file,
 222               package => $spack,
 223               line => $line,
 224               sub => $sname,
 225             };
 226         } elsif ($event eq 'used' || $event eq 'set') {
 227             push @{$var_use{$name}{$pack}},
 228             { file => $file,
 229               package => $spack,
 230               line => $line,
 231               sub => $sname,
 232               assign => ($event eq 'set'),
 233             };
 234         } else {
 235             dprint 'ignore', "Ignoring var event $event";
 236         }
 237     } else {
 238         dprint 'ignore', "Ignoring $type event $event";
 239     }
 240 }
 241
 242 sub load_pad {
 243     my $padlist = shift;
 244     my ($namelistav, $vallistav, @namelist, $ix);
 245     @pad = ();
 246     @padval = ();
 247     return if class($padlist) eq "SPECIAL";
 248     ($namelistav,$vallistav) = $padlist->ARRAY;
 249     @namelist = $namelistav->ARRAY;
 250     for ($ix = 1; $ix < @namelist; $ix++) {
 251         my $namesv = $namelist[$ix];
 252         next if class($namesv) eq "SPECIAL";
 253         my ($type, $name) = $namesv->PV =~ /^(.)([^\0]*)(\0.*)?$/;
 254         $pad[$ix] = [undef, $type, $name];
 255     }
 256     if ($Config{useithreads}) {
 257         my (@vallist);
 258         @vallist = $vallistav->ARRAY;
 259         for ($ix = 1; $ix < @vallist; $ix++) {
 260             my $valsv = $vallist[$ix];
 261             next unless class($valsv) eq "GV";
 262             # these pad GVs don't have corresponding names, so same @pad
 263             # array can be used without collisions
 264
 265             # XXX: for some reason, on 5.10 $valsv->STASH can be a
 266             # B::SPECIAL, which doesn't have a name.
 267
 268             # XXX: this segfaults on 5.10 for some reason while
 269             # traversing File::Find::contract_name from main
 270
 271             next if ref $valsv->STASH eq 'B::SPECIAL';
 272             $pad[$ix] = [$valsv->STASH->NAME, "*", $valsv->NAME];
 273         }
 274     }
 275     @padval = $vallistav->ARRAY;
 276 }
 277
 278 sub xref {
 279     my $start = shift;
 280     my $op;
 281     for ($op = $start; $$op; $op = $op->next) {
 282         last if $done{$$op}++;
 283         my $opname = $op->name;
 284         if ($opname =~ /^(or|and|mapwhile|grepwhile|range|cond_expr)$/) {
 285             xref($op->other);
 286         } elsif ($opname eq "match" || $opname eq "subst") {
 287             xref($op->pmreplstart);
 288         } elsif ($opname eq "substcont") {
 289             xref($op->other->pmreplstart);
 290             $op = $op->other;
 291             redo;
 292         } elsif ($opname eq "enterloop") {
 293             xref($op->redoop);
 294             xref($op->nextop);
 295             xref($op->lastop);
 296         } elsif ($opname eq "subst") {
 297             xref($op->pmreplstart);
 298         } else {
 299             no strict 'refs';
 300             my $ppname = "pp_$opname";
 301             &$ppname($op) if defined(&$ppname);
 302         }
 303     }
 304 }
 305
 306 sub xref_cv {
 307     my $cv = shift;
 308     my $pack = $cv->GV->STASH->NAME;
 309     local $subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
 310     load_pad($cv->PADLIST);
 311     xref($cv->START);
 312 }
 313
 314 sub xref_object {
 315     my $cvref = shift;
 316     local (@todo, %done);
 317     my $cv = svref_2object($cvref);
 318     xref_cv($cv);
 319     dprint 'todo', "todo = (@todo)";
 320     my $gv = $cv->GV;
 321     process([$gv->STASH->NAME, '&', $gv->NAME], 'subdef');
 322 }
 323
 324 sub xref_main {
 325     $subname = "(main)";
 326     load_pad(comppadlist);
 327     xref(main_start);
 328     while (@todo) {
 329         xref_cv(shift @todo);
 330     }
 331 }
 332
 333 sub pp_pushmark {
 334     my $op = shift;
 335     my ($class, $meth);
 336     if (($class = $op->next)->name eq 'const') {
 337         my $sv = $class->sv;
 338         my $classname;
 339         # constant could be in the pad (under useithreads)
 340         if (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) {
 341             $classname = $sv->PV;
 342         } else {
 343             my $pv = $padval[$class->targ];
 344             if (class($pv) =~ /^PV/ && class($sv) eq 'SPECIAL'
 345                 ## bareword flag -- should use this?
 346 #                 && ($op->private & 64)
 347                ) {
 348                 $classname = $pv->PV;
 349             }
 350         }
 351         $lastclass = $classname;
 352     }
 353 }
 354
 355 sub pp_nextstate {
 356     my $op = shift;
 357     $file = $op->file;
 358     die "pp_nextstate: $file" if $file =~ /::/;
 359     $line = $op->line;
 360     $top = UNKNOWN;
 361 }
 362
 363 sub use_type($) {
 364     my ($op) = @_;
 365     if ($op->private & (OPpLVAL_INTRO | OPpOUR_INTRO)) {
 366         'intro';
 367     } elsif ($op->flags & OPf_MOD
 368              && !($op->private & (OPpDEREF_HV | OPpDEREF_AV))) {
 369         'set';
 370     } else {
 371         'used';
 372     }
 373 }
 374
 375 sub pp_padsv {
 376     my $op = shift;
 377      $top = $pad[$op->targ];
 378 #     process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
 379 }
 380
 381 sub pp_padav { pp_padsv(@_) }
 382 sub pp_padhv { pp_padsv(@_) }
 383
 384 sub deref {
 385     my ($op, $var, $as) = @_;
 386     $var->[1] = $as . $var->[1];
 387     process($var, use_type $op);
 388 }
 389
 390 sub pp_rv2cv { deref(shift, $top, "&"); }
 391 sub pp_rv2hv { deref(shift, $top, "%"); }
 392 sub pp_rv2sv { deref(shift, $top, "\$"); }
 393 sub pp_rv2av { deref(shift, $top, "\@"); }
 394 sub pp_rv2gv { deref(shift, $top, "*"); }
 395
 396 sub pp_gvsv {
 397     my $op = shift;
 398     my $gv;
 399     if ($Config{useithreads}) {
 400         $top = $pad[$op->padix];
 401         $top = UNKNOWN unless $top;
 402         $top->[1] = '$';
 403     }
 404     else {
 405         $gv = $op->gv;
 406         $top = [$gv->STASH->NAME, '$', $gv->SAFENAME];
 407     }
 408     process($top, use_type $op);
 409 }
 410
 411 sub pp_gv {
 412     my $op = shift;
 413     my $gv;
 414     if ($Config{useithreads}) {
 415         $top = $pad[$op->padix];
 416         $top = UNKNOWN unless $top;
 417         $top->[1] = '*';
 418     }
 419     else {
 420         $gv = $op->gv;
 421         $top = [$gv->STASH->NAME, "*", $gv->SAFENAME];
 422     }
 423     process($top, use_type $op);
 424 }
 425
 426 sub pp_method {
 427     my $op = shift;
 428     $top = [$lastclass || "(method)", "->".$top->[1], $top->[2]];
 429     dprint 'method', "pp_method($top->[1])";
 430     undef $lastclass;
 431 }
 432
 433 sub pp_method_named {
 434     use Data::Dumper;
 435     my $op = shift;
 436     my $sv = $op->sv;
 437     my $pviv = $padval[$op->targ];
 438     if ($pviv && class($pviv) =~ /^PV/) {
 439         my $name = $pviv->PV;
 440         dprint 'method_named', $op->targ.": $name";
 441         undef $top->[2] if $top->[2] eq '?';
 442         $top = [$lastclass || "(method)", '->', $name];
 443         undef $lastclass;
 444     } else {
 445         dprint 'method_named', "method_named: wtf: sizeof padval = ".@padval;
 446     }
 447 }
 448
 449 sub pp_entersub {
 450     my $op = shift;
 451     if ($top->[1] =~ /^(?:m$|->)/) {
 452         dprint 'method', "call to (@$top) from $subname";
 453         process($top, "meth");
 454     } else {
 455         process($top, "subused");
 456     }
 457     undef $lastclass;
 458     $top = UNKNOWN;
 459 }
 460
 461 #
 462 # Stuff for cross referencing definitions of variables and subs
 463 #
 464
 465 sub B::GV::xref {
 466     my $gv = shift;
 467     my $cv = $gv->CV;
 468     $file = $gv->FILE;
 469     # XXX: sometimes the "file" is a module.  Why?
 470     $line = $gv->LINE;
 471     if ($$cv) {
 472         #return if $done{$$cv}++;
 473         process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
 474         push(@todo, $cv);
 475     }
 476     my $form = $gv->FORM;
 477     if ($$form) {
 478         return if $done{$$form}++;
 479         process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
 480     }
 481 }
 482
 483 ## Exclude all pragmatic modules (lowercase first letter) and the
 484 ## following problematic things, which tend to cause more harm than
 485 ## good when they get xref'd:
 486 my %exclude;
 487 BEGIN {
 488     undef $exclude{"$_\::"}
 489         for qw(B O AutoLoader DynaLoader XSLoader Config DB VMS
 490                FileHandle Exporter Carp PerlIO::Layer);
 491 }
 492
 493 sub xref_exclude {
 494     my $x = shift;
 495     $x =~ /^[a-z]/ || exists $exclude{$x};
 496 }
 497
 498 sub xref_definitions {
 499     my ($pack, %exclude);
 500     $subname = "(definitions)";
 501     no strict qw(vars refs);
 502     walksymtable(\%{"main::"}, "xref", sub { !xref_exclude($_[0]) });
 503 }
 504
 505 =item C<rebuild()>
 506
 507 Rebuild the Xref database.
 508
 509 =cut
 510
 511 sub rebuild {
 512     %call = (); %callby = ();
 513     %var_def = (); %var_use = ();
 514     local (@todo, %done);
 515     xref_definitions;
 516     xref_main;
 517     1;
 518 }
 519
 520 sub unmention {
 521     my ($h, $K, $V, $pack) = @_;
 522     dprint 'unmention', "Unmentioning $K => $V";
 523     while (my ($k, $v) = each %$h) {
 524         while (my ($k2, $v2) = each %$v) {
 525             if (ref $v2 eq 'ARRAY') {
 526                 $v->{$k2} = [grep {
 527                     $_->{$K} ne $V || !$pack || $pack ne $_->{package}
 528                 } @$v2];
 529                 delete $v->{$k2} unless @{$v->{$k2}};
 530             } else {
 531                 delete $v->{$k2} if $k2 eq $V;
 532             }
 533         }
 534         delete $h->{$k} unless keys %{$h->{$k}};
 535     }
 536 }
 537
 538 sub unmention_sub {
 539     my ($h, $sub, $pack) = @_;
 540     dprint 'unmention', "Unmentioning $pack\::$sub";
 541     if ($pack) {
 542         delete $h->{$sub}{$pack};
 543         delete $h->{$sub} unless keys %{$h->{$sub}};
 544     } else {
 545         delete $h->{$sub};
 546     }
 547 }
 548
 549 =item C<forget($func [, $mod])>
 550
 551 Forget that C<$func> was defined.
 552
 553 =cut
 554
 555 sub forget {
 556     my ($obj, $pack) = @_;
 557     unmention_sub \%callby, @_;
 558     unmention \%call, 'sub', @_;
 559     unmention \%var_use, 'sub', @_;
 560     unmention \%var_def, 'sub', @_;
 561 }
 562
 563 =item C<redefined($func [, $pack])>
 564
 565 Recompute xref info for C<$func>, or C<$pack::$func> if C<$pack> given.
 566
 567 =cut
 568
 569 sub redefined {
 570     forget @_;
 571     {
 572         no strict 'refs';
 573         my ($sub, $pack) = @_;
 574         $pack ||= 'main';
 575         $sub = $pack eq 'main' ? $sub : "$pack\::$sub";
 576         local $subname = '(definitions)';
 577         xref_object \&$sub;
 578     }
 579 }
 580
 581 ######################################################################
 582 # Apropos and definition-finding:
 583
 584 sub _ret_list
 585 {
 586     my ($h, $sub, $mod) = @_;
 587     if ($sub =~ /^(.*)::([^:]+)$/) {
 588         $sub = $2;
 589         $mod = $1;
 590     }
 591     $h = $h->{$sub};
 592     my @r;
 593     if ($mod) {
 594         @r = keys %{$h->{$mod}};
 595     } else {
 596 #        @r = map { @$_ } values %$h;
 597         my %h;
 598         @h{keys %$_} = 1 for values %$h;
 599         @r = keys %h;
 600     }
 601     @r = sort @r;
 602     return wantarray ? @r : \@r;
 603 }
 604
 605 sub _var_ret_list
 606 {
 607     my ($h, $v, $mod, $assign) = @_;
 608     if ($v =~ /^(.*)::([^:]+)$/) {
 609         $mod = $1;
 610         $v = $2;
 611     }
 612     $h = $h->{$v};
 613     my @r;
 614     if ($mod) {
 615         @r = exists $h->{$mod} ? @{$h->{$mod}} : ();
 616     } else {
 617         ## XXX: Need to revisit when this is/isn't an array!
 618         @r = map { ref $_ eq 'ARRAY' ? @$_ : $_ } values %$h;
 619     }
 620     @r = grep $_->{assign}, @r if $assign;
 621     @r = map { [@{$_}{qw(file line sub package)}] } @r;
 622     return wantarray ? @r : \@r;
 623 }
 624
 625 =item C<callers($func)>
 626
 627 List callers of C<$func>.
 628
 629 =cut
 630
 631 sub callers {
 632     _ret_list \%call, @_;
 633 }
 634
 635 =item C<callees($func)>
 636
 637 List callees of C<$func>.
 638
 639 =cut
 640
 641 sub callees {
 642     _ret_list \%callby, @_;
 643 }
 644
 645 =item C<var_defs($var)>
 646
 647 Find locations where C<$var> is defined.
 648
 649 =cut
 650
 651 sub var_defs {
 652     return _var_ret_list \%var_def, @_;
 653 }
 654
 655 =item C<var_uses($var)>
 656
 657 Find locations where C<$var> is used.
 658
 659 =cut
 660
 661 sub var_uses {
 662     return _var_ret_list \%var_use, @_;
 663 }
 664
 665 =item C<var_assigns($var)>
 666
 667 Find locations where C<$var> is assigned to.
 668
 669 =cut
 670
 671 sub var_assigns {
 672     my ($v, $pack) = @_;
 673     return _var_ret_list \%var_use, $v, $pack, 1;
 674 }
 675
 676 =item C<file_modules($file)>
 677
 678 List the modules defined in file C<$file>.
 679
 680 =cut
 681
 682 sub file_modules {
 683     my $file = shift;
 684     eval {
 685         require Module::Info;
 686         my $mod = Module::Info->new_from_file(abs_path($file));
 687         if ( $mod ) {
 688             return $mod->packages_inside();
 689         }
 690     }
 691 }
 692
 693 =item C<var_apropos($expr)>
 694
 695 Find variables matching C<$expr>.
 696
 697 =cut
 698
 699 sub _apropos {
 700     my ($h, $re, $mod) = @_;
 701     my @r = do {
 702         if($re) {
 703             $re = _apropos_re($re);
 704             sort grep /$re/, keys %$h;
 705         } else {
 706             sort keys %$h;
 707         }
 708     };
 709     if ($mod) {
 710         $mod = _apropos_re($mod);
 711         my %r;
 712         for (@r) {
 713             my $sn = $_;
 714             for (keys %{$h->{$_}}) {
 715                 $r{$_ eq 'main' ? $sn : "$_\::$sn"} = 1 if /$mod/;
 716             }
 717         }
 718         @r = sort keys %r;
 719     }
 720     return wantarray ? @r : \@r;
 721 }
 722
 723 sub var_apropos {
 724     _apropos \%var_use, @_;
 725 }
 726
 727 1;
 728
 729 __END__
 730
 731 =back
 732
 733 =head1 EXPORTS
 734
 735 Nothing by default, but all sub and variable described above can be
 736 imported.  C<Sepia::Xref> also defines the tags C<:most> for the
 737 above-listed functions, and C<:all> for those and the variables as
 738 well.
 739
 740 =head1 BUGS
 741
 742 =over 4
 743
 744 =item See L<B::Xref>.
 745
 746 =item module names are ignored when looking up a sub.
 747
 748 =item file and line number guessing is evil
 749
 750 Both should be done more cleanly and effectively.  This is a hack
 751 because I don't quite understand what perl saves.  We should be able
 752 to do as well as its warning messages.
 753
 754 =item Some packages are not xref'd.
 755
 756 Some "internal" packages are deliberately not cross-referenced, either
 757 because they are hairy and cause us problems, or because they are so
 758 commonly included as to be uninteresting.  The current list includes
 759 all pragmatic modules, plus: B, O, AutoLoader, DynaLoader, XSLoader,
 760 Config, DB, VMS, FileHandle, Exporter, Carp, PerlIO::Layer.
 761
 762 =item Tree-view is not fully functional
 763
 764 Ideally, clicking the function names in tree view would take you to
 765 that function.  This doesn't work.  Also, more keys (like "q" to quit)
 766 should be implemented.
 767
 768 =back
 769
 770 =head1 SEE ALSO
 771
 772 C<B::Xref>, of which C<Sepia::Xref> is a bastard child.
 773
 774 =head1 AUTHOR
 775
 776 L<B::Xref> by Malcolm Beattie, m(angl|odifi)ed by Sean O'Rourke
 777 (seano@cpan.org).
 778
 779 =cut