Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Prettified Perl Inheritance

by Kageneko (Scribe)
on Jul 29, 2003 at 17:40 UTC ( #278901=perlcraft: print w/ replies, xml ) Need Help??

   1: # (Please move this node if it belongs in Snippets or something)
   2: #
   3: # This little program will print a prettified inheritance
   4: # tree for the given perl module.  Its usage is:
   5: # perl-inheritance [<options>] <module-name>
   6: # e.g.: perl-inheritance Class::DBI
   7: #
   8: # Available options are:
   9: # -I<path> : include <path> in @INC
  10: # -a : attempt to use all modules instead of just the root one
  11: # -i : ignore modules that can't be found
  12: #
  13: # Some example output:
  14: # perl-inheritance Class::DBI
  15: # Class::DBI (v0.93)
  16: # +---Class::DBI::__::Base (v-1, set by base.pm)
  17: #     +---Class::Data::Inheritable (v0.02)
  18: #     +---Class::Accessor (v0.18)
  19: #     +---Ima::DBI (v0.29)
  20: #         +---Class::WhiteHole (v0.04)
  21: #         +---DBI (v1.37)
  22: #         |   +---Exporter (v5.567)
  23: #         |   +---DynaLoader (v1.04)
  24: #         +---Class::Data::Inheritable (loaded by Class::DBI::__::Base)
  25: #
  26: # perl-inheritance Net::FTP
  27: # Net::FTP (v2.71)
  28: # +---Exporter (v5.567)
  29: # +---Net::Cmd (v2.24)
  30: # |   +---Exporter (loaded by Net::FTP)
  31: # +---IO::Socket::INET (v1.26)
  32: #     +---IO::Socket (v1.27)
  33: #         +---IO::Handle (v1.21)
  34: #             +---Exporter (loaded by Net::FTP)
  35: 
  36: #!/usr/local/bin/perl -w
  37: use warnings;
  38: use strict;
  39: no strict 'refs';
  40: 
  41: my @ignore_list      = ();
  42: my $ignore_not_found = 0;
  43: my %already_loaded   = ();
  44: my $load_all         = 0;
  45: 
  46: ARG: while (@ARGV) {
  47:   SWITCH: {
  48:     ($ARGV[0] =~ /\-I(.+)/o) && do {
  49:       eval "use lib '$1';";
  50:       shift @ARGV;
  51:      last SWITCH;
  52:     };
  53:     ($ARGV[0] =~ /\-i$/o) && do {
  54:       $ignore_not_found = 1;
  55:       shift @ARGV;
  56:      last SWITCH;
  57:     };
  58:     ($ARGV[0] =~ /\-a$/o) && do {
  59:       $load_all = 1;
  60:       shift @ARGV;
  61:      last SWITCH;
  62:     };
  63:     ($ARGV[0] =~ /\-i=(.+)/o) && do {
  64:       @ignore_list = split " ", $1;
  65:       shift @ARGV;
  66:      last SWITCH;
  67:     };
  68:    last ARG;
  69:   } ## end SWITCH:
  70: } ## end while (@ARGV)
  71: 
  72: if (!@ARGV) {
  73:   print STDERR "Usage: $0 <perl modules>\n";
  74:   exit 1;
  75: }
  76: 
  77: foreach (@ARGV) {
  78:   %already_loaded = ();
  79:   ScanModule(undef, $_, 0);
  80: }
  81: 
  82: sub ScanModule {
  83:   my $parent  = shift;
  84:   my $module  = shift;
  85:   my $depth   = shift;
  86:   my @total   = @_;
  87:   my $ignored = 0;
  88:   my $loaded  = 0;
  89: 
  90:   $loaded = 1 if (exists $already_loaded{$module});
  91: 
  92:   eval "use $module" if (!defined $parent || $load_all);
  93:   if ($@ =~ /Can't locate .+ in \@INC/o) {
  94:     if ($ignore_not_found
  95:       || index("@ignore_list ", "$module ") != -1) {
  96:       $ignored = 1;
  97:       } else {
  98:       die "Error using $module: $@\n";
  99:     }
 100:   } elsif ($@) {
 101:     die "Error using $module: $@\n";
 102:   }
 103: 
 104:   if ($depth > 1) {
 105:     for (my $iter = 0; $iter < @total - 2; $iter += 2) {
 106:       if ($total[$iter] < $total[$iter + 1]) {
 107:         print "|   ";
 108:       } else {
 109:         print "    ";
 110:       }
 111:     } ## end for (my $iter = 0; $iter...
 112:   } ## end if ($depth > 1)
 113: 
 114:   if ($depth > 0) {
 115:     print "+---";
 116:   }
 117: 
 118:   print $module;
 119:   print " (ignored)" if ($ignored);
 120:   if ($loaded) {
 121:     print " (loaded by $already_loaded{$module})\n";
 122:   } else {
 123:     my $version = $module->VERSION();
 124:     print " (v$version)" if $version;
 125:     print "\n";
 126:     my $isa   = "${module}::ISA";
 127:     my $count = 1;
 128:     my $total = @$isa;
 129: 
 130:     foreach (@$isa) {
 131:       ScanModule($module, $_, $depth + 1, @total, $count, $total);
 132:       $count++;
 133:     }
 134:     $already_loaded{$module} = $parent;
 135:   } ## end else [ if ($loaded)
 136: } ## end sub ScanModule

Comment on Prettified Perl Inheritance
Download Code
Re: Prettified Perl Inheritance
by bsb (Priest) on Aug 03, 2003 at 07:01 UTC
    See also GraphViz::ISA and pmload in pmtools (basic).

    Diamond inheritence will get tree-ified won't it?

    Also, use/require already remembers loaded modules in %INC:

    $ perl -MDBI -le '$,="\n"; print %INC' warnings/register.pm /usr/share/perl/5.8.0/warnings/register.pm Carp.pm /usr/share/perl/5.8.0/Carp.pm Exporter/Heavy.pm /usr/share/perl/5.8.0/Exporter/Heavy.pm strict.pm /usr/share/perl/5.8.0/strict.pm continues ...

      Hmm, I haven't done any testing with diamond inheritance. I know that I setup the code to not follow an inheritance tree more than once, so it wouldn't get into infinite loops.

      The reason I didn't use %INC for testing whether a module was loaded was because I wanted to record which module had loaded it first (well, in the tree-scheme of things :) and didn't really care where the file existed.

      Thanks for the tip (and thanks to PodMaster for his) regarding the graphing modules.
Re: Prettified Perl Inheritance
by metaperl (Curate) on Jul 07, 2011 at 22:16 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlcraft [id://278901]
Approved by dragonchild
Front-paged by broquaint
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (10)
As of 2015-05-05 19:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    In my home, the TV remote control is ...









    Results (125 votes), past polls