############################################################################
#
#   Copyright 1999-2000 Phone.com, Inc.  All rights reserved.
#
#   Subject to the terms and conditions of the SDK License Agreement, 
#   Phone.com, Inc. hereby grants you the right to use the UP.SDK 
#   software and its related documentation.
#   
#   The Phone.com name and logo and the family of terms carrying the "UP."
#   prefix are trademarks of Phone.com, Inc. All other brands and product 
#   names may be trademarks of the respective companies with which they 
#   are associated.
#
############################################################################

######################################################################
#
# DeckUtils
#
# Deck Output and CGI support for UP.Link apps
#
#
# PUBLIC FUNCTIONS:
# OutputDeck($deck,$charset) 		- Outputs the specified deck to STDOUT
# OutputDigest($digest->asString())	- Outputs the specified digest to STDOUT
# HTTPEscapeString($string)		- URL encodes the input string
# DeckEscapeString($string)		- Encodes the input string for display in the deck
# ParseCGIVars()			- Parses the CGI variables in an assoc array.
# ParseURLEncodedString($string)	- Parses the input string into an assoc array.
# ErrorExit($string1, $string2)		- Outputs an Error deck with string1 and string2
#
#
# PUBLIC VARIABLES:
# $AppUtils::CGI - Sets the CGI env for the app and controls HTTP header output
# $AppUtils::CONTENTTYPE_CHARSET - Sets the character set used in Deck output
# 
#
# EXAMPLE:
# require 'DeckUtils.pl';
# ...
# $AppUtils::CGIStandard;
# ...
# # Get the cgi variable and put them in an associative array
# %cgiVars = &AppUtils::ParseCGIVars();
# ...
# $nextState = $cgiVars{"NEXT"};
# ...
# $string = &AppUtils::DeckEscapeString("This & that");
# $deck = "<Deck>... $string ... </Deck>";
# &AppUtils::OutputDeck($deck);
#
######################################################################

package AppUtils;

######################################################################
# Constants
######################################################################
#
# Different CGI Environments expect different kinds of headers, you
# can set the CGI environment your application is running in by
# setting the variable $AppUtils::CGI.  Example for Netscape:
#
#		$AppUtils::CGI = $AppUtils::CGINetscape;
#
# This variable is used to determine whether or not the HTTP status
# header should be sent by the script or not. Most Web servers expect
# the CGI application to output the HTTP status line. But Netscape servers
# output the HTTP status line themselves and expect the CGI app to output
# any other headers and the response body itself. The $AppUtils::CGI
# variable is used to tell the utility which CGI environment to simulate
# and hence whether or not the HTTP status line will be output by the 
# utility's OutputDeck and OutputDigest functions
#
# Unless PerlIS.dll (only on NT) is being used, this variable defaults to
# $CGINetscape (script won't output HTTP status line)
# 
# The value can be overridden by the application script after 'require'ing
# DeckUtils.pl but before calling OutputDeck or OutputDigest
# 

# Various CGI Environments supported
$CGIStandard = 1;
$CGINetscape = 0;

# Default to Netscape
$CGI = $CGINetscape;
$CGI = $CGIStandard if ($ENV{'PERLXS'} eq 'PerlIS');

#Decks supported
$DECKTYPE_HDML = 0;
$DECKTYPE_WML  = 1;
$DECKTYPE_WMLP = 2;

#Default to WML
$DECKTYPE = $DECKTYPE_WMLP;

# Delimiter to use for separating html header elements
$HdrDelim = "\n";

# Headers to put at beginning of CGI output
$HTTPHEADER = "HTTP/1.0 200 OK";

#$CONTENTHEADER_WML  = "text/x-wap.wml";

$CONTENTHEADER_WML  = "text/vnd.wap.wml";
$CONTENTHEADER_WMLSCRIPT  = "text/vnd.wap.wmlscript";
$CONTENTHEADER_HDML = "text/x-hdml";
$CONTENTHEADER_IMAGE  = "text/vnd.wap.wbmp";

# Default character set used in output decks. Apps that generate
# decks in other character sets must set this value to the charset 
# being used to ensure proper transcoding to the device
$CONTENTTYPE_CHARSET = "";
#$CONTENTTYPE_CHARSET = "charset=utf-8";

$DTD_HDML = "";

#WML1.1
$DTD_WML  = '<!DOCTYPE wml PUBLIC "-//WAPFORUM//DTD WML 1.1//EN" "http://www.wapforum.org/DTD/wml_1.1.xml">'. "\n";

#WML1.1 w/Extensions
$DTD_WMLP = '<!DOCTYPE wml PUBLIC "-//PHONE.COM//DTD WML 1.1//EN" "http://www.phone.com/dtd/wml11.dtd">'. "\n";

$XML_HEADER = '<?xml version="1.0"?>' . "\n";

# Generic error deck - used by ErrorExit
$ERRORDECK_WML =
    '<wml>
	   <head>
	     <meta forua="true" http-equiv="cache-control" content="max-age=0"/>
	   </head>
	   <card>
	   	<p>Service Error</p>
	     <p mode="nowrap">%s</p>
	     <p mode="nowrap">%s</p>
	   </card>
	 </wml>';

$ERRORDECK_HDML =
    "<HDML VERSION=3.0 TTL=0>
	   <DISPLAY>
	     Service Error
	     <LINE> %s
	     <LINE> %s
	   </DISPLAY>
	 </HDML>";

######################################################################
# Sub routines
######################################################################
######################################################################
#
# METHOD:
# OutputDeck
#
# INDEX: (lists the categories this function is indexed under in the docs)
# decks:outputting
# 
# DESCRIPTION:
# Output an Deck deck with appropriate HTTP headers.
#
# SYNOPSIS:
# require 'DeckUtils.pl';
# ...
# &AppUtils::OutputDeck($deck,$charset);
#
# ARGUMENTS:
# $deck		The deck to output
# $charset	(Optional)Charset used in the deck. If none is specified
#           the value specified in $AppUtils::CONTENTTYPE_CHARSET will be used
#
# EXAMPLE:
# $deck = "<WML>...</WML>";
# &AppUtils::OutputDeck($deck);
#
######################################################################
sub OutputDeck
{
	my($Deck,$charset) = @_;
	
	my $contentType;
	
open(LOG,">/tmp/wmllog.txt");
	if ($CGI != $CGINetscape) {
print LOG "1. HTTPHEADER='$HTTPHEADER'\n";	
		print $HTTPHEADER, $HdrDelim;
	}

	$contentType = "Content-type: " . GetContentType($charset);
print LOG "2. contentType='$contentType'\n";	
	print $contentType, $HdrDelim;
	print $HdrDelim;
	if ($DECKTYPE != $DECKTYPE_HDML) {
print LOG "3. XML_HEADER='$XML_HEADER'\n";	
		print $XML_HEADER;
print LOG "4. AppUtils::GetDTD()='&AppUtils::GetDTD()'\n";	
		print GetDTD();
	}
print LOG "5. Deck='$Deck'\n";	
	print $Deck;
close(LOG);

}

######################################################################
#
# METHOD:
# OutputDigest
#
# INDEX: (lists the categories this function is indexed under in the docs)
# digests:outputting;outputting, digests
# 
# DESCRIPTION:
# Output a digest with appropriate HTTP headers.
#
# SYNOPSIS:
# require 'DeckUtils.pl';
# ...
# &AppUtils::OutputDigest($digest->asString();
#
# ARGUMENTS:
# $digest		The digest to output.
#
# EXAMPLES:
# my $digest = new Digest;
# $digest->addDeckDeck("", $deck);
# &AppUtils::OutputDigest($digest->asString());
#
######################################################################
sub OutputDigest
{
	my($digest) = @_;

	#All HTTP headers required for the digest are part of the digest.
	#So just output HTTP Status, if required

	if ($CGI != $CGINetscape) {
		print $HTTPHEADER, $HdrDelim;
	}

	print $digest;
}


######################################################################
#
# METHOD:
# GetContentType
#
# INDEX: (lists the categories this function is indexed under in the docs)
# ContentType, DeckUtils
# 
# DESCRIPTION:
# Retrieves the content-type to be used for the deck
#
# SYNOPSIS:
# require 'DeckUtils.pl';
# ...
# $string = &AppUtils::GetContentType;
#
# ARGUMENTS:
# $charset	(Optional)Charset used in the deck. If none is specified
#           the value specified in $AppUtils::CONTENTTYPE_CHARSET will be used
# EXAMPLES:
# $string = &AppUtils::GetContentType;
#
######################################################################
sub GetContentType
{
	my($charset) = @_;
	my $contentType;
	
	if (! defined($charset)) {
		$charset = $CONTENTTYPE_CHARSET;
	}
	if ($AppUtils::DECKTYPE == $DECKTYPE_HDML) {
		$contentType = $CONTENTHEADER_HDML;
	}
	else {
		$contentType = $CONTENTHEADER_WML;
	}

	# Prepend the 'charset=' part if not present in the string.
	#
	if (length($charset) > 0) {
		if ($charset =~ /charset\=/i) {
			$contentType = $contentType . ";" . $charset;
		}
		else {
			$contentType = $contentType . ";charset=" . $charset;
		}
	}
	return $contentType;	
}

######################################################################
#
# METHOD:
# GetDTD
#
# INDEX: (lists the categories this function is indexed under in the docs)
# DTD, DeckUtils
# 
# DESCRIPTION:
# Retrieves the DTD to be used for the deck
#
# SYNOPSIS:
# require 'DeckUtils.pl';
# ...
# $string = &AppUtils::GetDTD;
#
# ARGUMENTS:
#
# EXAMPLES:
# $string = &AppUtils::GetDTD;
#
######################################################################
sub GetDTD
{
	return $DTD_WMLP if ($DECKTYPE == $DECKTYPE_WMLP);
	return $DTD_WML  if ($DECKTYPE == $DECKTYPE_WML);
	return ""        if ($DECKTYPE == $DECKTYPE_HDML);
}

######################################################################
#
# METHOD:
# HTTPEscapeString
#
# INDEX: (lists the categories this function is indexed under in the docs)
# HTTP escaping, strings;strings, HTTP escaping
# 
# DESCRIPTION:
# Escapes any restricted characters for a URL and returns
# the escaped string.
#
# SYNOPSIS:
# require 'DeckUtils.pl';
# ...
# &AppUtils::HTTPEscapeString($string);
#
# ARGUMENTS:
# $string		The string to escape.
#
# EXAMPLES:
# $string = "This & that";
# $deck  = '<WML><CARD>';
# $deck .= '<DO TYPE="ACCEPT"> <GO URL="?ABC='.&HTTPEscapeString($string).'">';
# $deck .= '</CARD></WML>';
#
######################################################################
sub HTTPEscapeString
{
    my($string) = @_;

	$string =~ s/\"/%22/g;
    $string =~ s/\#/%23/g;
    $string =~ s/\$/%24/g;
    $string =~ s/\%/%25/g;
    $string =~ s/\&/%26/g;
    $string =~ s/\+/%2B/g;
    $string =~ s/\//%2F/g;
    $string =~ s/\?/%3F/g;
    $string =~ s/\:/%3A/g;
    $string =~ s/\;/%3B/g;
    $string =~ s/\</%3C/g;
    $string =~ s/\=/%3D/g;
    $string =~ s/\>/%3E/g;
    $string =~ s/\@/%40/g;
    $string =~ s/ /\+/g;
    $string;
}

######################################################################
#
# METHOD:
# DeckEscapeString
#
# INDEX: (lists the categories this function is indexed under in the docs)
# Deck escaping, strings;strings, Deck escaping
# 
# DESCRIPTION:
# Escapes restricted characters for Deck text in the string
# string and returns the escaped string.
#
# SYNOPSIS:
# require 'DeckUtils.pl';
# ...
# &AppUtils::DeckEscapeString($string);
#
# ARGUMENTS:
# $string		The string to escape
#
# EXAMPLES:
# $string = "This & that";
# $deck  = '<WML><CARD>';
# $deck .= &DeckEscapeString($string);
# $deck .= '</CARD></WML>';
#
######################################################################
sub DeckEscapeString
{
    my($string) = @_;

    $string =~ s/&/&amp;/g;
    $string =~ s/</&lt;/g;
    $string =~ s/>/&gt;/g;
    $string =~ s/\'/&apos;/g;
    $string =~ s/\"/&quot;/g;
    $string =~ s/\$/\$\$/g;

	# Remove any carraige returns and control G's
	$string =~ s/\r//g;

    $string;
}

######################################################################
#
# METHOD:
# ParseCGIVars
#
# Inspired by Steven E. Brenner's (S.E.Brenner@bioc.cam.ac.uk) 
# ReadParse library function.
#
# Copyright 1993 Steven E. Brenner, unpublished work.
# Permission granted to use and modify this library so long as the
# copyright above is maintained, modifications are documented, and
# credit is given for any use of the library.
#
# INDEX: (lists the categories this function is indexed under in the docs)
# CGI variables, parsing;parsing:CGI variables
# 
# DESCRIPTION:
# Extracts the key-data pairs from the CGI environment and puts them in 
# an associative array.
#
# RETURNS:
# An associative array of all CGI environment key-data pairs.
#
# EXAMPLES:
# %cgiVars = &AppUtils::ParseCGIVars();
# $nextState = $cgiVars{"NEXT"};
#
######################################################################
sub ParseCGIVars
{
    my($name, $value, %envArray);
    my($queryString, $i);

	# Read in the cgi environment variables
	$queryString = $ENV{'QUERY_STRING'};

	# Append any POST data to the query string arguments
	#
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		if ($queryString ne "") {
			$queryString .= "&";
		}
		for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
			$queryString .= getc;
		}
	}

	return &ParseURLEncodedString($queryString);
}

######################################################################
#
# METHOD:
# ParseURLEncodedString
#
# INDEX: (lists the categories this function is indexed under in the docs)
# URL-encoded variables, parsing;parsing:URL-encoded strings
# 
# DESCRIPTION:
# Extracts key-data pairs from a URL-encoded string.
#
# SYNOPSIS:
# require 'DeckUtils.pl';
# ...
# &AppUtils::ParseURLEncodedString($string);
#
# ARGUMENTS:
# $string		The URL-encoded input string to parse.
#
# RETURNS:
# Returns an associative array of the key-data pairs in the specified string.
#
# EXAMPLES:
# $string = "abcd=this+is+a+test&xyz=hello%26world";
# %parsedVars = &AppUtils::ParseURLEncodedString($string);
# $abcd = $parsedVars{"abcd"};
#
######################################################################
sub ParseURLEncodedString
{
	my $queryString = shift;
    my($name, $value, %envArray);

    foreach (split(/&/, $queryString)) {

		# Convert plus's to spaces.
		s/\+/ /g;

		# Convert %XX from hex numbers to alphanumeric.
		s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("c",hex($1))/ge;

		# Split into variable and value.
		($name, $value) = split(/=/, $_, 2);
		$value =~ s/^ +//;        # strip leading spaces
		$value =~ s/ +$//;        # strip trailing spaces
		$envArray{$name} = $value;

    }

	# Return the associative array
    %envArray;
}

######################################################################
#
# METHOD:
# ErrorExit
#
# INDEX: (lists the categories this function is indexed under in the docs)
# decks, error:outputting;error decks
# 
# DESCRIPTION:
# Outputs an error deck and exits.
#
# SYNOPSIS:
# require 'DeckUtils.pl';
# ...
# &AppUtils::ErrorExit();
#
# ARGUMENTS:
# $str1		Error description
# $str2		Additional error description
#
# EXAMPLES:
# &ErrorExit("DB Error", "Could not login");
#
######################################################################
sub ErrorExit
{
	my($str1, $str2) = @_;

	if ($DECKTYPE == $DECKTYPE_HDML) {
		&OutputDeck(sprintf($ERRORDECK_HDML, $str1, $str2));
	}
	else {
		&OutputDeck(sprintf($ERRORDECK_WML, $str1, $str2));
	}
	exit;
}

1;
