home *** CD-ROM | disk | FTP | other *** search
/ bombers.k12.ar.us / bombers.k12.ar.us.tar / bombers.k12.ar.us / cgi-bin / perldiver.pl < prev    next >
Perl Script  |  2001-07-05  |  8KB  |  277 lines
  1. #!/usr/bin/perl
  2.  
  3. ################################################################
  4. #                                                              #
  5. #                        PerlDiver v1.1                        #
  6. #          Copyright ⌐1999 - Tintagel Consulting, LLC          #
  7. #                    dba Script Solutions                      #
  8. #               http://www.scriptsolutions.com/                #
  9. #                     All rights reserved                      #
  10. #                                                              #
  11. ################################################################
  12. #                                                              #
  13. # PURPOSE OF PROGRAM:                                          #
  14. #                                                              #
  15. # PerlDiver v1.1 gives you the location of your sendmail       #
  16. # program, your path to perl, your environment variables and   #
  17. # most (not all) of the Perl modules that are installed on     #
  18. # your web server.                                             #
  19. #                                                              #
  20. #                                                              #
  21. # INSTRUCTIONS:                                                #
  22. #                                                              #
  23. # Complete instructions and the newest version are located at: #
  24. # http://www.scriptsolutions.com/programs/free/perldiver/      #
  25. #                                                              #
  26. #                                                              #
  27. # LICENSE AGREEMENT:                                           #
  28. #                                                              #
  29. # By downloading and installing PerlDiver v1.1, you have       #
  30. # agreed to indemnify, defend, and hold harmless Tintagel      #
  31. # Consulting, LLC dba Script Solutions from any and all        #
  32. # liability, penalties, losses, damages, costs, expenses,      #
  33. # attorneys' fees, causes of action or claims caused by or     #
  34. # resulting indirectly from your use of this script which      #
  35. # damages either you, or any other party or parties without    #
  36. # limitation or exception. This indemnification and hold       #
  37. # harmless agreement extends to all issues associated with     #
  38. # this script.                                                 #
  39. #                                                              #
  40. ################################################################
  41.  
  42.  
  43. ################################################################
  44. #                DO NOT CHANGE ANYTHING BELOW                  #
  45.  
  46. $sendmail    =`whereis sendmail`;
  47. $plocation    =`whereis perl`;
  48. @perlloc     = split(" ",$plocation);
  49. @mailloc     = split(" ",$sendmail);
  50. $font = '<FONT FACE="Verdana, sans serif" SIZE=2>';
  51. &vars;
  52.  
  53. print "Content-type:  text/html\n\n";
  54.  
  55. print qq~
  56. <HTML><HEAD><TITLE>$program $version</TITLE></HEAD>
  57. <LINK REL="stylesheet"
  58.  HREF="http://www.scriptsolutions.com/images/style.css"
  59.  TYPE="text/css">
  60. <body bgcolor="#FFFFFF" ALINK="#FDB900" LINK="#BF0425"
  61.  VLINK="#1200FD" TOPMARGIN=0 LEFTMARGIN=0 RIGHTMARGIN=0>
  62. <TABLE WIDTH=100% BGCOLOR=#FDB900 CELLPADDING=2
  63.  CELLSPACING=0 BORDER=0
  64.  BACKGROUND="http://www.scriptsolutions.com/cgi-bin/bannertrak/bannertrak.cgi?aff=${program}_${version}&img=top.GIF">
  65. <TR>
  66. <TH> <BR> </TD>
  67. </TR>
  68. </TABLE>
  69. <P ALIGN=CENTER>
  70. <FONT FACE="Courier New,mono" SIZE=3 COLOR="#BF0425">
  71. <B>
  72. <A HREF="http://www.scriptsolutions.com/" TARGET="_blank">$dev</A>
  73. <BR>
  74. <FONT SIZE=6>$program $version</FONT>
  75. </FONT>
  76. </P>
  77. </B>
  78. <P>
  79. <DIV ALIGN=CENTER>
  80. <TABLE WIDTH=100% BGCOLOR="#FDB900" CELLPADDING=2 CELLSPACING=0 BORDER=0>
  81. <TR>
  82. <TH>$font<FONT SIZE=4>Server Program Paths</FONT></FONT>
  83. </TD>
  84. </TR>
  85. </TABLE>
  86. <P>
  87. <TABLE BORDER=0 CELLPADDING=3 WIDTH=95%>
  88. <TR>
  89. <TD BGCOLOR="$bgcolor" WIDTH=35%>${font}<B>Perl Executable:</B></TD>
  90. <TD WIDTH=65%>${font}$^X</TD>
  91. </TR>
  92. <TR>
  93. <TD BGCOLOR="$bgcolor">${font}<B>Perl Version:</B></TD>
  94. <TD>${font}$]</TD>
  95. </TR>
  96. <TR>
  97. <TD BGCOLOR="$bgcolor">${font}<B>PERL compile version OS:</B></TD>
  98. <TD>${font}$^O</TD>
  99. </TR>
  100. <TR>
  101. <TD BGCOLOR="$bgcolor">${font}<B>GID</B>: <FONT SIZE=1>(If not blank, you are on a machine that supports membership in multiple groups simultaneously)</FONT></TD>
  102. <TD>${font}$<</TD>
  103. </TR>
  104. <TR>
  105. <TD VALIGN=TOP BGCOLOR="$bgcolor">${font}<B>Location of Perl:</B></TD>
  106. <TD>${font}
  107. ~;
  108.  
  109. foreach $loc(@perlloc){
  110.     print "$loc<BR>\n";
  111.     }
  112.  
  113. print qq~
  114. </TD>
  115. </TR>
  116. <TR>
  117. <TD VALIGN=TOP BGCOLOR="$bgcolor">${font}<B>Location of Sendmail:</B></TD>
  118. <TD>${font}
  119. ~;
  120.  
  121. foreach $ml(@mailloc){
  122.     print "$ml<BR>\n";
  123.     }
  124.  
  125. print qq~
  126. </TD>
  127. </TR>
  128. <TR>
  129. <TD VALIGN=TOP BGCOLOR="$bgcolor">${font} <B>Directory locations searched for perl executables</B></TD>
  130. <TD>$font
  131. ~;
  132.  
  133. foreach $item(@INC){
  134.     print "$item <BR>\n";
  135.     }
  136.  
  137. print qq~
  138. </TD>
  139. </TR>
  140. </TABLE>
  141. <P>
  142. <TABLE WIDTH=100% BGCOLOR=#FDB900 CELLPADDING=2 CELLSPACING=0 BORDER=0>
  143. <TR>
  144. <TH>$font<FONT SIZE=4>Environment Variables</FONT></TD>
  145. </TR>
  146. </TABLE>
  147. <P>
  148. <TABLE BORDER=0 CELLPADDING=3 WIDTH=95%>
  149. ~;
  150.  
  151. foreach $fieldname(keys %ENV){
  152.     print qq~
  153.     <TR><TD BGCOLOR="$bgcolor" WIDTH=35%><B>${font}$fieldname</B></TD>
  154.     <TD WIDTH=65%>${font}$ENV{$fieldname}</TD>
  155.     </TR>
  156.     ~;
  157.     }
  158.     print qq~
  159.     </TABLE>
  160.     <P>
  161.     <TABLE WIDTH=100% BGCOLOR=#FDB900 CELLPADDING=2 CELLSPACING=0 BORDER=0>
  162.     <TR>
  163.     <TH>$font<FONT SIZE=4>Installed Modules</FONT></TD>
  164.     </TR>
  165.     </TABLE>
  166.     <P>
  167.     <TABLE BORDER=0 CELLPADDING=3 WIDTH=100%>
  168.     ~;
  169.  
  170. find(\&wanted,@INC);
  171.  
  172. $modcount = 0;
  173.  
  174. foreach $line(@foundmods){
  175.     $match = lc($line);
  176.     if ($found{$line}[0] >0){
  177.         $found{$line} = [$found{$line}[0]+1,$match];
  178.         }
  179.     else {
  180.         $found{$line} = ["1",$match];
  181.         $modcount++;
  182.         }
  183.     }
  184.  
  185. @foundmods = sort count keys(%found);
  186.  
  187. ######################################################
  188. sub count {
  189.     return $found{$a}[1] cmp $found{$b}[1]
  190.     }
  191. ######################################################
  192.  
  193. $third = $modcount/3;
  194. $count=0;
  195.  
  196. print "<TR><TD WIDTH=33% VALIGN=TOP><TABLE BORDER=0 CELLPADDING=1>";
  197.  
  198. foreach $mod(@foundmods){
  199.     chomp $mod;
  200.     $count++;
  201.     if ($count <= $third){
  202.         print qq~<TR><TD>${font}$mod</TD></TR>~;
  203.         }
  204.     else {
  205.         push (@mod1,$mod)
  206.         }
  207.     }
  208.  
  209. print "</TABLE></TD><TD WIDTH=33% VALIGN=TOP><TABLE BORDER=0 CELLPADDING=1>";
  210.  
  211. $count = 0;
  212.  
  213. foreach $mod1(@mod1){
  214.     chomp $mod1;
  215.     $count++;
  216.     if ($count <= $third){
  217.         print qq~<TR><TD>${font}$mod1</TD></TR>~;
  218.         }
  219.     else {
  220.         push (@mod2,$mod1)
  221.         }
  222.     }
  223.  
  224. print "</TABLE></TD><TD WIDTH=33% VALIGN=TOP><TABLE BORDER=0 CELLPADDING=1>";
  225.  
  226. $count = 0;
  227.  
  228. foreach $mod2(@mod2){
  229.     chomp $mod2;
  230.     $count++;
  231.     if ($count <= $third){
  232.         print qq~<TR><TD>${font}$mod2</TD></TR>~;
  233.         }
  234.     }
  235.  
  236. print qq~
  237. </TABLE>
  238. </TD>
  239. </TR>
  240. </TABLE>
  241. <P>
  242. <HR COLOR="#BF0425" SIZE=1>
  243. <P>
  244. ${font}The latest version of <B><FONT FACE="Courier New, mono">$program</FONT></B> can always be found on <A HREF="http://www.scriptsolutions.com/programs/free/perldiver/" TARGET="_blank">${dev}'s web site</A>.
  245. <P><FONT SIZE=1>$font© 1999, <A HREF="http://www.scriptsolutions.com/" TARGET="_blank">ScriptSolutionsÖ</A>, a <A HREF="http://www.tintagel.net/" TARGET="_blank">Tintagel</A> project.<P><TABLE WIDTH=100% BGCOLOR=#FDB900 CELLPADDING=2 CELLSPACING=0 BORDER=0 BACKGROUND="http://www.scriptsolutions.com/images/top.GIF">
  246. <TR>
  247. <TH ALIGN=RIGHT>
  248.  
  249. <BR>
  250.  
  251. </TD>
  252. </TR>
  253. </TABLE>
  254. </BODY></HTML>
  255. ~;
  256. exit;
  257.  
  258. sub vars {
  259.     $dev="ScriptSolutionsÖ";
  260.     use File::Find;
  261.     $bgcolor = "GHOSTWHITE";
  262.     $program="perl diver";
  263.     $version="1.1";
  264.     }
  265. #########################################################
  266. sub wanted {
  267.     $count = 0;
  268.     if ($File::Find::name =~ /\.pm$/){
  269.         open(MODFILE,$File::Find::name) || return;
  270.         while(<MODFILE>){
  271.             if (/^ *package +(\S+);/){
  272.                 push (@foundmods, $1);
  273.                 last;
  274.                 }
  275.             }
  276.          }
  277.     }