package Sample;
# -------------------------------------------------------------------------
# This package presents example PowerWeb Server++ WebScripts.
#
# Many of the examples are functionally identical to the C and Rexx
# language examples, so you can compare ease of development and speed
# of execution.
#
# COPYRIGHT:
# CompuSource (Pty) Ltd
# Licensed Materials - Property of CompuSource (Pty) Ltd
# (C) Copyright CompuSource (Pty) Ltd 1994-1996.
# All Rights Reserved
# Use, duplication, or disclosure restricted by international
# copyright law.
#
# -------------------------------------------------------------------------
#
# This package contains the following sample Perl subroutines:
#
# TimeZone - display local and CompuSource time zones
# DirList - show a directory listing
# Tree - display a tree view of PowerWeb settings
#
# This file is best viewed with tabs set every 3 characters.
# -------------------------------------------------------------------------
use WebPerl;
# -------------------------------------------------------------------------
sub Sample::TimeZone
{
# Declare the local variables used by this subroutine
my (@local, @gmt, @cs);
# Compute the time zones
@local = localtime();
@gmt = gmtime();
@cs = @gmt;
$cs[2] = $cs[2] + 2;
if ($cs[2] > 23)
{
$cs[2] = $cs[2] - 24;
}
# Display the results as an HTML table
WebPerl::Print
'
Time Zones |
|---|
| Local |
GMT |
CompuSource |
';
WebPerl::Print sprintf('| %02d:%02d:%02d | ', $local[2], $local[1], $local[0]);
WebPerl::Print sprintf('%02d:%02d:%02d | ', $gmt[2], $gmt[1], $gmt[0]);
WebPerl::Print sprintf('%02d:%02d:%02d | ', $cs[2], $cs[1], $cs[0]);
WebPerl::Print '
';
# A return value of 0 means the subroutine succeeded
0;
}
# -------------------------------------------------------------------------
sub Sample::DirList
{
# Read the parameter passed by PowerWeb
my ($parcel) = @_;
# Declare the local variables used by this subroutine
my ($fileSpec, $showDate, $showSize, $showDirs);
# Tell PowerWeb we will be returning HTML including Web Macros.
# If you aren't using Web Macros you can remove this line.
WebPerl::WriteText($parcel, 'Request:/Header/Out/Content-Type', 'text/x-server-parsed-html');
# Read the form input fields - note that PowerWeb has already decoded them.
$fileSpec = WebPerl::ReadText($parcel, 'Request:/Argument/filespec');
$showDate = WebPerl::ReadInteger($parcel, 'Request:/Argument/showdate');
$showSize = WebPerl::ReadInteger($parcel, 'Request:/Argument/showsize');
$showDirs = WebPerl::ReadInteger($parcel, 'Request:/Argument/showdirs');
# Handle missing or empty fields by using suitable defaults
if (!$fileSpec) { $fileSpec = '/*'; }
if (!$showDate) { $showDate = 0; }
if (!$showSize) { $showSize = 0; }
if (!$showDirs) { $showDirs = 0; }
# Output a page title
WebPerl::Print '';
WebPerl::Print "Directory Listing for Documents in $fileSpec
";
# Output a #Dir Web Macro according to the form's fields
WebPerl::Print "';
WebPerl::Print '';
# A return value of 0 means the subroutine succeeded
0;
}
# -------------------------------------------------------------------------
sub Sample::Tree
{
# Read the parameter passed by PowerWeb
my ($parcel) = @_;
# Declare the local variables used by this subroutine
my ($root, $buffer);
# Read the argument to the URL (if any)
$buffer = WebPerl::ReadText($parcel, 'Request:/ArgumentText');
# If no argument given, use a default of the current Request object.
if (!$buffer) {
$buffer = 'Request:/';
}
WebPerl::Print '';
# Discover the "root" of the tree to display
$root = WebPerl::Find($parcel, $buffer);
if (!$root) {
WebPerl::Print "Failed to Find the Requested Variable Directory: $buffer";
}
else {
# Output a heading.
WebPerl::Print "Tree of Variables Under: $buffer
";
# Call the recursive function to display the tree in HTML
Sample::TourTreeRecursion($root, 0);
}
WebPerl::Print '';
# A return value of 0 means the subroutine succeeded
0;
}
# Recursive subroutine called by the main program.
sub Sample::TourTreeRecursion
{
# Read the parameters passed by Sample::Tree
my ($root, $level) = @_;
# Declare the local variables used by this subroutine
my ($TYPE_LIST, $kind) = (5, WebPerl::Kind($root));
my ($item, $text, $next);
# If not at the absolute root, display the local root variable's name and value.
if ($level > 0) {
$item = '';
if ($kind == $TYPE_LIST) {
$item = $item . '';
}
$item = $item . WebPerl::Name($root);
if ($kind == $TYPE_LIST) {
$item = $item . '';
}
else {
$text = WebPerl::ReadText($root, '');
if (!$text) {
$text = '(none)';
}
$item = $item . ' = ' . $text;
}
WebPerl::Print $item;
}
# If the local root Variable is a list, display it recursively.
if ($kind == $TYPE_LIST) {
$next = WebPerl::Child($root);
if ($next) {
WebPerl::Print '';
do {
Sample::TourTreeRecursion($next, $level+1);
$next = WebPerl::Sibling($next);
} until (!$next);
WebPerl::Print '
';
}
}
}
# -------------------------------------------------------------------------
# A module return value of 1 means the package loaded ok.
1;