# WAP.pm - The WAP Class that defines a WML or HDML document.
# Created by James Pattie, 12/21/2000.

# Copyright (c) 2000 PC & Web Xperience, Inc. http://www.pcxperience.com/
# All rights reserved.  This program is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.

package HTMLObject::WAP;
use strict;
use HTMLObject::WMLDeck;
use HTMLObject::HDMLDeck;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw(
);
	
$VERSION = '2.28';

my @encodeCharacters = ( '%', '\+', ';', ',', '=', '&', ':', '\s', '\"', '#', '\$', '\/', '\?', '<', '>', '@' );
my %encodeCharactersHash = ( '%' => '%25',
                    '\+' => '%2B',
                    ';' => '%3B',
                    ',' => '%2C',
                    '=' => '%3D',
                    '&' => '%26',
                    ':' => '%3A',
                    '\s' => '+',
                    '\"' => '%22',
                    '#' => '%23',
                    '\$' => '%24',
                    '\/' => '%2F',
                    '\?' => '%3F',
                    '<' => '%3C',
                    '>' => '%3E',
                    '@' => '%40',
                  );
                  
my @formCharacters = ( '&', '<', '>', '\'', '\"', '\$' );
my %formCharactersHash = ( '&' => '&amp;',
                             '<' => '&lt;',
                             '>' => '&gt;',
                             '\'' => '&apos;',
                             '\"' => '&quot;',
                             '\$' => '\$\$',
                           );

# new
# takes: type, version, language, charsetEncoding
sub new
{
  my $class = shift;
  my $self = bless {}, $class;
  my %args = ( type => "WML", version => "1.1", language => "en", charsetEncoding => "", @_ );
  
  $self->{type} = $args{type};
  $self->{version} = $args{version};

  $self->{error} = 0; # no error initially.
  $self->{errorMessages} = {   1002 => 'Required Parameter missing',
  			1007 => 'Error Code already being used',
  		     };
  $self->setErrorMessage(code => '-1',   message => 'No error occurred');
  $self->setErrorMessage(code => '1000', message => 'Invalid Content-Type Specified');
  $self->setErrorMessage(code => '1001', message => 'Invalid Focus Specified');
  $self->setErrorMessage(code => '1003', message => "Eval'ing setCookie command failed");
  $self->setErrorMessage(code => '1004', message => 'Invalid Date for Cookie Expires');
  $self->setErrorMessage(code => '1005', message => 'Invalid Domain for Cookie');
  $self->setErrorMessage(code => '1006', message => 'Invalid Section used when Content-Type not equal to "text/html"');
  $self->setErrorMessage(code => '1008', message => 'Error Code does not exist');
  $self->setErrorMessage(code => '1009', message => 'Invalid WAP type');
  $self->setErrorMessage(code => '1010', message => 'Invalid WAP version');
  $self->setErrorMessage(code => '1011', message => 'No Decks defined');
  $self->setErrorMessage(code => '1012', message => 'Error occurred');

  $self->{errorCode} = -1;

  $self->{currentDeck} = "";  # points to the deck obj in the decks hash that we are currently working with.
  $self->{contentTypeString} = ($self->{type} eq "WML" ? "text/vnd.wap.wml" : "text/x-hdml");
  $self->{language} = $args{language};
  $self->{charsetEncoding} = $args{charsetEncoding};
  $self->{decks} = {};  # hash to hold the deck objects in.  Each deck will have the card objects that make it up.
  $self->{decksOrder} = [];  # The order the decks must be displayed in.
  $self->{cookies} = [];
  $self->{encodeCharacters} = \@encodeCharacters;
  $self->{encodeCharactersHash} = \%encodeCharactersHash;
  $self->{formCharacters} = \@formCharacters;
  $self->{formCharactersHash} = \%formCharactersHash;

  # validate the type and version
  if ($self->{type} !~ /^(WML|HDML)$/)
  {
    my $type = $self->{type};
    $self->{type} = "WML";    
    $self->setError(code => 1009);
    $self->displayError(title => "Error: new", message => "type = '$type' is invalid!<br/>");
  }
  if ($self->{type} eq "WML" && $self->{version} ne "1.1")
  {
    my $version = $self->{version};
    $self->{version} = "1.1";
    $self->setError(code => 1010);
    $self->displayError(title => "Error: new", message => "version = '$version' is invalid!<br/>");
  }
  if ($self->{type} eq "HDML" && $self->{version} ne "3.0")
  {
    my $version = $self->{version};
    $self->{version} = "3.0";
    $self->setError(code => 1010);
    $self->displayError(title => "Error: new", message => "version = '$version' is invalid!<br>");
  }
  
  # for now we leave language alone as it is not fully supported by the browsers we are working with.
  
  return $self;
}

# setErrorMessage
# parameters:  code, message
sub setErrorMessage
{
  my $self = shift;
  my %args = ( @_, );

  if (!exists $args{'code'})
  {
    $self->doRequiredParameterError('setErrorMessage', 'code');
  }
  if (!exists $args{'message'})
  {
    $self->doRequiredParameterError('setErrorMessage', 'message');
  }

  my $code = $args{'code'};
  my $message = $args{'message'};

  if (exists $self->{errorMessages}{$code})
  {
    $self->setError(code => '1007');
    $self->displayError(title => 'Error:  setErrorMessage', message => "Error Code = '$code' already exists!");
  }

  # otherwise assign this message and code to the hash.
  $self->{errorMessages}{$code} = $message;
}

# clearErrorMessage
# parameters: code
sub clearErrorMessage
{
  my $self = shift;
  my %args = ( @_, );

  if (!exists $args{'code'})
  {
    $self->doRequiredParameterError('clearErrorMessage', 'code');
  }

  my $code = $args{'code'};

  if (!exists $self->{errorMessages}{$code})
  {
    $self->setError(code => '1008');
    $self->displayError(title => 'Error:  clearErrorMessage', message => "Error Code = '$code' does not exist in the errorMessages hash!");
  }

  # otherwise remove this message and code from the hash.
  delete($self->{errorMessages}{$code});
}

# setError - Signals that an error occurred and what the code is.
# parameters: code
sub setError
{
  my $self = shift;
  my %args = ( @_, );

  if (!exists $args{'code'})
  {
    $self->doRequiredParameterError('setError', 'code');
  }

  my $code = $args{'code'};

  $self->{error} = 1;
  $self->{errorCode} = $code;
}

# didErrorOccur - Returns the flag value to indicate if an error occurred.
sub didErrorOccur
{
  my $self = shift;
  
  return $self->{error};
}

# getErrorMessage - Returns the Error Message created by the class.
sub getErrorMessage
{
  my $self = shift;

  return $self->{errorMessages}{$self->{errorCode}};
}

# getErrorCode - Returns the Error Code of the error that happened.
sub getErrorCode
{
  my $self = shift;

  return $self->{errorCode};
}

# reset
# takes: type, version, language, charsetEncoding
sub reset
{
  my $self = shift;
  my %args = ( type => "WML", version => "1.1", language => "en", charsetEncoding => "", @_ );
  
  $self->{type} = $args{type};
  $self->{version} = $args{version};

  $self->{error} = 0; # no error initially.
  %{$self->{errorMessages}} = (   1002 => 'Required Parameter missing',
  			1007 => 'Error Code already being used',
  		     );
  $self->setErrorMessage(code => '-1',   message => 'No error occurred');
  $self->setErrorMessage(code => '1000', message => 'Invalid Content-Type Specified');
  $self->setErrorMessage(code => '1001', message => 'Invalid Focus Specified');
  $self->setErrorMessage(code => '1003', message => "Eval'ing setCookie command failed");
  $self->setErrorMessage(code => '1004', message => 'Invalid Date for Cookie Expires');
  $self->setErrorMessage(code => '1005', message => 'Invalid Domain for Cookie');
  $self->setErrorMessage(code => '1006', message => 'Invalid Section used when Content-Type not equal to "text/html"');
  $self->setErrorMessage(code => '1008', message => 'Error Code does not exist');
  $self->setErrorMessage(code => '1009', message => 'Invalid WAP type');
  $self->setErrorMessage(code => '1010', message => 'Invalid WAP version');
  $self->setErrorMessage(code => '1011', message => 'No Decks defined');
  $self->setErrorMessage(code => '1012', message => 'Error occurred');

  $self->{errorCode} = -1;

  $self->{currentDeck} = "";  # points to the deck obj in the decks hash that we are currently working with.
  $self->{contentTypeString} = ($self->{type} eq "WML" ? "text/vnd.wap.wml" : "text/x-hdml");
  $self->{language} = $args{language};
  $self->{charsetEncoding} = $args{charsetEncoding};
  $self->{decks} = {};  # hash to hold the deck objects in.  Each deck will have the card objects that make it up.
  $self->{decksOrder} = [];  # The order the decks must be displayed in.
  $self->{cookies} = [];
  $self->{encodeCharacters} = \@encodeCharacters;
  $self->{encodeCharactersHash} = \%encodeCharactersHash;
  $self->{formCharacters} = \@formCharacters;
  $self->{formCharactersHash} = \%formCharactersHash;
  
  # validate the type and version
  if ($self->{type} !~ /^(WML|HDML)$/)
  {
    my $type = $self->{type};
    $self->{type} = "WML";    
    $self->setError(code => 1009);
    $self->displayError(title => "Error: new", message => "type = '$type' is invalid!<br/>");
  }
  if ($self->{type} eq "WML" && $self->{version} ne "1.1")
  {
    my $version = $self->{version};
    $self->{version} = "1.1";
    $self->setError(code => 1010);
    $self->displayError(title => "Error: new", message => "version = '$version' is invalid!<br/>");
  }
  if ($self->{type} eq "HDML" && $self->{version} ne "3.0")
  {
    my $version = $self->{version};
    $self->{version} = "3.0";
    $self->setError(code => 1010);
    $self->displayError(title => "Error: new", message => "version = '$version' is invalid!<br>");
  }
  
  # for now we leave language alone as it is not fully supported by the browsers we are working with.
}

# displayError - Displays the specified error document and then exits.
sub displayError
{
  my $self = shift;
  my %args = (  title => 'Error: HTMLObject::WAP',
  		message => 'An Error Occurred!',
  		@_	# arguments passed in go here.
  	     );
  	
  my $doc = HTMLObject::WAP->new(type => $self->{type}, version => $self->{version}, language => $self->{language}, charsetEncoding => $self->{charsetEncoding});
  if ($doc->didErrorOccur)
  {
    die "HTMLObject::Wap->displayError()  - " . $doc->getErrorMessage;
  }

  if ($self->{type} eq "WML")
  {
    $doc->createDeck(id => "error");
    if ($doc->didErrorOccur)
    {
      die "HTMLObject::Wap->displayError()  - " . $doc->getErrorMessage;
    }
    my $result = $doc->createCard(id => "error", title => "Error");
    if ($doc->didErrorOccur)
    {
      die "HTMLObject::Wap->displayError()  - " . $doc->getErrorMessage;
    }
    $doc->printHead("<meta forua=\"true\" http-equiv=\"cache-control\" content=\"max-age=0\"/>\n");
    $doc->print("<p>$args{title}</p>\n<p mode=\"nowrap\">" . $self->getErrorMessage . "</p>\n<p mode=\"nowrap\">$args{message}</p>\n");
  }
  elsif ($self->{type} eq "HDML")
  {
    $doc->createDeck(id => "error", version => $self->{version}, ttl => "0");
    if ($doc->didErrorOccur)
    {
      die "HTMLObject::Wap->displayError()  - " . $doc->getErrorMessage;
    }
    my $result = $doc->createCard(id => "error", name => "error", cardType => "display", title => "Error");
    if ($doc->didErrorOccur)
    {
      die "HTMLObject::Wap->displayError()  - " . $doc->getErrorMessage;
    }
    $doc->print("$args{title}\n<line>" . $self->getErrorMessage . "\n<line>$args{message}\n");
  }
  
  # display the error document.
  $doc->display(deck => "error");

  exit 0;
}

# displayCookies
sub displayCookies
{
  my $self = shift;

  my $output = "";
  if (scalar @{$self->{cookies}} > 0)
  {
    foreach my $cookie (@{$self->{cookies}})
    {
      $output .= "Set-Cookie: $cookie\n";
    }
  }

  return $output;
}

# display
# optional: deck
# This generates the WML or HDML document for the specified deck or if none specified a digest is generated if more than one deck else just the single deck
# if one is created.
sub display
{
  my $self = shift;
  my %args = ( @_ );
  my $deck = $args{deck};

  my $output = "";
  
  if (scalar keys %{$self->{decks}} == 0)
  {
    $self->setError(code => 1011);
    $self->displayError(title => "Error: display", message => "no decks defined!");
  }

  # display Cookies if needed  (they must come before the Content-Type header)
  my $temp_str = $self->displayCookies();
  $output .= $temp_str if (length $temp_str > 0);

  if ((length $deck == 0 && scalar keys %{$self->{decks}} == 1) || exists $self->{decks}->{$deck})
  {  
    # Display the Content-Type block.
    $output .= "Content-Type: $self->{contentTypeString}" . (length $self->{charsetEncoding} > 0 ? "; charset=$self->{charsetEncoding}" : "") . "\n\n";  
  
    if ($self->{type} eq "WML")
    {
      # output the Document Type header.
      $output .= "<?xml version=\"1.0\"?>\n";
      $output .= "<!DOCTYPE wml PUBLIC \"-//PHONE.COM//DTD WML 1.1//EN\" \"http://www.phone.com/dtd/wml11.dtd\">\n";
    }
    if (length $deck == 0)
    {
      $deck = $self->{decksOrder}->[0];
    }
    
    # now display the selected deck.
    $output .= $self->{decks}->{$deck}->display;
    if ($self->{decks}->{$deck}->didErrorOccur)
    {
      die $self->{decks}->{$deck}->errorMessage;
    }
  }
  else  # we are doing a digest!  do this later.
  {
  }

  print $output;
}

# doRequiredParameterError - Displays the customized title and message and then exits the program.
sub doRequiredParameterError
{
  my $self = shift;
  my $title_name = shift;
  my $message_name = shift;

  $self->setError(code => '1002');
  $self->displayError(title => "Error:  $title_name", message => "$message_name is required!");
}

# encodeString
# parameters are: string
# returns: url encoded string
sub encodeString
{
  my $self = shift;
  my %args = ( @_,  # arguments go here.
  	     );

  my $string = $args{'string'};

  if (!exists $args{'string'})
  {
    $self->doRequiredParameterError('encodeString', 'string');
  }

  foreach my $char (@{$self->{encodeCharacters}})
  {
    my $value = $self->{encodeCharactersHash}->{$char};
    $string  =~ s/$char/$value/g;
  }

  return $string;
}

# formEncodeString
# takes: string
# returns: form encoded string
sub formEncodeString
{
  my $self = shift;
  my %args = ( @_ );
  my $string = $args{string};
  
  if (!exists $args{string})
  {
    $self->doRequiredParameterError('formEncodeString', 'string');
  }
  
  foreach my $char (@{$self->{formCharacters}})
  {
    my $value = $self->{formCharactersHash}->{$char};
    $string =~ s/$char/$value/g;
  }
  
  return $string;
}

# setCookie
# parameters are: name, value, expires, path, domain, secure
sub setCookie
{
  my $self = shift;
  my %args = ( name => '',
  	       value => '',
  	       @_,  # arguments go here.
  	     );

  my $name = $args{'name'};
  my $value = $args{'value'};

  if (length $name == 0)
  {
    $self->doRequiredParameterError('setCookie', 'name');
  }

  $name = $self->encodeString( string => "$name" );
  $value = $self->encodeString( string => "$value" );
  	
  my $cookie = "$name=$value;";

  if (exists $args{'expires'})
  {
    my $date = $args{'expires'};

    if ($date =~ /^\w{3}\,\s\d{2}\-\w{3}-\d{4}\s\d{2}\:\d{2}\:\d{2}\sGMT$/)
    {
      $cookie .= " expires=$args{'expires'};";
    }
    else
    {
      $self->setError(code => '1004');
      $self->displayError(title => 'setCookie', message => "date = '$date' is invalid!");
    }
  }
  if (exists $args{'path'})
  {
    $cookie .= " path=$args{'path'};";
  }
  if (exists $args{'domain'})
  {
    my $domain = $args{'domain'};
    if ($domain =~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i && $domain =~ /\..+\.\w{3}$/)
    {
      $cookie .= " domain=$args{'domain'};";
    }
    elsif ($domain !~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i && $domain =~ /\..+\..+\..+/)
    {
      $cookie .= " domain=$args{'domain'};";
    }
    else
    {
      $self->setError(code => '1005');
      $self->displayError(title => 'setCookie', message => "domain = '$domain' is invalid!");
    }
  }
  if (exists $args{'secure'})
  {
    $cookie .= " secure";
  }

  my $num = scalar @{$self->{cookies}};
  $self->{cookies}[$num] = $cookie;  # store the cookie string in the cookies array.
}

# setCompressedCookie
# parameters: name, @cookies, expires, path, domain, secure
sub setCompressedCookie
{
  my $self = shift;
  my %args = ( name => '',
  	       @_,  # arguments go here.
  	     );

  if (!exists $args{'cookies'})
  {
    $self->doRequiredParameterError('setCookie', 'cookies');
  }
  	
  my $name = $args{'name'};
  my @localCookies = @{$args{'cookies'}};
  my $cookieValue = "";  # The value for this compressed cookie to be set.

  if (length $name == 0)
  {
    $self->doRequiredParameterError('setCookie', 'name');
  }
  if (scalar @localCookies == 0)
  {
    $self->doRequiredParameterError('setCookie', 'cookies');
  }

  for (my $i=0; $i < scalar @localCookies; $i++)
  {
    my $subCookie = $localCookies[$i][0];
    my $subValue  = $localCookies[$i][1];

    $subCookie = $self->encodeString( string => "$subCookie" );
    $subValue = $self->encodeString( string => "$subValue" );

    if (length $cookieValue > 0)
    {
      $cookieValue .= "&" . $subCookie . "::" . $subValue;
    }
    else
    {
      $cookieValue = $subCookie . "::" . $subValue;
    }
  }

  my $arguments = "";
  if (exists $args{'path'})
  {
    $arguments .= ", path => '$args{'path'}'";
  }
  if (exists $args{'domain'})
  {
    $arguments .= ", domain => '$args{'domain'}'";
  }
  if (exists $args{'expires'})
  {
    $arguments .= ", expires => '$args{'expires'}'";
  }
  if (exists $args{'secure'})
  {
    $arguments .= ", secure => ''";
  }

  # now set the cookie by calling setCookie.
  eval("\$self->setCookie(name => \"$name\", value => \"$cookieValue\"$arguments);");
  if ($@)
  {
    $self->setError(code => '1003');
    $self->displayError(title => 'setCompressedCookies', message => "\$@ = $@");
  }
}

# createDeck
# requires: id
# optional: url
#  type = WML
#    requires:
#    optional: lang, displayLang
#  type = HDML
#    requires: version
#    optional: ttl, markable, public, accessdomain, accesspath
# returns: 1=OK, 0=Error, -1=Already exists
sub createDeck
{
  my $self = shift;
  my %args = ( id => "deck0", url => "", @_ );
  my $id = $args{id};
  my $url = $args{url};
  
  if (length $id == 0)
  {
    $self->doRequiredParameterError('createDeck', 'id');
  }
  
  if (exists $self->{decks}->{$id})
  {
    return -1;  # already exists
  }
  
  my $deckObj;
  if ($self->{type} eq "WML")
  {
    my %attributes = ( id => $id );
    $attributes{digestURL} = $url if (length $url > 0);
    $attributes{lang} = $args{lang} if (exists $args{lang});
    $attributes{displayLang} = $args{displayLang} if (exists $args{displayLang});
    
    $deckObj = HTMLObject::WMLDeck->new(%attributes);
  }
  elsif ($self->{type} eq "HDML")
  {
    my %attributes = ( id => $id );
    $attributes{digestURL} = $url if (length $url > 0);
    $attributes{ttl} = $args{ttl} if (exists $args{ttl});
    $attributes{markable} = $args{markable} if (exists $args{markable});
    $attributes{public} = $args{public} if (exists $args{public});
    $attributes{accessdomain} = $args{accessdomain} if (exists $args{accessdomain});
    $attributes{accesspath} = $args{accesspath} if (exists $args{accesspath});
    
    $deckObj = HTMLObject::HDMLDeck->new(%attributes);
  }
  if ($deckObj->didErrorOccur)
  {
    print "Error occurred in createDeck: $deckObj->errorMessage";
    $self->setError(code => 1012);
    $self->displayError(title => "Error: createDeck", message => $deckObj->errorMessage);
  }
  
  $self->{decks}->{$id} = $deckObj;
  push @{$self->{decksOrder}}, $id;
  $self->{currentDeck} = $id;
  
  return 1;
}

# createCard
# requires: id
# optional: cardType (if type=HDML), all other attributes needed by the WML or HDML Card Object.
# returns: 1=OK, 0=Error, -1=Already exists
sub createCard
{
  my $self = shift;
  my %args = ( id => "card0", @_ );
  
  if (length $args{id} == 0)
  {
    $self->doRequiredParameterError('createCard', 'id');
  }
  
  if (scalar keys %{$self->{decks}} == 0 || $self->{currentDeck} eq "")
  {
    $self->setError(code => 1012);
    $self->displayError(title => "Error: createCard", message => "no decks exist or current deck invalid!");
  }
  
  my $result = $self->{decks}->{$self->{currentDeck}}->createCard(%args);
  if ($self->{decks}->{$self->{currentDeck}}->didErrorOccur)
  {
    $self->setError(code => 1012);
    $self->displayError(title => "Error: createCard", message => $self->{decks}->{$self->{currentDeck}}->errorMessage);
  }
  
  return $result;
}

# setFocus
# takes: location
# returns: oldlocation
sub setFocus
{
  my $self = shift;
  my $focus = shift;

  my $oldLocation = $self->{decks}->{$self->{currentDeck}}->setFocus($focus);
  if ($self->{decks}->{$self->{currentDeck}}->didErrorOccur)
  {
    $self->setError(code => '1012');
    $self->displayError(title => "Error:  set_focus", message => $self->{decks}->{$self->{currentDeck}}->errorMessage);
  }
  
  return $oldLocation;
}

# setCardFocus
# takes: location
# returns: oldlocation
sub setCardFocus
{
  my $self = shift;
  my $focus = shift;
  
  if ($self->{type} eq "WML")
  {
    return "";
  }

  my $oldLocation = $self->{decks}->{$self->{currentDeck}}->setCardFocus($focus);
  if ($self->{decks}->{$self->{currentDeck}}->didErrorOccur)
  {
    $self->setError(code => '1012');
    $self->displayError(title => "Error:  set_focus", message => $self->{decks}->{$self->{currentDeck}}->errorMessage);
  }
  
  return $oldLocation;
}

# print
sub print
{
  my $self = shift;
  my $text = shift;

  $self->{decks}->{$self->{currentDeck}}->print($text);
  if ($self->{decks}->{$self->{currentDeck}}->didErrorOccur)
  {
    $self->setError(code => '1012');
    $self->displayError(title => "Error:  print", message => $self->{decks}->{$self->{currentDeck}}->errorMessage);
  }
}

# printHead
# only valid if WML
sub printHead
{
  my $self = shift;
  my $text = shift;

  if ($self->{type} eq "WML")
  {
    $self->{decks}->{$self->{currentDeck}}->printHead($text);
    if ($self->{decks}->{$self->{currentDeck}}->didErrorOccur)
    {
      $self->setError(code => '1012');
      $self->displayError(title => "Error:  print", message => $self->{decks}->{$self->{currentDeck}}->errorMessage);
    }
  }
}

# printTemplate
# only valid if WML
sub printTemplate
{
  my $self = shift;
  my $text = shift;

  if ($self->{type} eq "WML")
  {
    $self->{decks}->{$self->{currentDeck}}->printTemplate($text);
    if ($self->{decks}->{$self->{currentDeck}}->didErrorOccur)
    {
      $self->setError(code => '1012');
      $self->displayError(title => "Error:  print", message => $self->{decks}->{$self->{currentDeck}}->errorMessage);
    }
  }
}

1;
__END__

=head1 NAME

HTMLObject::WAP - Perl extension for HTMLObject.

=head1 SYNOPSIS

  use HTMLObject::WAP;
  my $doc = HTMLObject::WAP->new(type => "WML",
            version => "1.1", language => "en",
            charsetEncoding => "");

  $doc->createDeck(id => "hello");
  $doc->createCard(id => "card1");
  $doc->print(<<"END_OF_BODY");
  <p>
  HTMLObject::WAP<br/>
  This is cool!<br/>
  </p>
  END_OF_BODY

  $doc->setCookie(name => 'testing', value => 'WML 1.1');

  # Actually generate the entire document, cookie and all!
  $doc->display();

=head1 DESCRIPTION

HTMLObject::WAP provides the Base methods needed to create a generic
WAP document dynamically.  See documentation.html for complete details.
It supports Internationalization.

=head1 Exported FUNCTIONS

  scalar new(type, version, language, charsetEncoding)
    Creates a new instance of the HTMLObject::WAP document type.
    type = (WML or HDML) - the type of document to create
    version = (1.1 or 3 - the version of WML or HDML to use)

  void reset(type, version, language, charsetEncoding)
    Resets the HTMLObject::WAP document back to the defaults.

  void setErrorMessage(code => '', message => '')
    This adds the error message associated with code to the
    errorMessages hash. Modifies %errorMessages.

  void clearErrorMessage(code => '')
    This removes the message associated with code from the
    errorMessages hash. Modifies %errorMessages.

  void setError(code => '')
    This takes the code and sets $error=1, $errorCode = $code. This is a
    helper function for the derived classes to use to signal when an
    error has occurred. Modifies $error and $errorCode.

  scalar didErrorOccur()
    Returns 1 if an error occurred, 0 otherwise.

  scalar getErrorMessage()
    Returns the message that was generated via the code that was set.

  scalar getErrorCode()
    Returns the code that was set to indicate the error that occurred.

  void doRequiredParameterError(title => '', message => '')
    Creates an Error document using the customized title to display the
    error of Required Parameter missing. The specified message is also
    included in the body so that the program can notify the user of what
    variable is missing. Uses displayError() to generate the Error
    document.
    
  int createDeck(name, url)
    creates the deck named name in the decks hash and stores the url
    given for use in digest mode.  The url is not needed unless you
    are creating more than 1 deck.
    
  int createCard(id, ...)
    calls the currently selected deck's createCard method passing
    in all parameters passed into itself.

  void display()
    This function generates the WAP Document displaying any cookies,
    plus the contents of the Body that the user created.  This function
    prints the generated document to standard out which is then hopefully
    being sent to a web server to process.

  void displayError(title => '', message => '')
    Creates a HTML document that displays the user specified error
    message along with the error message generated by the program. The
    user specified title is used also. The program is exited after the
    document is displayed. Uses display() to generate the actual document.

  scalar encodeString(string => '')
    URI encodes the string and returns the result.

  scalar formEncodeString(string => '')
    encode the string to replace all HTML special characters with their
    tag equivalents.  Ex.  & => &amp;

  void setCookie(name => '', value => '', expires => '', path => '',
                  domain => '', secure => '')
    Creates an entry in the cookies array that specifies the name=value
    pair and the expiration date and if it is to be secure for the
    specified cookie.  If secure is defined then it is included in the
    Set-Cookie line, else it is left out. The value does not matter as it
    is a tag in the Set-Cookie line and not a name=value item. Modifies
    @cookies.

    Valid formats for the expiration date are:
             Weekday, dd-Mon-yyyy hh:mm:ss GMT
    Valid formats for the domain are:
             The domain must be within the current domain and must have
             2 or more periods depending on the type of domain.
             Ex. ".host.com"

  void setCompressedCookie(name => '', cookies => [name, value],
                             expires => '', path => '', domain => '',
                             secure => '')
    Creates an entry in the cookies array that specifes the name=value
    pair where the value is the embedded cookies to be stored in this
    cookie. The embedded cookies are seperated with a :: but other than
    that everything else is the same as setCookie. The cookies hash
    entry is pointing to an array where each entry is another array with
    the first entry being the name and the second entry the value for
    each embedded cookie. Modifies @cookies.

  scalar setFocus(section) (scalar value)
    Calls the current deck's setFocus method to signal which card to
    work with.  Returns the previously selected card.  If nothing
    passed in, then just returns the currently selected card.
    
  scalar setCardFocus(location) (scalar value)
    Calls the current deck's setCardFocus method to signal the current
    card to set it's focus to the specified location and then return
    the previous location.  If nothing is passed in just returns the 
    current location.  
    
  void print(string) (scalar value)
    Appends the contents of string to the currently specified section.
    This could modify $head_string or $body_string.

  void printHead(string) (scalar value)
    Appends the contents of string to the currently specified WML Decks
    head section. This modifies $head.
  
  void printTemplate(string) (scalar value)
    Appends the contents of string to the currently specified WML Decks
    template section.  This modifies $template.

=head1 AUTHOR

James A. Pattie, htmlobject@pcxperience.com

=head1 SEE ALSO

perl(1), HTMLObject::Base(3), HTMLObject::Normal(3), HTMLObject::FrameSet(3), HTMLObject::ReadCookie(3).

=cut