home *** CD-ROM | disk | FTP | other *** search
/ PC Online 1998 November / PCO_1198.ISO / filesbbs / os2 / os2www.arj / OS2WWW.ZIP / SYS406.R8 / PERL-BIN / SAMPLE.PM < prev    next >
Encoding:
Perl POD Document  |  1996-05-09  |  6.1 KB  |  250 lines
  1. package Sample;
  2.  
  3. # -------------------------------------------------------------------------
  4. # This package presents example PowerWeb Server++ WebScripts.
  5. #
  6. # Many of the examples are functionally identical to the C and Rexx 
  7. # language examples, so you can compare ease of development and speed
  8. # of execution.
  9. #
  10. # COPYRIGHT:
  11. #   CompuSource (Pty) Ltd
  12. #   Licensed Materials - Property of CompuSource (Pty) Ltd
  13. #   (C) Copyright CompuSource (Pty) Ltd 1994-1996.
  14. #   All Rights Reserved
  15. #   Use, duplication, or disclosure restricted by international
  16. #   copyright law.
  17. #
  18. # -------------------------------------------------------------------------
  19. #
  20. # This package contains the following sample Perl subroutines:
  21. #
  22. #        TimeZone        -    display local and CompuSource time zones
  23. #        DirList        -    show a directory listing
  24. #        Tree            -    display a tree view of PowerWeb settings
  25. #
  26. # This file is best viewed with tabs set every 3 characters.
  27.  
  28. # -------------------------------------------------------------------------
  29.  
  30. use WebPerl;
  31.  
  32. # -------------------------------------------------------------------------
  33.  
  34. sub Sample::TimeZone
  35. {
  36.     # Declare the local variables used by this subroutine
  37.  
  38.     my (@local, @gmt, @cs);
  39.  
  40.     # Compute the time zones
  41.  
  42.     @local    = localtime();
  43.     @gmt        = gmtime();
  44.     @cs        = @gmt;
  45.     $cs[2]    = $cs[2] + 2;
  46.     
  47.     if ($cs[2] > 23)
  48.     {
  49.         $cs[2] = $cs[2] - 24;
  50.     }
  51.  
  52.     # Display the results as an HTML table
  53.  
  54.     WebPerl::Print
  55. '<html><body background=/icons/textures/paper.jpg>
  56. <table border=1>
  57. <tr><th colspan=3><h2>Time Zones</h2></th></tr>
  58. <tr>
  59. <td><b>Local</b></td>
  60. <td><b>GMT</b></td>
  61. <td><b>CompuSource</b></td>
  62. </tr>
  63. <tr>';
  64.  
  65.     WebPerl::Print sprintf('<td>%02d:%02d:%02d</td>',    $local[2],    $local[1],    $local[0]);
  66.     WebPerl::Print sprintf('<td>%02d:%02d:%02d</td>',    $gmt[2],        $gmt[1],        $gmt[0]);
  67.     WebPerl::Print sprintf('<td>%02d:%02d:%02d</td>',    $cs[2],        $cs[1],        $cs[0]);
  68.     
  69.     WebPerl::Print '</tr></table></body></html>';
  70.  
  71.     # A return value of 0 means the subroutine succeeded
  72.  
  73.     0;
  74. }
  75.  
  76. # -------------------------------------------------------------------------
  77.     
  78. sub Sample::DirList
  79. {
  80.     # Read the parameter passed by PowerWeb
  81.  
  82.     my ($parcel) = @_;
  83.  
  84.     # Declare the local variables used by this subroutine
  85.  
  86.     my ($fileSpec, $showDate, $showSize, $showDirs);
  87.  
  88.     # Tell PowerWeb we will be returning HTML including Web Macros.
  89.     # If you aren't using Web Macros you can remove this line.
  90.  
  91.     WebPerl::WriteText($parcel, 'Request:/Header/Out/Content-Type', 'text/x-server-parsed-html');
  92.  
  93.     # Read the form input fields - note that PowerWeb has already decoded them.
  94.  
  95.     $fileSpec = WebPerl::ReadText($parcel, 'Request:/Argument/filespec');
  96.     $showDate = WebPerl::ReadInteger($parcel, 'Request:/Argument/showdate');
  97.     $showSize = WebPerl::ReadInteger($parcel, 'Request:/Argument/showsize');
  98.     $showDirs = WebPerl::ReadInteger($parcel, 'Request:/Argument/showdirs');
  99.     
  100.     # Handle missing or empty fields by using suitable defaults
  101.  
  102.     if (!$fileSpec) {    $fileSpec = '/*';    }
  103.     if (!$showDate) {    $showDate = 0;        }
  104.     if (!$showSize) {    $showSize = 0;        }
  105.     if (!$showDirs) {    $showDirs = 0;        }
  106.     
  107.     # Output a page title
  108.  
  109.     WebPerl::Print '<html><body background=/icons/textures/paper.jpg>';
  110.     WebPerl::Print "<h1>Directory Listing for Documents in $fileSpec</h1>";
  111.     
  112.     # Output a #Dir Web Macro according to the form's fields
  113.  
  114.     WebPerl::Print "<!--#dir Virtual=$fileSpec";
  115.     
  116.     if ($showDirs) {
  117.         WebPerl::Print ' IncludeDirectories=yes';
  118.     }
  119.     
  120.     if ($showDate) {
  121.         WebPerl::Print ' SuppressLastModified=no';
  122.     } else {
  123.         WebPerl::Print ' SuppressLastModified=yes';
  124.     }
  125.     
  126.     if ($showSize) {
  127.         WebPerl::Print ' SuppressSize=no';
  128.     } else {
  129.         WebPerl::Print ' SuppressSize=yes';
  130.     }
  131.     
  132.     WebPerl::Print '-->';
  133.     WebPerl::Print '</body></html>';
  134.  
  135.     # A return value of 0 means the subroutine succeeded
  136.  
  137.     0;
  138. }
  139.  
  140. # -------------------------------------------------------------------------
  141.  
  142. sub Sample::Tree
  143. {
  144.     # Read the parameter passed by PowerWeb
  145.  
  146.     my ($parcel) = @_;
  147.  
  148.     # Declare the local variables used by this subroutine
  149.  
  150.     my ($root, $buffer);
  151.  
  152.     # Read the argument to the URL (if any)
  153.  
  154.     $buffer = WebPerl::ReadText($parcel, 'Request:/ArgumentText');
  155.  
  156.     # If no argument given, use a default of the current Request object.
  157.  
  158.     if (!$buffer) {
  159.         $buffer = 'Request:/';
  160.     }
  161.  
  162.     WebPerl::Print '<html><body background=/icons/textures/paper.jpg>';
  163.  
  164.     # Discover the "root" of the tree to display 
  165.  
  166.     $root = WebPerl::Find($parcel, $buffer);
  167.  
  168.     if (!$root) {
  169.         WebPerl::Print "Failed to Find the Requested Variable Directory: $buffer";
  170.     }
  171.     else {
  172.         # Output a heading.
  173.         WebPerl::Print "<h2>Tree of Variables Under: $buffer</h2>";
  174.  
  175.         # Call the recursive function to display the tree in HTML
  176.         Sample::TourTreeRecursion($root, 0);
  177.     }
  178.  
  179.     WebPerl::Print '</body></html>';
  180.  
  181.     # A return value of 0 means the subroutine succeeded
  182.  
  183.     0;
  184. }
  185.  
  186. # Recursive subroutine called by the main program.
  187.  
  188. sub Sample::TourTreeRecursion
  189. {
  190.     # Read the parameters passed by Sample::Tree
  191.  
  192.     my ($root, $level) = @_;
  193.  
  194.     # Declare the local variables used by this subroutine
  195.  
  196.     my ($TYPE_LIST, $kind) = (5, WebPerl::Kind($root));
  197.     my ($item, $text, $next);
  198.  
  199.     # If not at the absolute root, display the local root variable's name and value.
  200.  
  201.     if ($level > 0) {
  202.         $item = '<li>';
  203.  
  204.         if ($kind == $TYPE_LIST) {
  205.             $item = $item . '<b>';
  206.         }
  207.  
  208.         $item = $item . WebPerl::Name($root);
  209.  
  210.         if ($kind == $TYPE_LIST) {
  211.             $item = $item . '</b>';
  212.         }
  213.         else {
  214.             $text = WebPerl::ReadText($root, '');
  215.  
  216.             if (!$text) {
  217.                 $text = '(none)';
  218.             }
  219.  
  220.             $item = $item . ' = ' . $text;
  221.         }
  222.  
  223.         WebPerl::Print $item;
  224.     }
  225.  
  226.     # If the local root Variable is a list, display it recursively.
  227.  
  228.     if ($kind == $TYPE_LIST) {
  229.         $next = WebPerl::Child($root);
  230.  
  231.         if ($next) {
  232.             WebPerl::Print '<ul>';
  233.  
  234.             do {
  235.                 Sample::TourTreeRecursion($next, $level+1);
  236.                 $next = WebPerl::Sibling($next);
  237.             } until (!$next);
  238.  
  239.             WebPerl::Print '</ul>';
  240.         }
  241.     }
  242. }
  243.  
  244. # -------------------------------------------------------------------------
  245.  
  246. # A module return value of 1 means the package loaded ok.
  247.  
  248. 1;
  249.  
  250.