/scripts/tests/perl_swiss_army_knife.pl

https://code.google.com/p/camelbox/ · Perl · 86 lines · 48 code · 17 blank · 21 comment · 5 complexity · 9a1e65763c5e4ec3a60ff9a80513abbd MD5 · raw file 

    

  1. #!/usr/bin/perl
    2. 

  2. # $Id: perl_swiss_army_knife.pl 367 2008-07-20 17:48:23Z elspicyjack $
    3. 

  3. 

  4. # A script to print out a bunch of info about the current Perl environment
    5. 

  5. # by Brian Manning (elspicyjack {at} gmail ⋅ com)
    6. 

  6. 

  7. # The original script most likely appears in the Perl Cookbook from O'Reilly.
    8. 

    9. 

  9. # if the script detects that it's running as under a CGI environment (the
    10. 

  10. # REQUEST_METHOD environment variable is set), it will wrap the plaintext
    11. 

  11. # output in the correct HTML tags so the browser will render it in the same
    12. 

  12. # manner as if the script were running in a shell.
    13. 

  13. 

  14. my @found_modules; # a list of modules that were found in @INC paths
    15. 

  15. my $i=1;	# a counter
    16. 

  16. 

  17. # are we CGI?
    18. 

  18. if ( exists $ENV{'REQUEST_METHOD'} ) {
    19. 

  19.     print "Content-type: text/html","\n\n";
    20. 

  20.     print "<html><body><pre>\n";
    21. 

  21. } # if ( exists $ENV{'REQUEST_METHOD'} )
    22. 

  22. 

  23. print "##################################################################\n";
    24. 

  24. print "# Perl Executable Name (\$^X)                                     #\n";
    25. 

  25. print "##################################################################\n";
    26. 

  26. print qq(Executable name: $^X\n\n);
    27. 

  27. 

  28. print "##################################################################\n";
    29. 

  29. print "# Perl Runtime Environment (\%ENV)                                #\n";
    30. 

  30. print "##################################################################\n";
    31. 

  31. 

  32. # print the runtime environment
    33. 

  33. foreach my $key ( sort(keys(%ENV)) ) {
    34. 

  34.     print(sprintf("%2d", $i) . qq( $key = ) . $ENV{$key} . qq(\n));
    35. 

  35. 	$i++;	
    36. 

  36. } # while (($key, $val) = each %ENV)
    37. 

  37. print "\n";
    38. 

  38. 

  39. $i=1;	# reset counter
    40. 

  40. 

  41. # print the @INC array
    42. 

  42. print "##################################################################\n";
    43. 

  43. print "# Perl Module Include Paths (\@INC)                               #\n";
    44. 

  44. print "##################################################################\n";
    45. 

  45. printf qq(%2d %s\n), $i++, $_ for sort(@INC);
    46. 

  46. print "\n";
    47. 

  47. 

  48. $i=0;	# reset counter
    49. 

  49. 

  50. # print installed modules
    51. 

  51. print "##################################################################\n";
    52. 

  52. print "# Installed Perl Modules (\&modules in \@INC)                      #\n";
    53. 

  53. print "##################################################################\n";
    54. 

  54. # NOTES
    55. 

  55. #   1. Prune man, pod, etc. directories
    56. 

  56. #   2. Skip files with a suffix other than .pm
    57. 

  57. #   3. Format the filename so that it looks more like a module
    58. 

  58. #   4. Print it
    59. 

  59. use File::Find;
    60. 

  60. foreach $start ( @INC ) { find(\&modules, $start); }
    61. 

  61. 

  62. # reset counter
    63. 

  63. my $i=1;
    64. 

  64. foreach $module ( sort(@found_modules) ) {
    65. 

  65.     printf qq(%4d %s\n), $i++, $module;
    66. 

  66. } # foreach $module ( sort(@found_modules) )
    67. 

  67. 

  68. # print the butt-end of the HTML if this is CGI
    69. 

  69. if ( exists $ENV{'REQUEST_METHOD'} ) {
    70. 

  70.     print "</body></html>\n";
    71. 

  71. } # if ( exists $ENV{'REQUEST_METHOD'} ) {
    72. 

  72. 

  73. exit 0;
    74. 

  74. 

  75. ### modules ###
    76. 

  76. sub modules {
    77. 

  77. 	if (-d && /^[a-z]/) { $File::Find::prune = 1; return; }
    78. 

  78. 		return unless /\.pm$/;
    79. 

  79.        	my $filename = "$File::Find::dir/$_";
    80. 

  80.       	$filename =~ s!^$start/!!;
    81. 

  81.        	$filename =~ s!\.pm$!!;
    82. 

  82.         $filename =~ s!/!::!g;
    83. 

  83.         push(@found_modules, $filename);
    84. 

  84. 		$i++;
    85. 

  85. } # sub modules
    86.