home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1997 March / PCWK0397.iso / novell / webserv3 / docs / tools / perl / album.pl
Perl Script  |  1996-12-10  |  3KB  |  94 lines
  1. #!/usr/bin/perl
  2. # The above line is a throw back to my Unix days...ignore it.
  3. #
  4. # Description:
  5. #
  6. # A Perl script to create an HTML photo album of .GIF. and .JPG files.  It
  7. # specifically looks for all graphic files in the directory specified on the
  8. # URL and lists them and includes the text from corresponding .TXT files.  
  9. # This is all done in table format, creating an index (or album) of the graphics 
  10. # in the directory.
  11. #
  12. # The directory specified must be a directory under the DocumentRoot defined
  13. # in the Web Server's SRM.CFG file.
  14. #
  15. # The directory to album is specified on the URL line following the name of 
  16. # the script.
  17. #
  18. # Example: http://server:port/perl/album.pl/images gives an album of the 
  19. # "images" directory.
  20. # 
  21. # Descriptions of the graphic files are given by creating a text file whose 
  22. # name is the same as the graphic file, except with an extension of .TXT.  
  23. # The description file must be in the same directory as the graphic file.  
  24. # The description will be displayed on the album page.
  25. #
  26. # This may not be the most efficient script in the world <g>, but it works.
  27.  
  28. # Standard opening commands for a Web Server Perl CGI script
  29. require("cgi-lib.pl");
  30. print &PrintHeader;
  31. &ReadParse;
  32.  
  33. # Set up the necessary variables
  34. $dir = $ENV{"PATH_TRANSLATED"};     #The directory to look in for images
  35.                     #This is the real dir on the server
  36. if ( rindex($dir, "/") != length($dir)-1 ) {
  37.   $dir = $dir."/";             #If $dir doesn't end in '/', add it
  38. }
  39. $filespec = $dir."*.???";            #filespec will be globbed for image files
  40. $path = $ENV{"PATH_INFO"};        #The dir to the images relative to the DocumentRoot
  41. if ( rindex($path, "/") != length($path)-1 ) {
  42.   $path = $path."/";            #If $path doesn't end in '/', add it
  43. }
  44. @types = ("GIF", "JPG");        #The valid extensions to search for
  45.  
  46. #--------- HTML Document Setup --------------
  47. print "<html>\n";
  48. print "<title>Album of $path</title>\n";
  49. print "<body bgcolor=#ffffff>\n";
  50. print "<h3>Album of $path</h3>\n";
  51. print "Click on the file name of an image to have the full file delivered.<hr>\n";
  52.  
  53. #-------- Build Table -------------------
  54. # Set up the table for this .GIF/.JPG
  55. print "<table border=1>\n";
  56. opendir(DIR, $filespec);    #Has to be opened with globbing because of a Perl bug.
  57. foreach $file (sort(readdir(DIR))) {    #Loops through pictures, making the index as it goes.
  58.   $name = substr($file, 0, length($file)-4);
  59.   $ext = substr($file, length($file)-3, 3);
  60.   if (grep(/$ext/, @types) > 0) {
  61.     print "<tr>\n";
  62.     print "  <td valign=top align=left>\n";
  63.     # Display link
  64.     print "    [<a href=$path$file>";
  65.     print "      $file";
  66.     print "    </a>]\n";
  67.     # Display text description
  68.     if (-e "$dir$name.TXT") {
  69.       open(DESC, "$dir$name.TXT");
  70.       while (!eof(DESC)) {
  71.         print <DESC>;
  72.       }
  73.     }
  74.     else {
  75.       print "No description available.\n";
  76.     }
  77.     print "  </td>\n";
  78.     # Display picture
  79.     print "  <td>\n";
  80.     print "    <img src=$path$file border=0>\n";
  81.     print "  </td>\n";
  82.     print "  </td>\n";
  83.     print "</tr>\n";
  84.   }
  85. }
  86. # When all the files are listed, close the directory
  87. closedir(DIR);
  88. # Close the table
  89. print "</table><p>\n";
  90.  
  91. #---------- HTML Document Wrap-up ------------
  92. print "</body>\n";
  93. print "</html>\n";
  94.