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
Back to
Craft