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
'<html><body background=/icons/textures/paper.jpg>
<table border=1>
<tr><th colspan=3><h2>Time Zones</h2></th></tr>
<tr>
<td><b>Local</b></td>
<td><b>GMT</b></td>
<td><b>CompuSource</b></td>
</tr>
<tr>';

	WebPerl::Print sprintf('<td>%02d:%02d:%02d</td>',	$local[2],	$local[1],	$local[0]);
	WebPerl::Print sprintf('<td>%02d:%02d:%02d</td>',	$gmt[2],		$gmt[1],		$gmt[0]);
	WebPerl::Print sprintf('<td>%02d:%02d:%02d</td>',	$cs[2],		$cs[1],		$cs[0]);
	
	WebPerl::Print '</tr></table></body></html>';

	# 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 '<html><body background=/icons/textures/paper.jpg>';
	WebPerl::Print "<h1>Directory Listing for Documents in $fileSpec</h1>";
	
	# Output a #Dir Web Macro according to the form's fields

	WebPerl::Print "<!--#dir Virtual=$fileSpec";
	
	if ($showDirs) {
		WebPerl::Print ' IncludeDirectories=yes';
	}
	
	if ($showDate) {
		WebPerl::Print ' SuppressLastModified=no';
	} else {
		WebPerl::Print ' SuppressLastModified=yes';
	}
	
	if ($showSize) {
		WebPerl::Print ' SuppressSize=no';
	} else {
		WebPerl::Print ' SuppressSize=yes';
	}
	
	WebPerl::Print '-->';
	WebPerl::Print '</body></html>';

	# 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 '<html><body background=/icons/textures/paper.jpg>';

	# 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 "<h2>Tree of Variables Under: $buffer</h2>";

		# Call the recursive function to display the tree in HTML
		Sample::TourTreeRecursion($root, 0);
	}

	WebPerl::Print '</body></html>';

	# 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 = '<li>';

		if ($kind == $TYPE_LIST) {
			$item = $item . '<b>';
		}

		$item = $item . WebPerl::Name($root);

		if ($kind == $TYPE_LIST) {
			$item = $item . '</b>';
		}
		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 '<ul>';

			do {
				Sample::TourTreeRecursion($next, $level+1);
				$next = WebPerl::Sibling($next);
			} until (!$next);

			WebPerl::Print '</ul>';
		}
	}
}

# -------------------------------------------------------------------------

# A module return value of 1 means the package loaded ok.

1;

