# Base.pm - The Base Class that the FrameSet and Normal HTML document Objects
# are derived from.
# Created by James Pattie, 04/27/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.

# updated 02/24/2001 - Converted to new method and variable naming convention.
# updated 06/05/2001 - Add non-Buffering mode.
# updated 10/06/2001 - Added debug display code and tag substitution support.
# updated 10/08/2001 - Started to fix the indentation problem with textareas.
# updated 10/15/2001 - Removing the error if the tag doesn't exist in printTag.
# updated 10/23/2001 - Added support to decode a string which has form encoded chars in it.
# updated 11/20/2001 - Added support for selecting the version of HTML to generate a DOCTYPE for.

package HTMLObject::Base;
use strict;
use POSIX qw(strftime);
use Date::Manip qw(ParseDate UnixDate DateCalc Date_ConvTZ);
use vars qw($AUTOLOAD $VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

=head1 NAME

HTMLObject::Base - Perl extension for HTMLObject.

=head1 SYNOPSIS

  use HTMLObject::Base;
  my $doc = HTMLObject::Base->new();

  $doc->setTitle("Test of HTMLObject::Base");
  $doc->setFocus("body");
  $doc->print(<<"END_OF_BODY");
  <center>
  <h1>HTMLObject::Base</h1>
  <br />
  This is cool!
  END_OF_BODY

  $doc->setCookie(name => 'cookie name', value => 'This rocks!');

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

=head1 DESCRIPTION

HTMLObject::Base provides the Base methods needed to create a generic
HTML document dynamically.  See documentation.html for complete details.
It now supports Internationalization via the lang and charset
attributes of the html tag and the Content-type.

=head1 Exported FUNCTIONS

=over 4

=cut

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw(
);

$VERSION = '2.30';

# pre-declare the variables so that I can access them from the HTMLObject::Form module, etc.
use vars qw($formEncodedCharacters %formEncodedCharactersHash $formUnEncodedCharacters %formUnEncodedCharactersHash @htmlTags @htmlTagArgs $encodeCharacters %codeToCharset %codeToLanguage %doctypesHash %xhtmlDocTypesHash);

# Internationalization support

%codeToLanguage = (
  "ab" => "Abkhazian",
  "om" => "Afan",
  "aa" => "Afar",
  "af" => "Afrikaans",
  "sq" => "Albanian",
  "am" => "Amharic",
  "ar" => "Arabic",
  "hy" => "Armenian",
  "as" => "Assamese",
  "ay" => "Aymara",
  "az" => "Azerbaijani",
  "ba" => "Bashkir",
  "eu" => "Basque",
  "bn" => "Bengali",
  "dz" => "Bhutani",
  "bh" => "Bihari",
  "bi" => "Bislama",
  "br" => "Breton",
  "bg" => "Bulgarian",
  "my" => "Burmese",
  "be" => "Byelorussian",
  "km" => "Cambodian",
  "ca" => "Catalan",
  "zh" => "Chinese",
  "co" => "Corsican",
  "hr" => "Croatian",
  "cs" => "Czech",
  "da" => "Danish",
  "nl" => "Dutch",
  "en" => "English",
  "eo" => "Esperanto",
  "et" => "Estonian",
  "fo" => "Faroese",
  "fj" => "Fiji",
  "fi" => "Finnish",
  "fr" => "French",
  "fy" => "Frisian",
  "gl" => "Galician",
  "ka" => "Georgian",
  "de" => "German",
  "el" => "Greek",
  "kl" => "Greenlandic",
  "gn" => "Guarani",
  "gu" => "Gujarati",
  "ha" => "Hausa",
  "he" => "Hebrew", # used to be iw
  "hi" => "Hindi",
  "hu" => "Hungarian",
  "is" => "Icelandic",
  "id" => "Indonesian",
  "ia" => "Interlingua",
  "ie" => "Interlingue",
  "iu" => "Inuktitut",
  "ik" => "Inupiak",
  "ga" => "Irish",
  "it" => "Italian",
  "ja" => "Japanese",
  "jv" => "Javanese",
  "kn" => "Kannada",
  "ks" => "Kashmiri",
  "kk" => "Kazakh",
  "rw" => "Kinyarwanda",
  "ky" => "Kirghiz",
  "rn" => "Kurundi",
  "ko" => "Korean",
  "ku" => "Kurdish",
  "lo" => "Laothian",
  "la" => "Latin",
  "lv" => "Latvian",
  "ln" => "Lingala",
  "lt" => "Lithuanian",
  "mk" => "Macedonian",
  "mg" => "Malagasy",
  "ms" => "Malay",
  "ml" => "Malayalam",
  "mt" => "Maltese",
  "mi" => "Maori",
  "mr" => "Marathi",
  "mo" => "Moldavian",
  "mn" => "Mongolian",
  "na" => "Nauru",
  "ne" => "Nepali",
  "no" => "Norwegian",
  "oc" => "Occitan",
  "or" => "Oriya",
  "ps" => "Pashto",
  "fa" => "Persian",
  "pl" => "Polish",
  "pt" => "Portuguese",
  "pa" => "Punjabi",
  "qu" => "Quechua",
  "rm" => "Rhaeto-Romance",
  "ro" => "Romanian",
  "ru" => "Russian",
  "sm" => "Samoan",
  "sg" => "Sangho",
  "sa" => "Sanskrit",
  "gd" => "Scots Gaelic",
  "sr" => "Serbian",
  "sh" => "Serbo-Croatian",
  "st" => "Sesotho",
  "tn" => "Setswana",
  "sn" => "Shona",
  "sd" => "Sindhi",
  "si" => "Singhalese",
  "ss" => "Siswati",
  "sk" => "Slovak",
  "sl" => "Slovenian",
  "so" => "Somali",
  "es" => "Spanish",
  "su" => "Sundanese",
  "sw" => "Swahili",
  "sv" => "Swedish",
  "tl" => "Tagalog",
  "tg" => "Tajik",
  "ta" => "Tamil",
  "tt" => "Tatar",
  "te" => "Telugu",
  "th" => "Thai",
  "bo" => "Tibetan",
  "ti" => "Tigrinya",
  "to" => "Tonga",
  "ts" => "Tsonga",
  "tr" => "Turkish",
  "tk" => "Turkmen",
  "tw" => "Twi",
  "ug" => "Uigur",
  "uk" => "Ukrainian",
  "ur" => "Urdu",
  "uz" => "Uzbek",
  "vi" => "Vietnamese",
  "vo" => "Volapuk",
  "cy" => "Welsh",
  "wo" => "Wolof",
  "xh" => "Xhosa",
  "yi" => "Yiddish",
  "yo" => "Yoruba",
  "za" => "Zhuang",
  "zu" => "Zulu",
 );

# This hash takes the 2 letter abreviation and returns the charset encoding to use with it.  It is possible to return an array if there is more than
# one possible encoding that is standard for that language.
%codeToCharset = (
  "af" => [ "iso-8859-1", "windows-1252" ],
  "sq" => [ "iso-8859-1", "windows-1252" ],
  "ar" => "iso-8859-6",
  "eu" => [ "iso-8859-1", "windows-1252" ],
  "bg" => "iso-8859-5",
  "be" => "iso-8859-5",
  "ca" => [ "iso-8859-1", "windows-1252" ],
  "hr" => "iso-8859-2",
  "cs" => "iso-8859-2",
  "da" => [ "iso-8859-1", "windows-1252" ],
  "nl" => [ "iso-8859-1", "windows-1252" ],
  "en" => [ "iso-8859-1", "windows-1252" ],
  "eo" => "iso-8859-3",
  "et" => "iso-8859-10",
  "fo" => [ "iso-8859-1", "windows-1252" ],
  "fi" => [ "iso-8859-1", "windows-1252" ],
  "fr" => [ "iso-8859-1", "windows-1252" ],
  "gl" => [ "iso-8859-1", "windows-1252" ],
  "de" => [ "iso-8859-1", "windows-1252" ],
  "el" => "iso-8859-7",
  "he" => "iso-8859-8",
  "hu" => "iso-8859-2",
  "is" => [ "iso-8859-1", "windows-1252" ],
  "ga" => [ "iso-8859-1", "windows-1252" ],
  "it" => [ "iso-8859-1", "windows-1252" ],
  "ja" => [ "shift_jis", "iso-2022", "euc-jp" ],
  "lv" => "iso-8859-10",
  "lt" => "iso-8859-10",
  "mk" => "iso-8859-5",
  "mt" => "iso-8859-3",
  "no" => [ "iso-8859-1", "windows-1252" ],
  "pl" => "iso-8859-2",
  "pt" => [ "iso-8859-1", "windows-1252" ],
  "ro" => "iso-8859-2",
  "ru" => [ "koi-8-r", "windows-1252" ],
  "sr" => "iso-8859-5",
  "sk" => "iso-8859-2",
  "sl" => "iso-8859-2",
  "es" => [ "iso-8859-1", "windows-1252" ],
  "sv" => [ "iso-8859-1", "windows-1252" ],
  "tr" => [ "iso-8859-9", "windows-1254" ],
  "uk" => "iso-8859-5",
 );

$encodeCharacters = ';,=&: \n"#$\/?<>@';

# removed the \$ => \$\$ conversions as they don't appear to be needed and removed ' => &apos;
$formEncodedCharacters = '&amp;|&lt;|&gt;|&quot;';
%formEncodedCharactersHash = ( '&lt;' => '<', '&gt;' => '>', '&quot;' => '"', '&amp;' => '&', );
$formUnEncodedCharacters = '<>"';
%formUnEncodedCharactersHash = ( '<' => '&lt;', '>' => '&gt;', '"' => '&quot;', '&' => '&amp;', );

@htmlTags = qw /a abbr acronym address area b base basefont bdo big blockquote
                  br button caption center cite code col colgroup dd del dfn dir
                  div dl dt em fieldset font form h1 h2 h3 h4 h5 h6 hr i iframe
                  img input ins isindex kbd label legend li map menu object ol
                  optgroup option p param pre q s samp script select small span
                  strike strong sub sup table tbody td textarea tfoot th thead
                  tr tt u ul var/;

@htmlTagArgs = qw/abbr accept-charset accept accesskey action align alt archive
                  axis bgcolor border cellpadding cellspacing char charoff
                  charset checked cite class clear codebase color cols colspan
                  compact coords datetime dir disabled enctype face for frame
                  headers height href hreflang hspace id ismap label lang
                  longdesc marginheight marginwidth maxlength method
                  multiple name nohref noshade nowrap onblur onchange onclick
                  ondblclick onfocus onkeydown onkeypress onkeyup onmousedown
                  onmousemove onmouseout onmouseover onmouseup onselect
                  onsubmit prompt readonly rel rows rowspan rules scope
                  scrolling selected shape size span src start style summary
                  tabindex target title type usemap valign value valuetype
                  vspace width/;

# supported DOCTYPE's
%doctypesHash = ( "4.0" =>
                       {
                         "strict" => "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0//EN\" \"http://www.w3.org/TR/REC-html40/strict.dtd\">",
                         "loose" => "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" \"http://www.w3.org/TR/REC-html40/loose.dtd\">",
                       },
                     "4.01" =>
                       {
                         "strict" => "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">",
                         "loose" => "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">",
                       },
                   );

%xhtmlDocTypesHash = ( "1.0" =>
                          {
                            "strict" => "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">",
                            "loose" => "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">",
                          },
                        );

=item scalar new(displayOnExit)

 Creates a new instance of the HTMLObject::Base document type.

 Optional: displayOnExit - boolean (1 or 0).  If true (1), when the
 object goes out of scope and the display() or startDisplaying()
 methods have not been called and we have not been instructed to
 not display via the doNotDisplay() method, then we call display()
 thus transparently making sure the object is output to the user.

 displayOnExit defaults to 0 (false).

=cut

sub new
{
  my $that = shift;
  my $class = ref($that) || $that;
  my $self = bless {}, $class;
  my %args = ( displayOnExit => 0, @_ );

  $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 Language Code");
  $self->setErrorMessage(code => '1010', message => "Recognized Language Code but No Charset Encoding Known");
  $self->setErrorMessage(code => '1011', message => "Charset Encoding Not Valid");
  $self->setErrorMessage(code => '1012', message => "In Buffering Mode");
  $self->setErrorMessage(code => '1013', message => "In non-Buffering Mode");
  $self->setErrorMessage(code => '1014', message => "Invalid variable or function");
  $self->setErrorMessage(code => '3000', message => 'Parameters and Options are both required if they are to be used');
  $self->setErrorMessage(code => '3001', message => 'Invalid Decoration type specified');
  $self->setErrorMessage(code => '3002', message => 'Value must be specified');
  $self->setErrorMessage(code => '3010', message => "Tag not found");
  $self->setErrorMessage(code => '1015', message => 'Invalid HTML Version');
  $self->setErrorMessage(code => '1016', message => 'Invalid HTML DTD');
  $self->setErrorMessage(code => '1017', message => 'Invalid Value');

  $self->{errorCode} = -1;

  $self->{displayOnExit} = $args{displayOnExit};
  $self->{doNotDisplay} = 0;  # by default we want to display, if displayOnExit = 1.
  $self->{weHaveDisplayed} = 0; # by default we haven't displayed yet.

  $self->{currentSection} = "body";
  $self->{titleString} = "HTMLObject::Base";
  $self->{contentTypeString} = "text/html";
  $self->{language} = "en";
  $self->{charsetEncoding} = "iso-8859-1";
  $self->{headString} = "";
  $self->{bodyString} = "";
  $self->{bodyBgcolor} = "white";
  $self->{bodyFgcolor} = "black";
  $self->{bodyImage} = "";
  $self->{bodyLinkColor} = "blue";
  $self->{bodyVlinkColor} = "blue";
  $self->{bodyAlinkColor} = "blue";
  $self->{bodyClass} = "";
  $self->{bodyID} = "";
  $self->{bodyStyle} = "";
  $self->{bodyTitle} = "";
  $self->{bodyCustomArgs} = "";   # stores user defined attributes for the body tag.
  $self->{cookies} = [];
  $self->{metaTags} = [];
  $self->{encodeCharacters} = $encodeCharacters;
  $self->{formEncodedCharacters} = $formEncodedCharacters;
  $self->{formUnEncodedCharacters} = $formUnEncodedCharacters;
  $self->{formEncodedCharactersHash} = \%formEncodedCharactersHash;
  $self->{formUnEncodedCharactersHash} = \%formUnEncodedCharactersHash;
  $self->{linkTag} = [];
  $self->{baseHrefString} = "";
  $self->{baseTargetString} = "";
  $self->{cssEntries} = [];

  $self->{codeToLanguageHash} = \%codeToLanguage;
  $self->{codeToCharsetHash} = \%codeToCharset;

  $self->{bufferMode} = 1;  # we default to buffer the data.
  $self->{allreadyClosed} = 0; # we default to not yet closing the document.

  $self->{tagBuffers} = ();
  $self->{tagBufferModes} = ();

  # define the DOCTYPE's possible.
  $self->{doctypes} = \%doctypesHash;
  $self->{xhtmlDoctypes} = \%xhtmlDocTypesHash;
  $self->{htmlVersion} = "4.01";
  $self->{htmlDTD} = "loose";
  $self->{xhtml} = 0;  # by default we do not use xhtml code.
  $self->{docEncoding} = "iso-8859-1";
  $self->{displayDTD} = 1;  # by default we always display the DTD.

  # define the htmlTags we know about.
  $self->{htmlTags} = \@htmlTags;
  $self->{htmlTagArgs} = \@htmlTagArgs;

  # Add Location: support
  $self->{location} = "";

  return $self;
}

=item void setErrorMessage(code => '', message => '')

 This adds the error message associated with code to the
 errorMessages hash. Modifies %errorMessages.

=cut
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;
}

=item void clearErrorMessage(code => '')

 This removes the message associated with code from the
 errorMessages hash. Modifies %errorMessages.

=cut
sub clearErrorMessage
{
  my $self = shift;
  my $code;
  if (scalar @_ == 1)
  {
    $code = shift;
  }
  else
  {
    my %args = ( @_, );

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

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

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

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

=item void setError(code => '')

 This takes the code and sets $self->{error}=1,
 $self->{errorCode} = $code. This is a helper function
 for the derived classes to use to signal when an
 error has occurred. Modifies $self->{error} and $self->{errorCode}.

=cut
sub setError
{
  my $self = shift;
  my $code;
  if (scalar @_ == 1)
  {
    $code = shift;
  }
  else
  {
    my %args = ( @_, );

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

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

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

=item scalar didErrorOccurr() - (This is gone in 2.x series.)

 See didErrorOccur().

=item scalar didErrorOccur()

 Returns 1 if an error occurred, 0 otherwise.

=cut
sub didErrorOccur
{
  my $self = shift;

  return $self->{error};
}

=item scalar getErrorMessage()

 Returns the message that was generated via the code that was set.

=cut
sub getErrorMessage
{
  my $self = shift;

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

=item scalar getErrorCode()

 Returns the code that was set to indicate the error that occurred.

=cut
sub getErrorCode
{
  my $self = shift;

  return $self->{errorCode};
}

=item void reset()

 Resets the HTMLObject::Base document back to the defaults.

=cut
sub reset
{
  my $self = shift;

  $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 Language Code");
  $self->setErrorMessage(code => '1010', message => "Recognized Language Code but No Charset Encoding Known");
  $self->setErrorMessage(code => '1011', message => "Charset Encoding Not Valid");
  $self->setErrorMessage(code => '1012', message => "In Buffering Mode");
  $self->setErrorMessage(code => '1013', message => "In non-Buffering Mode");
  $self->setErrorMessage(code => '1014', message => "Invalid variable or function");
  $self->setErrorMessage(code => '3000', message => 'Parameters and Options are both required if they are to be used');
  $self->setErrorMessage(code => '3001', message => 'Invalid Decoration type specified');
  $self->setErrorMessage(code => '3002', message => 'Value must be specified');
  $self->setErrorMessage(code => '3010', message => "Tag not found");
  $self->setErrorMessage(code => '1015', message => 'Invalid HTML Version');
  $self->setErrorMessage(code => '1016', message => 'Invalid HTML DTD');
  $self->setErrorMessage(code => '1017', message => 'Invalid Value');

  $self->{errorCode} = -1;

  $self->{currentSection} = "body";
  $self->{titleString} = "HTMLObject::Base";
  $self->{contentTypeString} = "text/html";
  $self->{language} = "en";
  $self->{charsetEncoding} = "iso-8859-1";
  $self->{headString} = "";
  $self->{bodyString} = "";
  $self->{bodyBgcolor} = "white";
  $self->{bodyFgcolor} = "black";
  $self->{bodyImage} = "";
  $self->{bodyLinkColor} = "blue";
  $self->{bodyVlinkColor} = "blue";
  $self->{bodyAlinkColor} = "blue";
  $self->{bodyClass} = "";
  $self->{bodyID} = "";
  $self->{bodyStyle} = "";
  $self->{bodyTitle} = "";
  $self->{bodyCustomArgs} = "";   # stores user defined attributes for the body tag.
  $self->{cookies} = [];
  $self->{metaTags} = [];
  $self->{encodeCharacters} = $encodeCharacters;
  $self->{formEncodedCharacters} = $formEncodedCharacters;
  $self->{formUnEncodedCharacters} = $formUnEncodedCharacters;
  $self->{formEncodedCharactersHash} = \%formEncodedCharactersHash;
  $self->{formUnEncodedCharactersHash} = \%formUnEncodedCharactersHash;
  $self->{linkTag} = [];
  $self->{baseHrefString} = "";
  $self->{baseTargetString} = "";
  $self->{cssEntries} = [];

  $self->{codeToLanguageHash} = \%codeToLanguage;
  $self->{codeToCharsetHash} = \%codeToCharset;

  # we can't reset these if they have already happened!
  #$self->{bufferMode} = 1;  # we default to buffer the data.
  #$self->{allreadyClosed} = 0; # we default to not yet closing the document.

  $self->{tagBuffers} = ();
  $self->{tagBufferModes} = ();

  # define the DOCTYPE's possible.
  $self->{doctypes} = \%doctypesHash;
  $self->{xhtmlDoctypes} = \%xhtmlDocTypesHash;
  $self->{htmlVersion} = "4.01";
  $self->{htmlDTD} = "loose";
  $self->{xhtml} = 0;  # by default we do not use xhtml code.
  $self->{docEncoding} = "iso-8859-1";
  $self->{displayDTD} = 1;  # by default we always display the DTD.

  # define the htmlTags we know about.
  $self->{htmlTags} = \@htmlTags;
  $self->{htmlTagArgs} = \@htmlTagArgs;

  # Add Location: support
  $self->{location} = "";

}

=item void setDocumentEncoding(encoding => "UTF-8")

 requires: encoding - document encoding value default of UTF-8
 This function sets the documents encoding format.  Your document
 defaults to iso-8859-1 if you do not use this method to change it.
 This is only available if working with an XHTML document.

=cut
sub setDocumentEncoding
{
  my $self = shift;
  my $encoding;
  if (scalar @_ == 1)
  {
    $encoding = shift;
  }
  else
  {
    my %args = (encoding => "UTF-8", @_);
    $encoding = $args{encoding};
  }

  if (strlen $encoding == 0)
  {
    $self->doRequiredParameterError('Base::setDocumentEncoding', 'encoding');
  }

  $self->{docEncoding} = $encoding;
}

=item scalar getDocumentEncoding()

 returns the current document encoding value.
 This is only available if working with an XHTML document.

=cut
sub getDocumentEncoding
{
  my $self = shift;

  return $self->{docEncoding};
}

=item void displayError(title => '', message => '', debug => 0|1)

 optional: debug (defaults to 0)
 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.  If debug is specified and equals 1, then the
 contents of the calling Document will be output in a viewable format
 so that the user can determine what would have been generated.

=cut
sub displayError
{
  my $self = shift;
  my %args = (  title => 'Error: HTMLObject::Base',
    message => 'An Error Occurred!', debug => 0,
    @_ # arguments passed in go here.
     );
  my $debug = $args{debug};

  if ($self->{bufferMode})
  {
    $self->doNotDisplay(1);  # don't try and display ourselves since an error occured.

    my $doc = HTMLObject::Base->new();

    $doc->setTitle($args{'title'});
    $doc->setFocus("body");
    $doc->print("<center><h1>HTMLObject</h1></center><br />\n");
    $doc->print("<h1>Error: &nbsp;<b>" . $self->getErrorCode() . "</b> Occurred!</h1>\n");
    $doc->print("Message: &nbsp;" . $self->getErrorMessage() . "\n<br />\n");
    $doc->print("<br />\n<br />\n$args{'message'}\n<br />\n");
    $doc->setStyleEntry(tag => "body", string => "color: #000000; background-color: #ffffff;") if ($self->{xhtml});

    # set the HTMLInfo based upon what was previously set.
    my %docInfo = $self->getHTMLInfo();
    $docInfo{dtd} = "loose" if ($docInfo{dtd} eq "frameset");
    $doc->setHTMLInfo(%docInfo);

    if ($debug == 1)
    {
      my $output = $self->display(debug => 1);
      $output =~ s/^(.*)$/&nbsp;&nbsp;$1/mg;
      $output =~ s/^(.*)$/      $1/mg;

      # need to use css in the future.

      $doc->print(<<"END_OF_CODE");
<br />
<table border="1" cellpadding="0" cellspacing="0" width="100%" bgcolor="lightgreen">
  <tr>
    <td bgcolor="cyan">Your Document would have generated:</td>
  </tr>
  <tr>
    <td>
      <font color="blue">
$output
      </font>
    </td>
  </tr>
</table>
END_OF_CODE
    }

    $doc->display();
  }
  else
  {
    $self->print("<center><h1>HTMLObject</h1></center><br />\n");
    $self->print("<br />\n<h1>Error: &nbsp;<b>" . $self->getErrorCode() . "</b> Occurred!</h1>\n");
    $self->print("Message: &nbsp;" . $self->getErrorMessage() . "\n<br />\n");
    $self->print("<br />\n<br />\n$args{'message'}\n<br />\n");
    $self->print("  </body>\n</html>\n");
  }

  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;
}

# displayMetaTags
sub displayMetaTags
{
  my $self = shift;

  my $output .= "";
  if (scalar @{$self->{metaTags}} > 0)
  {
    foreach my $metaTag (@{$self->{metaTags}})
    {
      $output .= "    $metaTag\n";
    }
  }

  return $output;
}

# displayLinks
sub displayLinks
{
  my $self = shift;

  my $output = "";

  if (scalar @{$self->{linkTag}} > 0)
  {
    foreach my $link (@{$self->{linkTag}})
    {
      $output .= "    $link\n";
    }
  }

  return $output;
}

# displayCSS
sub displayCSS
{
  my $self = shift;

  my $output = "";

  if (scalar @{$self->{cssEntries}} > 0)
  {
    my $tempCSS = "<style type=\"text/css\">\n";
    $tempCSS .= "<!--\n" if (!$self->{xhtml});
    $tempCSS .= "<![CDATA[\n" if ($self->{xhtml});
    foreach my $entry (@{$self->{cssEntries}})
    {
      $tempCSS .= "  " . $entry;
    }
    $tempCSS .= "-->\n" if (!$self->{xhtml});
    $tempCSS .= "]]>\n" if ($self->{xhtml});
    $tempCSS .= "</style>\n";

    $tempCSS =~ s/^(.*)$/    $1/mg;
    $output = $tempCSS;
  }

  return $output;
}

# displayBase
sub displayBase
{
  my $self = shift;

  my $output = "";

  if (length $self->{baseHrefString} > 0 || length $self->{baseTargetString} > 0)
  {
    $output = "<base";
    if (length $self->{baseHrefString} > 0)
    {
      $output .= " href=\"$self->{baseHrefString}\"";
    }
    if (length $self->{baseTargetString} > 0)
    {
      $output .= " target=\"$self->{baseTargetString}\"";
    }
    $output .= " />\n";
  }

  return $output;
}

=item scalar display(debug => 0|1, print => 0|1)

 optional: debug (defaults to 0), print (defaults to 1)
 returns: the string that represents the Document.
 This function generates the Base 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, if print = 1.  If
 debug is defined (and equals 1), then the contents of the current
 Document are returned in a format ready to display in another
 Document so that the user can see what would have been generated and
 the string is not printed out.

 The generated output is always returned to the caller.

=cut
sub display
{
  my $self = shift;
  my %args = ( debug => 0, print => 1, @_ );
  my $debug = $args{debug};
  my $print = $args{print};
  my $language = $self->getLanguage();

  my $output = "";

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>display</b> when in non-Buffer mode!");
  }
  if ($self->{weHaveDisplayed})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>display</b> when we have already displayed ourselves!");
  }

  $self->{weHaveDisplayed} = 1; # signal we have displayed ourselves.

  my ($tempHeadString, $tempBodyString);
  $tempHeadString = $self->getHeadString();
  $tempBodyString = $self->getBodyString();

  # do any replacement for the tagBuffers that have been defined.
  foreach my $tag (keys %{$self->{tagBuffers}})
  {
    if ($self->{tagBufferModes}->{$tag} eq "single")
    {
      $tempBodyString =~ s/($tag)/$self->{tagBuffers}->{$tag}/;
    }
    else
    {
      $tempBodyString =~ s/($tag)/$self->{tagBuffers}->{$tag}/g;
    }
  }

  if ($self->{contentTypeString} =~ /^(text\/html)$/i)
  {
    # display Cookies if needed  (they must come before the Content-Type header)
    my $tempStr = $self->displayCookies();
    $output .= $tempStr if (length $tempStr > 0);

    if (length $self->{location} > 0)
    {
      $output .= "Location: $self->{location}\n\n";
      print $output if (!$debug && $print);

      if ($debug == 1)
      {
        $output = $self->formEncodeString(string => $output);  # fixup all special characters.
        $output =~ s/ /&nbsp;/g;
        $output =~ s/\t/&nbsp;&nbsp;&nbsp;&nbsp;/g;  # replace each tab with 4 spaces
        $output =~ s/\n/<br \/>\n/gm;  # make all line breaks be <br />'s.
      }

      return $output;
    }

    #make sure that all output is properly indented, this way the user doesn't have to do any indentation to fit our output indentation.
    $tempHeadString =~ s/^(.*)$/    $1/mg;  # currently 4 spaces.

    $tempBodyString =~ s/^(.*)$/    $1/mg;
    $tempBodyString =~ s/(<textarea.*?>)((?s).*?<\/textarea>)/$1 . eval{(my $temp = $2) =~ s{^(\s{4})(.*?)$}{$2}mg; return $temp}/mxge if ($tempBodyString =~ /<textarea.*?>/);
    $tempBodyString =~ s/(<pre>)((?s).*?<\/pre>)/$1 . eval{(my $temp = $2) =~ s{^(\s{4})(.*?)$}{$2}mg; return $temp}/mxge if ($tempBodyString =~ /<pre>/);

    $output .= "Content-Type: $self->{contentTypeString}; charset=$self->{charsetEncoding}\n\n";  # Display the Content-Type block.

    # output the Document Type header.
    if ($self->{xhtml})
    {
      $output .= "<?xml version=\"1.0\" encoding=\"$self->{docEncoding}\"?>\n";
      $output .= $self->{xhtmlDoctypes}->{$self->{htmlVersion}}->{$self->{htmlDTD}} . "\n" if ($self->{displayDTD});
    }
    else
    {
      $output .= $self->{doctypes}->{$self->{htmlVersion}}->{$self->{htmlDTD}} . "\n" if ($self->{displayDTD});
    }
    $output .= "<html " . ($self->{xhtml} ? "xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"$language\" " : "") . "lang=\"$language\">\n";
    $output .= "  <head>\n";

    # display Meta Tags if needed.
    $tempStr = $self->displayMetaTags();
    $output .= $tempStr if (length $tempStr > 0);

    # display Base if needed.
    $tempStr = $self->displayBase();
    $output .= "    $tempStr\n" if (length $tempStr > 0);

    $output .= "    <title>$self->{titleString}</title>\n";

    # display Links if needed.
    $tempStr = $self->displayLinks();
    $output .= $tempStr if (length $tempStr > 0);

    # display CSS entries if needed.
    $tempStr = $self->displayCSS();
    $output .= "$tempStr\n" if (length $tempStr > 0);

    $output .= "    $tempHeadString" if (length $self->{headString} > 0);
    $output .= "  </head>\n\n";
    $output .= "  <body";
    if (!$self->{xhtml})
    {
      $output .= " bgcolor=\"$self->{bodyBgcolor}\" text=\"$self->{bodyFgcolor}\" link=\"$self->{bodyLinkColor}\" vlink=\"$self->{bodyVlinkColor}\" alink=\"$self->{bodyAlinkColor}\"";
      $output .= " background=\"$self->{bodyImage}\"" if (length $self->{bodyImage} > 0);
    }
    $output .= " class=\"$self->{bodyClass}\"" if (length $self->{bodyClass} > 0);
    $output .= " id=\"$self->{bodyID}\"" if (length $self->{bodyID} > 0);
    $output .= " style=\"$self->{bodyStyle}\"" if (length $self->{bodyStyle} > 0);
    $output .= " title=\"$self->{bodyTitle}\"" if (length $self->{bodyTitle} > 0);
    $output .= $self->{bodyCustomArgs} if (length $self->{bodyCustomArgs} > 0);
    $output .= ">\n";
    $output .= "$tempBodyString\n" if (length $self->{bodyString} > 0);
    $output .= "  </body>\n";
    $output .= "</html>\n";
  }
  else
  {
    $output .= "Content-Type: $self->{contentTypeString}\n";
    $output .= "\n";  # Close the Content-Type block.
    $output .= $self->{bodyString};
  }

  print $output if (!$debug && $print);

  if ($debug == 1)
  {
    $output = $self->formEncodeString(string => $output);  # fixup all special characters.
    $output =~ s/ /&nbsp;/g;
    $output =~ s/\t/&nbsp;&nbsp;&nbsp;&nbsp;/g;  # replace each tab with 4 spaces
    $output =~ s/\n/<br \/>\n/gm;  # make all line breaks be <br />'s.
  }

  return $output;
}

=item void startDisplaying()

 This function generates the Base 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.  This also sets a
 flag bufferMode to 0 so that the methods know that we are no longer
 buffering user input but should just print it to the standard
 output.  The only valid commands are error related, endDisplaying
 and print.

=cut
sub startDisplaying
{
  my $self = shift;
  my $language = $self->getLanguage();

  my $output = "";

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>startDisplaying</b> again when in non-Buffer mode!");
  }
  if ($self->{weHaveDisplayed})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>startDisplaying</b> when we have already displayed ourselves!");
  }

  $self->{weHaveDisplayed} = 1; # signal we have displayed ourselves.

  my ($tempHeadString, $tempBodyString);
  $tempHeadString = $self->getHeadString();
  $tempBodyString = $self->getBodyString();

  # do any replacement for the tagBuffers that have been defined.
  foreach my $tag (keys %{$self->{tagBuffers}})
  {
    if ($self->{tagBufferModes}->{$tag} eq "single")
    {
      $tempBodyString =~ s/($tag)/$self->{tagBuffers}->{$tag}/;
    }
    else
    {
      $tempBodyString =~ s/($tag)/$self->{tagBuffers}->{$tag}/g;
    }
  }

  if ($self->{contentTypeString} =~ /^(text\/html)$/i)
  {
    #make sure that all output is properly indented, this way the user doesn't have to do any indentation to fit our output indentation.
    $tempHeadString =~ s/^(.*)$/    $1/mg;  # currently 4 spaces.

    $tempBodyString =~ s/^(.*)$/    $1/mg;
    $tempBodyString =~ s/(<textarea.*?>)((?s).*?<\/textarea>)/$1 . eval{(my $temp = $2) =~ s{^(\s{4})(.*?)$}{$2}mg; return $temp}/mxge if ($tempBodyString =~ /<textarea.*?>/);
    $tempBodyString =~ s/(<pre>)((?s).*?<\/pre>)/$1 . eval{(my $temp = $2) =~ s{^(\s{4})(.*?)$}{$2}mg; return $temp}/mxge if ($tempBodyString =~ /<pre>/);

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

    $output .= "Content-Type: $self->{contentTypeString}; charset=$self->{charsetEncoding}\n\n";  # Display the Content-Type block.

    # output the Document Type header.
    if ($self->{xhtml})
    {
      $output .= "<?xml version=\"1.0\" encoding=\"$self->{docEncoding}\"?>\n";
      $output .= $self->{xhtmlDoctypes}->{$self->{htmlVersion}}->{$self->{htmlDTD}} . "\n" if ($self->{displayDTD});
    }
    else
    {
      $output .= $self->{doctypes}->{$self->{htmlVersion}}->{$self->{htmlDTD}} . "\n" if ($self->{displayDTD});
    }
    $output .= "<html " . ($self->{xhtml} ? "xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"$language\" " : "") . "lang=\"$language\">\n";
    $output .= "  <head>\n";

    # display Meta Tags if needed.
    $tempStr = $self->displayMetaTags();
    $output .= $tempStr if (length $tempStr > 0);

    # display Base if needed.
    $tempStr = $self->displayBase();
    $output .= "    $tempStr\n" if (length $tempStr > 0);

    $output .= "    <title>$self->{titleString}</title>\n";

    # display Links if needed.
    $tempStr = $self->displayLinks();
    $output .= $tempStr if (length $tempStr > 0);

    # display CSS entries if needed.
    $tempStr = $self->displayCSS();
    $output .= "$tempStr\n" if (length $tempStr > 0);

    $output .= "    $tempHeadString" if (length $self->{headString} > 0);
    $output .= "  </head>\n\n";
    $output .= "  <body";
    if (!$self->{xhtml})
    {
      $output .= " bgcolor=\"$self->{bodyBgcolor}\" text=\"$self->{bodyFgcolor}\" link=\"$self->{bodyLinkColor}\" vlink=\"$self->{bodyVlinkColor}\" alink=\"$self->{bodyAlinkColor}\"";
      $output .= " background=\"$self->{bodyImage}\"" if (length $self->{bodyImage} > 0);
    }
    $output .= " class=\"$self->{bodyClass}\"" if (length $self->{bodyClass} > 0);
    $output .= " id=\"$self->{bodyID}\"" if (length $self->{bodyID} > 0);
    $output .= " style=\"$self->{bodyStyle}\"" if (length $self->{bodyStyle} > 0);
    $output .= " title=\"$self->{bodyTitle}\"" if (length $self->{bodyTitle} > 0);
    $output .= ">\n";
    $output .= "$tempBodyString" if (length $self->{bodyString} > 0);
  }
  else
  {
    $output .= "Content-Type: $self->{contentTypeString}\n";
    $output .= "\n";  # Close the Content-Type block.
    $output .= $self->{bodyString};
  }

  $self->{bufferMode} = 0;  # signal we are no longer buffering!
  $self->{currentSection} = "body";
  $|=1;  # turn buffering off in perls print code.

  print $output;
}

=item void endDisplaying()

 This function closes the document that is currently being displayed
 in non-Buffering mode.  It is not valid to call this more than once.

=cut
sub endDisplaying
{
  my $self = shift;

  if ($self->{bufferMode})
  {
    $self->setError(code => "1012");
    $self->displayError(message => "You can not call <b>endDisplaying</b> when in Buffer mode!");
  }
  elsif ($self->{allreadyClosed})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You have already closed out the document!");
  }
  print "  </body>\n</html>\n" if ($self->{contentTypeString} =~ /^(text\/html)$/i);
  $self->{allreadyClosed} = 1;
}

=item 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.

=cut
sub doRequiredParameterError
{
  my $self = shift;
  my $titleName = shift;
  my $messageName = shift;

  $self->setError(code => '1002');
  $self->displayError(title => "Error:  $titleName", message => "<b>$messageName</b> is required!");
}

=item void setContentType(contentType) (scalar value)

 Uses the specified string to set the content-type: header with.
 Modifies $contentTypeString. If $contentType not equal to
 "text/html" then the focus is automatically set to "body".

=cut
sub setContentType
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setContentType</b> when in non-Buffer mode!");
  }

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setContentType', 'Content-Type');
  }

  my $temp = shift;

  if ($temp !~ /^(text\/html)$/i)
  {
    $self->{currentSection} = "body"; # make sure the only valid section is the body.
  }

  $self->{contentTypeString} = $temp;
}

# getContentType - Returns the charset encoding if valid.
sub getContentType
{
  my $self = shift;
  my $contentType = $self->{contentTypeString};

  if ($contentType =~ /^(text\/html)$/i)
  {
    $contentType .= "; charset=" . $self->{charsetEncoding};
  }

  return $contentType;
}

# setLanguageEncoding - Sets the language and charset encoding to work with.
sub setLanguageEncoding
{
  my $self = shift;
  my %args = ( language => 'en', encoding => 'iso-8859-1', @_, );
  my $language = $args{'language'};
  my $encoding = $args{'encoding'};

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setLanguageEncoding</b> when in non-Buffer mode!");
  }

  # validate that we have valid language code and encoding values and then that they are valid together.
  if (!exists $codeToLanguage{$language})
  {
    $self->setError(code => '1009');
    $self->displayError(title => "Error: setLanguageEncoding", message => "Language Code = '$language' is not recognized!");
  }
  if (!exists $codeToCharset{$language})
  {
    $self->setError(code => '1010');
    $self->displayError(title => "Error: setLanguageEncoding", message => "Language Code = '$language' does not have a charset encoding!");
  }
  else
  {
    my $charEncoding = $codeToCharset{$language};
    if (ref($charEncoding) eq "ARRAY")
    {
      my @encodings = @{$codeToCharset{$language}};
      my $found = 0;
      for (my $i=0; $i < scalar @encodings && !$found; $i++)
      {
        if ($encodings[$i] eq $encoding)
        {
          $found = 1;
        }
      }
      if (!$found)
      {
        $self->setError(code => '1011');
        $self->displayError(title => "Error: setLanguageEncoding", message => "Charset Encoding = '$encoding' is not valid!");
      }
    }
    else
    {
      if ($charEncoding ne $encoding)
      {
        $self->setError(code => '1011');
        $self->displayError(title => "Error: setLanguageEncoding", message => "Charset Encoding = '$encoding' is not valid!");
      }
    }
  }

  $self->{language} = $language;
  $self->{charsetEncoding} = $encoding;
}

# getLanguage
sub getLanguage
{
  my $self = shift;

  return $self->{language};
}

# getLanguageName
sub getLanguageName
{
  my $self = shift;

  return $codeToLanguage{$self->{language}};
}

# lookupLanguageName
sub lookupLanguageName
{
  my $self = shift;
  my $code;
  if (scalar @_ == 1)
  {
    $code = shift;
  }
  else
  {
    my %args = (code => 'en', @_, );  # default to english.
    $code = $args{'code'};
  }

  my $name = $codeToLanguage{$code};

  return $name;
}

# getCharEncoding
sub getCharEncoding
{
  my $self = shift;

  return $self->{charsetEncoding};
}

# lookupCharEncoding
sub lookupCharEncoding
{
  my $self = shift;
  my $code;
  if (scalar @_ == 1)
  {
    $code = shift;
  }
  else
  {
    my %args = (code => 'en', @_, );  # default to english.
    $code = $args{'code'};
  }

  return $codeToCharset{$code};  # this could be an array ref.
}

# setTitle
sub setTitle
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setTitle</b> when in non-Buffer mode!");
  }

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setTitle', 'Title');
  }

  $self->{titleString} = shift;
}

# getTitle
sub getTitle
{
  my $self = shift;

  return $self->{titleString};
}

# getHeadString
sub getHeadString
{
  my $self = shift;

  return $self->{headString};
}

# getBodyString
sub getBodyString
{
  my $self = shift;

  return $self->{bodyString};
}

# scalar uriEncode(string)
#  calls encodeString(string).
sub uriEncode
{
  if (scalar @_ == 1)
  {
    return encodeString(@_);
  }
  else
  {
    my $self = shift;

    return $self->encodeString(@_);
  }
}

# encodeString
# parameters are: string
# returns: url encoded string
sub encodeString
{
  my $string = "";
  if (scalar @_ == 1)  # treat it as a function call.
  {
    $string = shift;
  }
  else # treat it as a method call.
  {
    my $self = shift;
    if (scalar @_ == 1)
    {
      $string = shift;
    }
    else
    {
      my %args = ( string => "", @_,  # arguments go here.
            );

      $string = $args{'string'};

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

  if (length $string > 0)
  {
    # handle the special cases first.
    foreach my $char (qw/% +/)
    {
      my $encodedStr = sprintf("%x", ord($char));
      $string =~ s/[$char](?!$encodedStr)/\%$encodedStr/g;
    }
    # now fixup the rest of the cases.
    $string =~ s/([$encodeCharacters])/($1 ne " " ? sprintf("%%%x", ord($1)) : "+")/eg;
  }

  return $string;
}

# scalar formEncode(string)
# shortcut to formEncodeString(string)
sub formEncode
{
  if (scalar @_ == 1)
  {
    return formEncodeString(@_);
  }
  else
  {
    my $self = shift;

    return $self->formEncodeString(@_);
  }
}

=item scalar formEncodeString(string, ignoreTags, sequence)

=item scalar formEncodeString(scalar)

 In scalar mode, takes the incoming string and encodes it to
 escape all <, > values as &lt;, &gt; unless they are \ escaped.

 To have the \ showup, you will have to do a \\ when defining this
 in perl, otherwise perl interprets the \whatever internally.

 In non-scalar mode, you specify the arguments by name.

 optional:
   string - string to encode all &, <, > characters to their html
     equivalents of &amp;, &lt;, &gt;.
   ignoreTags - string of pipe (|) seperated tag names that should not
     be encoded.  Ex:  ignoreTags => "b|i|u|span" would ignore all
     <b>, </b>, <i>, </i>, <u>, </u>, <span>, </span> tags that were
     not \ escaped.
   sequence - a named set of ignoreTags values that you want used.
     If both sequence and ignoreTags are specified, the ignoreTags
     value is used.  If you want to apply multiple sequences, specify
     them in a comma delimited format.
     Ex: sequence => 'formatting,seperator'

     available sequences are:
       formatting - "b|i|u|span|sub|sup|big|code|font|h1|h2|h3|h4|h5|h6|pre|small|strike|strong"
       block - "p|div|form"
       tables - "table|tr|td|th|tbody|tfoot|thead"
       seperator - "br|hr"
       formItems - "input|textarea|select|option"
       grouping - "ol|ul|li"

 returns: form encoded string ignoring those entries defined in
   ignoreTags or sequence and where the &, <, > was not \ escaped.

   Any &, <, > that were \ escaped will have the \ removed on output.

=cut
sub formEncodeString
{
  my $string;
  my $ignoreTags;
  my $sequence;
  my %sequences = (
       "formatting" => "b|i|u|span|sub|sup|big|code|font|h1|h2|h3|h4|h5|h6|pre|small|strike|strong",
       "block" => "p|div|form",
       "tables" => "table|tr|td|th|tbody|tfoot|thead",
       "seperator" => "br|hr",
       "formItems" => "input|textarea|select|option",
       "grouping" => "ol|ul|li",
       );

  if (scalar @_ == 1)  # handle being called as function
  {
    $string = shift;
  }
  else # handle being called as method
  {
    my $self = shift;
    if (scalar @_ == 1)
    {
      $string = shift;
    }
    else
    {
      my %args = ( string => "", ignoreTags => "", sequence => "", @_ );
      $string = $args{string};
      $ignoreTags = (length $args{ignoreTags} > 0 ? $args{ignoreTags} : undef);
      $sequence = (length $args{sequence} > 0 ? $args{sequence} : undef);

      if (!defined $ignoreTags && defined $sequence)
      {
        my @sequences = split /,/, $sequence;
        foreach my $sequence (@sequences)
        {
          $ignoreTags .= "|" if (length $ignoreTags);  # make sure multiple sequences are | seperated for the regular expression.
          $ignoreTags .= $sequences{$sequence};
          if (!exists $sequences{$sequence})
          {
            $self->setError(code => "1017");
            $self->displayError(message => "sequence = '$sequence' does not exist!");
          }
        }
      }
    }
  }

  if (length $string > 0)
  {
    # handle the special cases first.
    foreach my $char (qw/&/)
    {
      $string =~ s/(?<!\\)[$char]/$formUnEncodedCharactersHash{$char}/emg;
      # now remove the \ from any chars that were escaped.
      $string =~ s/(\\([$char]))/$2/mg;
    }
    # now handle the rest.
    if (defined $ignoreTags)
    {
      # handle the < case where we encode < if it is not \ escaped and also not one of the ignoreTags values.
      $string =~ s/(?<!\\)(<)(?!(\/)?($ignoreTags)(\s+[^>]+)?(\/)?>)/$formUnEncodedCharactersHash{$1}/emg;

      # handle the > case where we encode > if it is not \ escaped and does not have one of the ignoreTags before it.
      # escape the > tag when it is part of an ignoreTag entry.
      $string =~ s/(<(\/)?($ignoreTags)(\s+[^>]+)?(\/)?)(>)/$1\\$6/mg;
      # convert all non-escaped >'s.
      $string =~ s/(?<!\\)(>)/$formUnEncodedCharactersHash{$1}/emg;

      # now remove the \ from any chars that were escaped.
      $string =~ s/(\\([$formUnEncodedCharacters]))/$2/mg;
    }
    else
    {
      $string =~ s/(?<!\\)([$formUnEncodedCharacters])/$formUnEncodedCharactersHash{$1}/emg;
      # now remove the \ from any chars that were escaped.
      $string =~ s/(\\([$formUnEncodedCharacters]))/$2/mg;
    }
  }

  return $string;
}

# scalar formDecode(string)
# calls formDecodeString(string)
sub formDecode
{
  if (scalar @_ == 1)
  {
    return formDecodeString(@_);
  }
  else
  {
    my $self = shift;

    return $self->formDecodeString(@_);
  }
}

# formDecodeString
# takes: string
# returns: string which has all form encoded characters replaced with the un-encoded value
sub formDecodeString
{
  my $string;
  if (scalar @_ == 1) # being called as a function.
  {
    $string = shift;
  }
  else # being called as a method
  {
    my $self = shift;
    if (scalar @_ == 1)
    {
      $string = shift;
    }
    else
    {
      my %args = ( string => "", @_ );
      $string = $args{string};

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

  if (length $string > 0)
  {
    $string =~ s/(?<!\\)($formEncodedCharacters)/$formEncodedCharactersHash{$1}/eg;
  }

  return $string;
}

# scalar formProtect(string)
# calls formProtectString(string).
sub formProtect
{
  if (scalar @_ == 1)
  {
    return formProtectString(@_);
  }
  else
  {
    my $self = shift;

    return $self->formProtectString(@_);
  }
}

# formProtectString
# takes: string
# returns: string after decoding and then re-encoding the string to protect any special characters you
# created and want to redisplay in an edit field, etc.
# keeps any html form tags un-decoded after decoding and re-encoding the string.
# example: string => "This is a <form> tag."  would keep <form> like so.
# string => "This is a &amp; &." would keep the string as is instead of turning the first &amp; into &amp;amp;
sub formProtectString
{
  my $string;
  if (scalar @_ == 1) # being called as function
  {
    $string = shift;
  }
  else  # being called as method
  {
    my $self = shift;
    if (scalar @_ == 1)
    {
      $string = shift;
    }
    else
    {
      my %args = ( string => "", @_ );
      $string = $args{string};

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

  if (length $string > 0)
  {
    # protect any \\ already in the document.
    $string =~ s/(?<!\\)\\/\\\\/g;

    # now protect any '|& make sure to not protect anything already protected.
    $string =~ s/(?<!\\)('|&)/\\$1/g;

    # Decode the string to convert any unprotected special chars into their non-special form.
    $string = formDecodeString($string);

    # remove any \&
    $string =~ s/(?<!\\)(\\(&))/$2/g;

    # Encode any unprotected special chars
    $string = formEncodeString($string);

    # remove any \' that are not double protected.
    $string =~ s/(?<!\\)(\\')/'/g;

    # remove any \&(lt;|gt;|quot;|apos;|amp;) that are not double protected
    $string =~ s/(?<!\\)(\\&(lt;|gt;|quot;|amp;|<|>|"|&))/&$2/g;

    # remove any protected \\ in the document.
    $string =~ s/\\\\/\\/g;
  }

  return $string;
}

sub formatDateOutput
{
  my $self = shift;
  my %args = ( @_ );
  my $tm = $args{tm};
  my $format = $args{format};
  my $result = "";

  $result = strftime($format, @{$tm});

  return $result;
}

=item scalar getCurrentDate(format)

 Uses localtime to gather the current date and returns a string
 with the specified parameters output in the format specified
 by format.

 By default format = "%F" which returns YYYY-MM-DD.

 See strftime(3) for possible arguments.

=cut

sub getCurrentDate
{
  my $self = shift;
  my %args = ( format => "%F", @_ );

  my @tm = localtime;
  my $result = $self->formatDateOutput(tm => \@tm, %args);

  return $result;
}

=item scalar getCurrentLocalizedDate(tz, format)

 Uses gmtime to gather the current date and returns a string
 with the specified parameters output in the format specified
 by format.

 By specifying your TimeZone in tz, I can calculate your
 localized time.  tz will default to "GMT".

 By default format = "%F" which returns YYYY-MM-DD.

 See strftime(3) for possible arguments.

=cut

sub getCurrentLocalizedDate
{
  my $self = shift;
  my %args = ( format => "%F", tz => "GMT", @_ );

  my @tm = gmtime;

  if ($args{tz} ne "GMT")
  {
    @tm = $self->calculateDateOffset(date => scalar(gmtime), offset => "0 hours", toTZ => $args{tz}, fromTZ => "GMT");
  }

  my $result = $self->formatDateOutput(tm => \@tm, %args);

  return $result;
}

=item @tm calculateDateOffset(date, offset, toTZ, fromTZ)

  Takes the date as given by the user (can be "now" to indicate
  they want the current time used) and uses Date::Manip DateCalc
  method to calculate the new date.

  toTZ indicates the TimeZone to convert into.
  fromTZ indicates the TimeZone we are converting from.  If "",
    then it is the servers default timezone.  It defaults to "".

  toTZ defaults to "".  This will calculate the date in the servers
    current TimeZone.  If you specify a TimeZone, then we convert
    to that TimeZone from the fromTZ value.

  Returns the updated tm array representing the new date/time just
  calculated.

=cut

sub calculateDateOffset
{
  my $self = shift;
  my %args = ( date => "now", offset => "0 hours", toTZ => "", fromTZ => "", @_ );
  my $err;
  my @tm = ();

  my $time = DateCalc($args{date}, $args{offset}, \$err);
  if ($time)
  {
    # see if we have to convert to a specific TimeZone.
    if ($args{toTZ} ne "")
    {
      # get the number of seconds past the epoch.
      $time = UnixDate($time, "%s");

      # convert back to the tm array.
      @tm = localtime($time);
      $time = $self->formatDateOutput(tm => \@tm, format => "%Y-%m-%d %H:%M:%S");  # force the format so that we always have a valid date/time back.
      $time = ParseDate($time);
      # I have to jump through hoops to have the input be a ParseDate object. :(
      $time = Date_ConvTZ($time, $args{fromTZ}, $args{toTZ});
    }

    # get the number of seconds past the epoch.
    $time = UnixDate($time, "%s");

    # convert back to the tm array.
    @tm = localtime($time);
  }

  return @tm;
}

=item scalar formatDateString(date, format)

 Runs the specified date through Date::Manip ParseDate
 and then returns it as specified by the format string.

 format defaults to "%F".

 date defaults to "now".

=cut

sub formatDateString
{
  my $self = shift;
  my %args = ( date => "now", format => "%F", @_ );
  my $result = "";

  my $date = ParseDate($args{date});
  if ($date)
  {
    my $time = UnixDate($date, "%s");

    my @tm = localtime($time);

    $result = $self->formatDateOutput(tm => \@tm, %args);
  }

  return $result;
}

=item scalar getDateOffset(date, offset, format)

 Returns the date/time specified in the format string that is
 the current date/time or specified date offset by the
 specified offset string that is valid for
 Date::Manip::ParseDate() function.

 format defaults to "%F" - YYYY-MM-DD

 date defaults to "now" which will use the current time for
 any calculations.

=cut

sub getDateOffset
{
  my $self = shift;
  my %args = ( format => "%F", date => "now", offset => "", @_ );

  my @tm = $self->calculateDateOffset(%args);

  my $result = $self->formatDateOutput(tm => \@tm, %args);

  return $result;
}

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

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setCookie</b> when in non-Buffer mode!");
  }

  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'} && length $args{expires} > 0)
  {
    my $date = $args{'expires'};

    # handle dates specified by human readable formats: 30 minutes, 2 days, yesterday, etc.
    if ($date !~ /^\w{3}\,\s\d{2}\-\w{3}-\d{4}\s\d{2}\:\d{2}\:\d{2}\sGMT$/)
    {
      # try to get the updated version
      $date = $self->getDateOffset(offset => $date, format => "%a, %d-%b-%Y %H:%M:%S", toTZ => "GMT");
      $date .= " GMT";
    }

    if ($date =~ /^\w{3}\,\s\d{2}\-\w{3}-\d{4}\s\d{2}\:\d{2}\:\d{2}\sGMT$/)
    {
      $cookie .= " expires=$date;";
    }
    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 =~ /(\.\w+)$/i && $domain =~ /\..+\.\w+$/)
    {
      $cookie .= " domain=$args{'domain'};";
    }
    elsif ($domain !~ /(\.\w+)$/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";
  }

  # first make sure this cookie has not already been set.
  foreach my $entry (@{$self->{cookies}})
  {
    return if ($entry eq $cookie);
  }

  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 (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setCompressedCookie</b> when in non-Buffer mode!");
  }

  if (!exists $args{'cookies'})
  {
    $self->doRequiredParameterError('setCompressedCookie', '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('setCompressedCookie', 'name');
  }
  if (scalar @localCookies == 0)
  {
    $self->doRequiredParameterError('setCompressedCookie', '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 => 'setCompressedCookie', message => "\$@ = $@");
  }
}

# setMetaTag
# parameters:  http-equiv, content
sub setMetaTag
{
  my $self = shift;
  my %args = ( @_,  # arguments go here.
        );

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setMetaTag</b> when in non-Buffer mode!");
  }

  if (!exists $args{'http-equiv'})
  {
    $self->doRequiredParameterError('setMetaTag', 'http-equiv');
  }
  if (!exists $args{'content'})
  {
    $self->doRequiredParameterError('setMetaTag', 'content');
  }

  my $httpEquiv = $args{'http-equiv'};
  my $content = $args{'content'};

  if (length $httpEquiv == 0)
  {
    $self->doRequiredParameterError('setMetaTag', 'http-equiv');
  }
  if (length $content == 0)
  {
    $self->doRequiredParameterError('setMetaTag', 'content');
  }

  my $metaTag = "<meta http-equiv=\"$httpEquiv\" content=\"$content\" />";

  # first make sure this meta tag has not already been set.
  foreach my $entry (@{$self->{metaTags}})
  {
    return if ($entry eq $metaTag);
  }

  my $num = scalar @{$self->{metaTags}};
  $self->{metaTags}[$num] = $metaTag;  # store the meta tag info for later display.
}

=item void refresh(url, seconds)

 requires: url - URI we should refresh to.  This is either an empty
   string or must be a valid URI.  Ex: http://www.xyz.com/index.html
   currently we check for ftp, http or https as the protocol.  If
   you need a different protocol, let me know and I'll update the
   check, otherwise you will have to manually use setMetaTag().
 optional: seconds - # of seconds we should wait before refreshing.
   Defaults to 0.

 Creates the Refresh meta tag.

=cut
sub refresh
{
  my $self = shift;
  my %args = ( url => "", seconds => 0, @_ );
  my $url = $args{url};
  my $seconds = $args{seconds};

  # validate the url.
  if ($url !~ /^(|(ftp|https?)(:\/\/\w+(\.\w+)+)(\/.+)?)$/)
  {
    $self->setError(code => "1017");
    $self->displayError(message => "url = '$url' is invalid!");
  }
  if ($seconds !~ /^(\d+)$/)
  {
    $self->setError(code => "1017");
    $self->displayError(message => "seconds = '$seconds' is invalid!");
  }

  $self->setMetaTag('http-equiv' => "Refresh", content => "$seconds" . ($url ? ";url=$url" : ""));
}

=item void setFocus(section) (scalar value)

 Validates the section name specified and then sets the internal
 pointer to the specified section. The output of any following print,
 read, or delete commands will work with the specified section.
 Modifies $currentSection.

 Valid sections are:
   body
   head

=cut
sub setFocus
{
  my $self = shift;

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setFocus', 'Section Name');
  }

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setFocus</b> when in non-Buffer mode!");
  }

  my $focus = shift;

  if ($focus ne "head" && $focus ne "body")
  {
    $self->setError(code => '1001');
    $self->displayError(title => 'Error:  setFocus', message => 'Focus = "$focus" is invalid!');
  }

  if ($self->{contentTypeString} !~ /^(text\/html)$/i && $focus ne "body")
  {
    $self->setError(code => '1006');
    $self->displayError(title => 'Error:  setFocus', message => 'Focus = "$focus" is invalid when Content-Type = "$self->{contentTypeString}" is used!');
  }

  $self->{currentSection} = $focus;
}

# getFocus
sub getFocus
{
  my $self = shift;

  return $self->{currentSection};
}

=item void print(string|hash)

    Appends the contents of string to the currently specified section,
    previously specified via setFocus().

    If you specify a hash, then we use the keys to determine what
    sections to append text to.  This allows you to work with the
    following sections and data structures by name:

    sections:
      - head
      - body
      - bodyClass
      - bodyID
      - bodyStyle
      - bodyTitle

    structures:
      - style or css
      - link
      - cookie
      - metaTag


    structures can be modified by sending in a single string or an
    arrayref of strings to be modified, thus you are not making one
    really long css entry, but able to split out the individual
    css entries.

    All structures are checked to make sure duplicates are not
    entered.

    Supported structure entries are not valid sections for the
    setFocus() function.

    The hash support was only implemented to allow the
    HTMLObject::Form code to output all the necessary html code and
    not force the user to pass in an HTMLObject instance when
    generating the form.

    Ex:
    $doc->print(body => "$bodyStr", head => "$headStr");

    $doc->print(css => [ "a { color: red; }", "a { color: red; }" ]);

    would cause only one instance of the "a { color: red; }" to be
    output, whereas if you would have specified the css entry as one
    long string, then it would have done duplicate suppression checking
    on the entire string and not on it's parts.

=cut
sub print
{
  my $self = shift;

  if (scalar @_ == 0)
  {
    # nothing to do, move along.
    return;
  }

  if (scalar @_ == 1)
  {
    my $text = shift;

    if (!$self->{bufferMode})
    {
      print $text;
      return;
    }

    if ($self->{currentSection} eq "head")
    {
      $self->{headString} .= $text;
    }
    elsif ($self->{currentSection} eq "body")
    {
      $self->{bodyString} .= $text;
    }
  }
  else
  {
    my %args = ( @_ );

    if (!$self->{bufferMode})
    {
      print $args{body};  # we can only print to the "body".
      return;
    }

    foreach my $section (keys %args)
    {
      if ($section =~ /^(head|body)$/)
      {
        my $string = $section . "String";
        $self->{$string} .= $args{$section};
      }
      if ($section =~ /^(bodyClass|bodyID|bodyStyle|bodyTitle)$/)
      {
        $self->{$section} .= $args{$section};
      }
      if ($section =~ /^(css|style|cookie|metaTag|link)$/)
      {
        my @tmpArray;
        if (ref ($args{$section}) eq "ARRAY")
        {
          @tmpArray = @{$args{$section}};
        }
        else
        {
          @tmpArray = ($args{$section});
        }
        my $sectionEntry;
        if ($section =~ /^(style|css)$/)
        {
          $sectionEntry = "cssEntries";
        }
        if ($section eq "link")
        {
          $sectionEntry = "linkTag";
        }
        if ($section eq "metaTag")
        {
          $sectionEntry = "metaTags";
        }
        if ($section eq "cookie")
        {
          $sectionEntry = "cookies";
        }
        foreach my $entry (@tmpArray)
        {
          $entry .= "\n" if ($entry !~ /\n$/ && $sectionEntry =~ /^(cssEntries)$/);
          my $found = 0;
          foreach my $tmpEntry (@{$self->{$sectionEntry}})
          {
            if ($entry eq $tmpEntry)
            {
              $found = 1;
              last;
            }
          }
          push @{$self->{$sectionEntry}}, $entry if (!$found);
        }
      }
    }
  }
}

# printTag
# requires: tag
# optional: value, mode (global or single replace)
# appends the contents of value to the tagBuffers->{tag} string.
# The tagBufferMode is set for the tag
# based upon the value of mode.  If no mode is specified and a mode has not
# yet been set for the tag, then it is defaulted to single replacement
# mode, not global replacement.
# Tags are only worked with in the BODY section.
sub printTag
{
  my $self = shift;
  my %args = ( tag => "", value => "", @_ );
  my $tag = $args{tag};
  my $value = $args{value};
  my $mode = $args{mode};

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>printTag</b> when in non-Buffer mode!");
  }

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

  # now append to the tagBuffers the string passed in.
  $self->{tagBuffers}->{$tag} .= $value;

  # check on the status of the mode
  if (length $mode > 0)
  {
    if ($mode !~ /^(single|global)$/)
    {
      $self->setError(code => 1014);
      $self->displayError(title => "Base::printTag", message => "tag replacement mode = '$mode' is invalid!");
    }
  }
  else
  {
    # make sure we have a mode set.
    $self->{tagBufferModes}->{$tag} = "single" if (! exists $self->{tagBufferModes}->{$tag});
  }
}

# read
sub read
{
  my $self = shift;
  my $text = "";

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>read</b> when in non-Buffer mode!");
  }

  if ($self->{currentSection} eq "head")
  {
    $text = $self->{headString};
  }
  elsif ($self->{currentSection} eq "body")
  {
    $text = $self->{bodyString};
  }

  return $text;
}

# readTag
# requires: tag
# returns the string from tagBuffers identified by tag
sub readTag
{
  my $self = shift;
  my $tag;
  if (scalar @_ == 1)
  {
    $tag = shift;
  }
  else
  {
    my %args = ( tag => "", @_ );
    $tag = $args{tag};
  }

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>readTag</b> when in non-Buffer mode!");
  }

  if (length $tag == 0)
  {
    $self->doRequiredParameterError('readTag', 'tag');
  }
  if (! exists $self->{tagBuffers}->{$tag})
  {
    $self->setError(code => "3010");
    $self->displayError(title => "Base::readTag", message => "tag = <b>$tag</b> not found in Body of document!");
  }

  # now return the content of tagBuffers for the specified tag.
  return $self->{tagBuffers}->{$tag};
}

# delete
sub delete
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>delete</b> when in non-Buffer mode!");
  }

  if ($self->{currentSection} eq "head")
  {
    $self->{headString} = "";
  }
  elsif ($self->{currentSection} eq "body")
  {
    $self->{bodyString} = "";
  }
}

# deleteTag
# required: tag
# We remove the contents from tagBuffers for the tag.
sub deleteTag
{
  my $self = shift;
  my $tag;
  if (scalar @_ == 1)
  {
    $tag = shift;
  }
  else
  {
    my %args = ( tag => "", @_ );
    $tag = $args{tag};
  }

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>deleteTag</b> when in non-Buffer mode!");
  }

  if (length $tag == 0)
  {
    $self->doRequiredParameterError('deleteTag', 'tag');
  }
  if (not exists $self->{tagBuffers}->{$tag})
  {
  $self->setError(code => "3010");
  $self->displayError(title => "Base::deleteTag", message => "tag = <b>$tag</b> not found in Body of document!");
  }
  delete $self->{tagBuffers}->{$tag};  # remove it from the hash, it is now not around to be substitued on when you call display!
  delete $self->{tagBufferModes}->{$tag};  # remove the mode entry also.
}

# setBodyBgcolor
sub setBodyBgcolor
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setBodyColor</b> when in non-Buffer mode!");
  }

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setBodyBgcolor', 'Background Color');
  }

  $self->{bodyBgcolor} = shift;
}

# getBodyBgcolor
sub getBodyBgcolor
{
  my $self = shift;

  return $self->{bodyBgcolor};
}

# setBodyFgcolor
sub setBodyFgcolor
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setBodyFgcolor</b> when in non-Buffer mode!");
  }

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setBodyFgcolor', 'Text Color');
  }

  $self->{bodyFgcolor} = shift;
}

# getBodyFgcolor
sub getBodyFgcolor
{
  my $self = shift;

  return $self->{bodyFgcolor};
}

# setBodyLinkColor
sub setBodyLinkColor
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setBodyLinkColor</b> when in non-Buffer mode!");
  }

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setBodyLinkColor', 'Link Color');
  }

  $self->{bodyLinkColor} = shift;
}

# getBodyLinkColor
sub getBodyLinkColor
{
  my $self = shift;

  return $self->{bodyLinkColor};
}

# setBodyVlinkColor
sub setBodyVlinkColor
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setBodyVlinkColor</b> when in non-Buffer mode!");
  }

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setBodyVlinkColor', 'VLink Color');
  }

  $self->{bodyVlinkColor} = shift;
}

# getBodyVlinkColor
sub getBodyVlinkColor
{
  my $self = shift;

  return $self->{bodyVlinkColor};
}

# setBodyAlinkColor
sub setBodyAlinkColor
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setBodyAlinkColor</b> when in non-Buffer mode!");
  }

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setBodyAlinkColor', 'ALink Color');
  }

  $self->{bodyAlinkColor} = shift;
}

# getBodyAlinkColor
sub getBodyAlinkColor
{
  my $self = shift;

  return $self->{bodyAlinkColor};
}

# setBodyImage
sub setBodyImage
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setBodyImage</b> when in non-Buffer mode!");
  }

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setBodyImage', 'Image');
  }

  $self->{bodyImage} = shift;
}

=item void setBodyClass(class)

Specify the class="" value to set in the <body> tag.
This is a pass by value, not by name.

Ex: $doc->setBodyClass("myBody");

=cut
sub setBodyClass
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setBodyClass</b> when in non-Buffer mode!");
  }

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setBodyClass', 'class string');
  }

  $self->{bodyClass} = shift;
}

=item scalar getBodyClass()

returns the current value of bodyClass.

=cut
sub getBodyClass
{
  my $self = shift;

  return $self->{bodyClass};
}

=item void setBodyID(id)

Specify the id="" value to set in the <body> tag.
This is a pass by value, not by name.

Ex: $doc->setBodyID("myID");

=cut
sub setBodyID
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setBodyID</b> when in non-Buffer mode!");
  }

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setBodyID', 'id string');
  }

  $self->{bodyID} = shift;
}

=item scalar getBodyID()

returns the current value of bodyID.

=cut
sub getBodyID
{
  my $self = shift;

  return $self->{bodyID};
}

=item void setBodyStyle(style)

Specify the style="" value to set in the <body> tag.
This is a pass by value, not by name.

Ex: $doc->setBodyStyle("color: red;");

=cut
sub setBodyStyle
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setBodyStyle</b> when in non-Buffer mode!");
  }

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setBodyStyle', 'style string');
  }

  $self->{bodyStyle} = shift;
}

=item scalar getBodyStyle()

returns the current value of bodyStyle.

=cut
sub getBodyStyle
{
  my $self = shift;

  return $self->{bodyStyle};
}

=item void setBodyTitle(title)

Specify the title="" value to set in the <body> tag.
This is a pass by value, not by name.

Ex: $doc->setBodyTitle("This is a test.");

=cut
sub setBodyTitle
{
  my $self = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setBodyTitle</b> when in non-Buffer mode!");
  }

  if (!defined $_[0])
  {
    $self->doRequiredParameterError('setBodyTitle', 'title string');
  }

  $self->{bodyTitle} = shift;
}

=item scalar getBodyTitle()

returns the current value of bodyTitle.

=cut
sub getBodyTitle
{
  my $self = shift;

  return $self->{bodyTitle};
}

# setBase
# parameters: href, target
sub setBase
{
  my $self = shift;
  my %args = ( href => '', target => '', @_, );

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setBase</b> when in non-Buffer mode!");
  }

  my $href = $args{'href'};
  my $target = $args{'target'};

  if (length $href == 0 && length $target == 0)
  {
    $self->doRequiredParameterError('setBase', 'href and/or target');
  }

  $self->{baseHrefString} = $href;
  $self->{baseTargetString} = $target;
}

# setLink
# required: href, rel, type
# optional: name, rev, target, title, charset, hreflang, src, media
sub setLink
{
  my $self = shift;
  my %args = ( @_, );

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setLink</b> when in non-Buffer mode!");
  }

  my $href = $args{'href'};
  my $name = $args{'name'};
  my $rel  = $args{'rel'};
  my $rev  = $args{'rev'};
  my $type = $args{'type'};
  my $title = $args{'title'};
  my $target = $args{'target'};
  my $charset = $args{charset};
  my $hreflang = $args{hreflang};
  my $src = $args{src};
  my $media = $args{media};

  if (!exists $args{'href'})
  {
    $self->doRequiredParameterError('setLink', 'href');
  }
  if (!exists $args{'rel'})
  {
    $self->doRequiredParameterError('setLink', 'rel');
  }
  if (!exists $args{'type'})
  {
    $self->doRequiredParameterError('setLink', 'type');
  }

  my $link = "<link href=\"$href\" rel=\"$rel\" type=\"$type\"";
  if (length $title > 0)
  {
    $link .= " title=\"$title\"";
  }
  if (length $rev > 0)
  {
    $link .= " rev=\"$rev\"";
  }
  if (length $name > 0)
  {
    $link .= " name=\"$name\"";
  }
  if (length $target > 0)
  {
    $link .= " target=\"$target\"";
  }
  if (length $src > 0)
  {
    $link .= " src=\"$src\"";
  }
  if (length $hreflang > 0)
  {
    $link .= " hreflang=\"$hreflang\"";
  }
  if (length $charset > 0)
  {
    $link .= " charset=\"$charset\"";
  }
  if (length $media > 0)
  {
    $link .= " media=\"$media\"";
  }
  $link .= " />\n";

  # first make sure this link has not been set.
  foreach my $entry (@{$self->{linkTag}})
  {
    return if ($entry eq $link);
  }

  my $num = scalar @{$self->{linkTag}};
  $self->{linkTag}[$num] = $link;
}

=item void setStyleEntry(tag => '', attributes => undef, string => '')

 requires: tag
 optional: attributes (ref to hash of name, value pairs to apply to
                       this tag),
           or string (name: value; - must be valid css)
 This generates a CSS entry to specify the style for the tag you
 specified.

=cut
sub setStyleEntry
{
  my $self = shift;
  my %args = ( tag => '', attributes => undef, string => "", @_ );
  my $tag = $args{tag};
  my $attributes = $args{attributes};  # This is a hash ref.
  my $string = $args{string};

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setStyleEntry</b> when in non-Buffer mode!");
  }

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

  if ((! defined $attributes) && (length $string == 0))
  {
    $self->doRequiredParameterError('setStyleEntry', 'attributes or string');
  }

  if (length $string == 0 && scalar keys %{$attributes} == 0)
  {
    $self->setError(code => '3000');
    $self->displayError(title => 'setStyleEntry', message => 'You must specify attributes to set for tag = \'$tag\'!');
  }

  # now generate the string that will be added to the css array.
  my $cssString = $tag . " { ";
  if (length $string > 0)
  {
    $cssString .= $string . " ";
  }
  else
  {
    foreach my $name (keys %{$attributes})
    {
      my $value = $attributes->{$name};
      $cssString .= $name . ": " . $value . "; ";
    }
  }
  $cssString .= "}\n";

  # first make sure this style entry has not been made yet.
  foreach my $entry (@{$self->{cssEntries}})
  {
    return if ($entry eq $cssString);
  }

  my $num = scalar @{$self->{cssEntries}};
  $self->{cssEntries}[$num] = $cssString;
}

=item void setLinkDecorations(link => 'none', alink => 'none', vlink => 'none', hover => '')

 This function allows the user to specify the decorations that the
 link, visited link, active link and hover link have.  If you
 specify nothing, then by default it turns off all decorations (no
 underline).  This generates a CSS section to specify the link
 decorations you desire.

 You should really generate your own CSS using setStyleEntry().

=cut
sub setLinkDecorations
{
  my $self = shift;
  my %args = ( link => 'none', alink => 'none', vlink => 'none', hover => 'blue', @_, );

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setLinkDecorations</b> when in non-Buffer mode!");
  }

  my $link  = $args{'link'};
  my $alink = $args{'alink'};
  my $vlink = $args{'vlink'};
  my $hover = $args{'hover'};

  # make sure that the specified decorations are one of (none, underline, overline, line-through, blink)
  if ($link !~ /none|underline|overline|line-through|blink/i)
  {
    $self->setError(code => '3001');
    $self->displayError(title => 'setLinkDecorations', message => "'$link' is invalid decoration for <b>link</b>!");
  }
  if ($alink !~ /none|underline|overline|line-through|blink/i)
  {
    $self->setError(code => '3001');
    $self->displayError(title => 'setLinkDecorations', message => "'$alink' is invalid decoration for <b>alink</b>!");
  }
  if ($vlink !~ /none|underline|overline|line-through|blink/i)
  {
    $self->setError(code => '3001');
    $self->displayError(title => 'setLinkDecorations', message => "'$vlink' is invalid decoration for <b>vlink</b>!");
  }
  if (length $hover == 0)
  {
    $self->setError(code => '3002');
    $self->displayError(title => 'setLinkDecorations', message => "<b>hover</b> must have a color!");
  }

  # create the style sheet entries that defines our text decorations.
  # they must be done in the order of link, visited, hover, active for the
  # css properties to properly cascade!  Found this out in the CSS2 documentation.
  $self->setStyleEntry(tag => "a:link", string => "text-decoration: $link;");

  $self->setStyleEntry(tag => "a:visited", string => "text-decoration: $vlink;");

  $self->setStyleEntry(tag => "a:hover", string => "color: $hover;");

  my %attributes = ( "text-decoration" => $alink );
  $self->setStyleEntry(tag => "a:active", attributes => \%attributes);
}

=item void setLocation(url)

 requires: url - url to redirect to.

 summary: When you call this method and then display(), any cookies
   defined will be output and then the Location: header.  This will
   only be done if the contentType = text/html.  All other content
   will be ignored.

   There is currently no extra checks being done to stop you from
   continuing to specify content and the startDisplaying() method
   does not check for or display the location property.

   Only the Base and Normal modules have been updated to honor this
   attribute when calling display().

 Ex: $doc->setLocation("http://www.test.com/cgi-bin/index.cgi?cmd=hi");

=cut
sub setLocation
{
  my $self = shift;
  my $url = shift;

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setLocation</b> when in non-Buffer mode!");
  }
  if (length $url == 0)
  {
    $self->doRequiredParameterError('setLocation', 'url');
  }

  # validate the url.
  if ($url !~ /^(ftp|https?)(:\/\/\w+(\.\w+)+)(\/.+)?$/)
  {
    $self->setError(code => "1017");
    $self->displayError(message => "url = '$url' is invalid!");
  }

  $self->{location} = $url;
}

=item scalar getLocation()

 returns the current location value.

=cut
sub getLocation
{
  my $self = shift;

  return $self->{location};
}

=item scalar makeValidHTML(string)

 requires: string - string to cleanup
 optional:
 returns: cleaned up string
 summary: basically converts all valid html tags to lowercase.
         converts <br> -> <br /> and <hr> -> <hr />
         tries to make sure that all attributes are lowercase
         and double quoted.
         Adds an ="1" to any attributes that are alone, like
         a multiple attribute in a <select> tag.
         Look into making sure that all tags have a close tag.

=cut
sub makeValidHTML
{
  my $self = shift;
  my $string;
  if (scalar @_ == 1)
  {
    $string = shift;
  }
  else
  {
    my %args = ( string => "", @_ );
    $string = $args{string};
  }

  if (length $string > 0)
  {
    # now we do the processing of the string.

    foreach my $tag (@{$self->{htmlTags}})
    {
      $string =~ s/(<$tag[^>]*>)/$self->fixupHTMLTag($1)/mige;
      $string =~ s/(<\/$tag[^>]*>)/$self->fixupHTMLTag($1)/mige;

      if ($tag =~ /^(br|hr|input|img)$/)
      {
        $string =~ s/(<($tag)(\s+[^>]+)?>)/<$2$3 \/>/mg;
      }

      # how to handle the case where we have a tag that should have a closing tag but
      # historically people didn't output them?  <option>, <li>, <lo>, <tr>, <td>, <th>
      #if ($tag =~ /^(option)$/)
      #{
      #  # find all <option> tags that don't have a </option> tag and supply it.
      #  $string =~ s/(<$tag[^>]*>(?!<\/(option|select)))/
      #}
    }
  }

  return $string;
}

=item scalar fixupHTMLTag(tag)

 takes the string passed in and lowercases the tag name,
 all arguments and makes sure that arguments values are
 double quoted.  If any argument doesn't have an = part,
 it is then fixed.

 Ex:  <SELECT name=colors multiple>
 ->   <select name="colors" multiple="1">

=cut
sub fixupHTMLTag
{
  my $self = shift;
  my $tag = shift;

  # remove the leading and trailing <>'s.
  $tag =~ s/^<//;
  $tag =~ s/>$//;

  # split on spaces
  my @parts = split(/\s+/, $tag);
  foreach my $part (@parts)
  {
    #print "tag = '$tag', part = '$part'\n";
    # lowercase only the attribute name (before the =)
    $part =~ s/^(\/?\w+)/lc($1)/e;

    # see if the part has an = in it that isn't followed by "
    if ($part =~ /=[^"]/)
    {
      $part =~ s/(=)/="/;
      $part .= "\"";  # add the trailing "
    }

    # see if the part is a simple string and make it be ="1"
    if ($part =~ /^\w+$/ && !grep(/^$part$/, @{$self->{htmlTags}}) )
    {
      $part .= "=\"1\"";
    }
  }

  # now put the tag string back together
  $tag = "<" . join(" ", @parts) . ">";

  return $tag;
}

=item bool doNotDisplay(bool)

 Takes the specified value and assigns to the doNotDisplay variable.

 returns the new value of doNotDisplay.

 Ex: $doc->doNotDisplay(1); # to turn off the auto display code.

=cut
sub doNotDisplay
{
  my $self = shift;
  my $value = shift;

  return ($self->{doNotDisplay} = $value);
}

sub DESTROY
{
  my $self = shift;

  # see if we need to display the object for the user.
  if ($self->{displayOnExit} && !$self->{weHaveDisplayed} && !$self->{doNotDisplay})
  {
    $self->display();
  }
}

sub AUTOLOAD
{
  my $self = shift;
  my $type = ref($self) || die "$self is not an object";
  my $name = $AUTOLOAD;

  $name =~ s/.*://; # strip fully-qualified portion
  unless (exists $self->{$name})
  {
    my @tags = grep(/^$name$/, @{$self->{htmlTags}});
    if (@tags)
    {
      return $self->htmlTag(-tag => $tags[0], @_);
    }

    # otherwise it wasn't one of our html tags!
    $self->setError(code => "1014");
    $self->displayError(title => "Unknown variable or method!", message => "Can't access `$name' field in object of class $type");
  }
  if (@_)
  {
    return $self->{$name} = shift;
  }
  else
  {
    return $self->{$name};
  }
}

=item bool setHTMLInfo(version, dtd, xhtml, displayDTD)

 requires:
 optional: version, dtd, xhtml - 0 or 1, displayDTD - 0 or 1
 returns: 0=error, 1=ok
 summary: Validates version and dtd and sets the htmlVersion and
         htmlDTD variables.  If dtd not defined it defaults to
         "loose".  If version not defined it defaults to "4.01"
         as long as xhtml = 0, but if xhtml = 1 then version
         defaults to "1.0".
         Possible values for version:
           4.0
           4.01
         Possible values for XHTML versions:
           1.0
         Possible values for dtd:
           strict
           loose

         displayDTD defaults to 1.  If it is set to 0, then
         the version, dtd and xhtml values are ignored.

=cut
sub setHTMLInfo
{
  my $self = shift;
  my %args = ( version => "4.01", dtd => "loose", xhtml => "0", displayDTD => 1, @_ );
  my $version = $args{version};
  my $dtd = $args{dtd};
  my $xhtml = $args{xhtml};
  my $displayDTD = $args{displayDTD};
  my $errStr = "HTMLObject::Base->setHTMLInfo()  - Error!<br />\n";

  if ($displayDTD !~ /^(0|1)$/)
  {
    $self->setError(code => '1017');
    $self->displayError(title => 'setHTMLInfo', message => $errStr . "displayDTD = '$displayDTD' is invalid!<br />\n");
  }
  if (!$displayDTD)
  {
    $self->{htmlVersion} = $version;
    $self->{htmlDTD} = $dtd;
    $self->{xhtml} = $xhtml;
    $self->{displayDTD} = $displayDTD;

    return 1;
  }
  if ($xhtml !~ /^(0|1)$/)
  {
    $self->setError(code => '1017');
    $self->displayError(title => 'setHTMLInfo', message => $errStr . "xhtml = '$xhtml' is invalid!<br />\n");
  }
  if ($xhtml)
  {
    if ($version eq "4.01")
    {
      $version = "1.0";  # they let the default fall through, so we have to change it.
    }
    if ($version !~ /^(1\.0)$/)
    {
      $self->setError(code => '1015');
      $self->displayError(title => 'setHTMLInfo', message => $errStr . "version = '$version' is invalid, XHTML Document!<br />\n");
    }
  }
  else
  {
    if ($version !~ /^(4\.0|4\.01)$/)
    {
      $self->setError(code => '1015');
      $self->displayError(title => 'setHTMLInfo', message => $errStr . "version = '$version' is invalid!<br />\n");
    }
  }
  if ($dtd !~ /^(strict|loose)$/)
  {
    $self->setError(code => '1016');
    $self->displayError(title => 'setHTMLInfo', message => $errStr . "dtd = '$dtd' is invalid!<br />\n");
  }

  $self->{htmlVersion} = $version;
  $self->{htmlDTD} = $dtd;
  $self->{xhtml} = $xhtml;
  $self->{displayDTD} = $displayDTD;

  return 1;
}

=item hash getHTMLInfo()

 requires:
 optional:
 returns: hash with version, dtd, xhtml and displayDTD
         entries = to the current values.
         Format = {version => X, dtd => Y, xhtml => 1/0,
         displayDTD => 1/0 }.

=cut
sub getHTMLInfo
{
  my $self = shift;
  my %result = ();

  $result{version} = $self->{htmlVersion};
  $result{dtd} = $self->{htmlDTD};
  $result{xhtml} = $self->{xhtml};
  $result{displayDTD} = $self->{displayDTD};

  return %result;
}

=item scalar processHTMLTagArgs(args)

 walk the specified args and if they exist, we append to the string
 and return the list of arguments that should be output in the tag.

=cut

sub processHTMLTagArgs
{
  my $self = shift;
  my %args = ( @_ );
  my $args = "";

  my @tagArgs = map(exists $args{$_} ? $_ : (), @{$self->{htmlTagArgs}});

  foreach my $name (@tagArgs)
  {
    my $value = $self->formProtect($args{$name});
    $args .= " $name=\"$value\"";
  }

  return $args;
}

=item scalar findHTMLTagContents(args)

Picks out the contents of the tag based on the following criteria:

-contents exists
-c exists
something exists that is not a valid attribute for this tag and
-contents and -c doesn't exist.

returns the found contents, else an empty string.

=cut
sub findHTMLTagContents
{
  my $self = shift;
  my %args = ( @_ );
  my $contents = "";
  
  if (exists $args{-content})
  {
    $contents = $args{-content};
  }
  elsif (exists $args{-c})
  {
    $contents = $args{-c};
  }
  else
  {
    # pick out the value that isn't a special flag and is not a valid attribute
    # for this tag.
    foreach my $arg (keys %args)
    {
      next if ($arg =~ /^-/);  # skip any of our special argument values.
      next if ($arg eq " " || $arg eq "");
      next if ($args{$arg} ne "");  # make sure we don't try to use something the user actually specified as a name => value pair.
      #$self->print("debug: tag='$args{-tag}', arg='$arg', value='$args{$arg}'.<br />");
      $contents .= $arg;  # I don't think I need to formProtect the contents.  Append together any entries that exist.
    }
  }
  
  return $contents;
}

=item scalar htmlTag(-tag, -content, -c, -newline, -indent)

 returns a string that contains the entire <tag> </tag> tag sequence
 with contents of -content or -c substituted in.  Any other arguments
 that are valid to the processHTMLTagArgs method will be added to
 the opening tag.  Not every argument is valid, and I'm not
 currently doing validation checks.  The value of tag is used to
 know what html tag to generate.

 The generated tag is indented according to the type of tag so
 that we hopefully can generate slightly decent looking html
 instead of it all being strung out on a single line.

 Use -indent to specify how many spaces the tag and content should
 be padded with.  This helps tag nesting.  Default = 0.

 All tags have a \n appended to them so you don't have to do that
 manually anymore, unless they are an inline type tag like:
 a span img input.

 The specially handled tags are:
 table, tr, td, select, ol, ul, li, option.


 If you specify -newline = 0, then a newline will not be generated
 even if it normally would have.  This allows you to exert some
 control over the output.
 
 Just added, you can specify content for a tag via one of the following:
   -content =>,
   -c =>, shortcut for -content
   or just specify the content string (without putting it in 
     name => value format).  If you do this, it must be the last argument
     you specify, otherwise it can get lost.
     
   Ex: $doc->center("This should be centered!");
      $doc->a(href => "something", "This is the content for the a tag.");

=cut

sub htmlTag
{
  my $self = shift;
  my %args = ( -indent => 0, -newline => 1, @_ );

  if ($args{-tag} =~ /^(hr|br|input|img)$/)
  {
    # these tags don't have another closing tag and to be xhtml valid need the " />" feature.
    my $newLine = ($args{-tag} =~ /^(input|img)$/ ? "" : "\n");
    $newLine = "" if (!$args{-newline});
    my $string = "<$args{-tag}" . $self->processHTMLTagArgs(%args) . " />" . $newLine;
    if ($args{-indent} > 0)
    {
      my $indentString = " " x $args{-indent};
      $string =~ s/^(.+)$/$indentString$1/mg;
    }
    return $string;
  }
  else
  {
    my $prefixIndent = ($args{-tag} =~ /^(tr|option|li)$/ ? "  " : ($args{-tag} =~ /^(td)$/ ? "    " : ""));
    my $openIndent = ($args{-tag} =~ /^(table|tr|ol|ul|select)$/ ? "\n" : "");
    my $closeIndent = ($args{-tag} =~ /^(tr)$/ ? "  " : "");
    my $newLine = ($args{-tag} =~ /^(span|a)$/ ? "" : "\n");
    $newLine = "" if (!$args{-newline});
    # these are complete tags that allow/require something else between them.
    my $string = $prefixIndent . "<$args{-tag}" . $self->processHTMLTagArgs(%args) . ">" . $openIndent . $self->findHTMLTagContents(%args) . $closeIndent . "</$args{-tag}>" . $newLine;
    if ($args{-indent} > 0)
    {
      my $indentString = " " x $args{-indent};
      $string =~ s/^(.+)$/$indentString$1/mg;
    }
    return $string;
  }
}

=item void setBodyAttribute(name => value)

 Arguments: hash style html attributes.
 Ex: onblur => "do something", onclick => "something else"

 Builds up name="value" to append to the <body> tag when the
 document is displayed.  name must be a valid html attribute.

=cut
sub setBodyAttribute
{
  my $self = shift;
  my %args = ( @_ );

  if (!$self->{bufferMode})
  {
    $self->setError(code => "1013");
    $self->displayError(message => "You can not call <b>setBodyAttribute</b> when in non-Buffer mode!");
  }

  my $string = $self->processHTMLTagArgs(%args);

  if (length $string)
  {
    $self->{bodyCustomArgs} .= $string;
  }
}

=item string optionsBuilder(data, options, selected)

 requires: data or options
 optional: selected

 If data is specified, then an HTMLObject::Form instance will
 be created and the createSelectOptions() method will be
 called passing in the data structure.

 If options is specified, then it must be the hashref as
 returned by the createSelectOptions() method.

 If both data and options are specified, then options takes
 precedence and is used.

 selected is either a string or arrayref specifying those
 entries to be selected on output.
 If a string is given, it will be split on \0 to handle the
 case that the HTMLObject::Form module has not processed it
 for multiple select values.
 If an arrayref is given, each entry will be re-selected and
 no further processing of the entries will be done.

 Summary: This method is designed to help make select boxes
 easier to generate without having to constantly loop over
 database result sets, etc. to generate the options.
 A string is returned which contains the <option></option>
 tags that represent the data/options that were specified.

 Usage:
 my $selectStr = $doc->select(name => "colors", -content =>
 $doc->optionsBuilder(data => $sth->fetchall_arrayref,
 selected => $input->{colors}));

=cut
sub optionsBuilder
{
  my $self = shift;
  my %args = ( @_ );
  my $result = "";
  my $options = undef;
  my $errStr = "HTMLObject::Base->optionsBuilder()  - Error!<br />\n";

  if (exists $args{options})
  {
    $options = $args{options};
  }
  elsif (exists $args{data})
  {
    eval "use HTMLObject::Form;";
    my $formObj = HTMLObject::Form->new;
    $options = $formObj->createSelectOptions(data => $args{data});
    if ($formObj->error)
    {
      $self->setError(code => '1017');
      $self->displayError(title => 'optionsBuilder', message => $errStr . $formObj->errorMessage);
    }
  }
  else
  {
    # they didn't specify data or options.
    $self->setError(code => '1002');
    $self->displayError(title => 'optionsBuilder', message => $errStr . "<b>data</b> or <b>options</b> must be specified!<br />\n");
  }
  # now make sure that the options is a hash ref, etc.
  if (ref($options) ne "HASH")
  {
    $self->setError(code => '1017');
    $self->displayError(title => 'optionsBuilder', message => $errStr . "The options/data structure is " . ref($options) . " and is not a HASH!<br />\n");
  }
  if (keys %{$options} > 0)
  {
    # only enforce the arrays existance if there is data to display.
    foreach my $eName (qw(names values))
    {
      if (!exists $options->{$eName})
      {
        $self->setError(code => '1017');
        $self->displayError(title => 'optionsBuilder', message => $errStr . "$eName does not exist in the options hash!<br />\n");
      }
      if (ref($options->{$eName}) ne "ARRAY")
      {
        $self->setError(code => '1017');
        $self->displayError(title => 'optionsBuilder', message => $errStr . "$eName is not an Array in the options hash!<br />\n");
      }
    }
    if (scalar @{$options->{names}} != scalar @{$options->{values}})
    {
      $self->setError(code => '1017');
      $self->displayError(title => 'optionsBuilder', message => $errStr . "The names and values arrays are not equal in the options hash!<br />\n");
    }
    if (exists $options->{labels})
    {
      if (ref($options->{labels}) ne "ARRAY")
      {
        $self->setError(code => '1017');
        $self->displayError(title => 'optionsBuilder', message => $errStr . "labels is not an Array in the options hash!<br />\n");
      }
      if (scalar @{$options->{labels}} != scalar @{$options->{names}})
      {
        $self->setError(code => '1017');
        $self->displayError(title => 'optionsBuilder', message => $errStr . "The names and labels arrays are not equal in the options hash!<br />\n");
      }
    }

    # now handle the selected argument.
    my $selected = [];
    if (exists $args{selected} && length $args{selected} > 0)
    {
      $selected = $args{selected};
      if (ref($selected) eq "")
      {
        my @entries = split /\0/, $selected;
        $selected = \@entries;
      }
      elsif (ref($selected) ne "ARRAY")
      {
        $self->setError(code => '1017');
        $self->displayError(title => 'optionsBuilder', message => $errStr . "selected must be either a string or arrayref not " . ref($selected) . "!<br />\n");
      }
    }

    # now build up the options entries.
    for (my $i=0; $i < scalar @{$options->{names}}; $i++)
    {
      my $oname = $options->{names}->[$i];
      my $value = $options->{values}->[$i];
      my $label = (exists $options->{labels} ? $options->{labels}->[$i] : undef);

      my %tagArgs = ( value => $value );
      $tagArgs{label} = $label if (defined $label);

      # determine if this option is to be selected.
      foreach my $sEntry (@{$selected})
      {
        if ($sEntry eq $value)
        {
          $tagArgs{selected} = 1;
          last;
        }
      }

      my $option = $self->htmlTag(-tag => "option", %tagArgs, -content => $oname);

      $result .= "  " . $option;
    }
  }

  return $result;
}

=back

=cut

1;
__END__

=head1 Exported FUNCTIONS (non-inline POD)

  scalar getContentType()
    Returns $contentTypeString.  If the content-type string is
    text/html, then the ; charset=xxxx is also appended.

  void setLanguageEncoding(language => 'en', encoding => 'iso-8859-1')
    Sets the language and encoding values to the specified values after
    validating that they exist and are valid together.

  scalar getLanguage()
    Returns the value of $language.

  scalar getLanguageName()
    Returns the name of the language we are using.

  scalar lookupLanguageName(code => 'en')
    Returns the name of the language code that is specified.  Defaults
    to looking up english if nothing specified.  Returns an empty string
    if the language code is not defined in our hash.

  scalar getCharEncoding()
    Returns the value of $charsetEncoding.

  (scalar or @ ref) lookupCharEncoding(code => 'en')
    Returns the array ref or string that represents the valid charset
    encodings that this language code supports.  Defaults to looking up
    english if nothing specified.

  void setTitle(title)  (scalar value)
    Uses the specified string to set the title with. Modifies
    $titleString.

  scalar getTitle()
    Returns $titleString.

  scalar getHeadString()
    Returns $headString.

  scalar getBodyString()
    Returns $bodyString.

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

  scalar uriEncode(string)
    shortcut to encodeString(string).

  scalar formEncode(string)
    shortcut to formEncodeString(string).

  scalar formDecodeString(string => '')
    takes: string
    returns: string which has all form encoded characters replaced with
             the un-encoded value.  Ex.  &amp; => &
    New feature:  Any special character backslash escaped will not be
    converted.  Ex:  \&amp; => \&amp;

  scalar formDecode(string)
    shortcut to formDecodeString(string).

  scalar formProtectString(string => '')
    takes: string
    returns: string after decoding and then re-encoding the string to
             protect any special characters you created and want to
             redisplay in an edit field, etc.  Uses formEncodeString
             and formDecodeString.

  scalar formProtect(string)
    shortcut to formProtectString(string).

  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.

    The Cookie specification, says the expiration date must look like:
             Weekday, dd-Mon-yyyy hh:mm:ss GMT
      Ex: Sun, 01-Jan-1970 00:00:00 GMT  would allow you to specify
      a date in the past, for removing the cookie.

    If you do not want to have to generate the date/time string for
    having your cookie expire in 30 minutes, just specify the date/time
    you are interested in and the code will convert it for you.
      Ex: expires => "30 minutes", expires => "yesterday",
      expires => "1970", expires => "2 days 30 minutes"
    See Date::Manip(3) and the ParseDate() method to see what it
    considers as valid date/time specifications.

    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.
      You can also specify the IP address or fqdn of the machine
      that you want the cookie to be limited to, instead of being
      sent to all other machines in the domain.
             Ex. ".host.com", "192.168.1.1", "www.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.

  void setMetaTag('http-equiv' => '', content => '')
    Creates an entry in the meta_tags array that specifies the http-equiv
    and content values for the specified Meta tag to be created when
    display is called. Modifies @metaTags.

  scalar getFocus()
    Returns the currently specified section.

  void printTag(tag, value, mode)
    requires: tag
    optional: value, mode (global or single replace)
    appends the contents of value to the tagBuffers->{tag} string.
    The tagBufferMode is set for the tag based upon the value of mode.
    If no mode is specified and a mode has not yet been set for the tag,
    then it is defaulted to single replacement mode, not global
    replacement.  Tags are only worked with in the BODY section.

  scalar read()
    Returns the contents of the currently specified section. This could
    be $headString or $bodyString.

  scalar readTag(tag)
    requires: tag
    returns the string from tagBuffers identified by tag

  void delete()
    Deletes the contents of the currently specified section. You should
    call read() before doing this so you can restore if this was an
    accident. This could modify $headString or $bodyString.

  void deleteTag(tag)
    required: tag
    We remove the contents from tagBuffers for the tag.

  void setBodyBgcolor(color)  (scalar value)
    This function sets the background color for the body. Modifies
    $bodyBgcolor.

  scalar getBodyBgcolor()
    This function returns the background color for the body.

  void setBodyFgcolor(color)  (scalar value)
    This function sets the text color for the body. Modifies
    $bodyFgcolor.

  scalar getBodyFgcolor()
    This function returns the text color for the body.

  void setBodyLinkColor(color)  (scalar value)
    This function sets the default link color for the body. Modifies
    $bodyLinkColor.

  scalar getBodyLinkColor()
    This function returns the default link color for the body.

  void setBodyVlinkColor(color)  (scalar value)
    This function sets the visited link color for the body. Modifies
    $bodyVlinkColor.

  scalar getBodyVlinkColor()
    This function returns the visited link color for the body.

  void setBodyAlinkColor(color)  (scalar value)
    This function sets the active link color for the body. Modifies
    $bodyAlinkColor.

  scalar getBodyAlinkColor()
    This function returns the active link color for the body.

  void setBodyImage(image)  (scalar value)
    This function sets the background image for the body. Modifies
    $bodyImage.

  void setBase(href => '', target => '')
    This function allows the user to specify the base url of the webpage
    or more importantly the default target that all links should point to
    if not explicitly specified. This is mainly used in web pages that
    are in a frameset. Modifies $baseHrefString, $baseTargetString.

  void setLink(href => '', name => '', rel => '', rev => '',
               target => '', title => '', charset => '', src => '',
               hreflang => '', media => '')
    required: href, rel, type
    optional: name, rev, target, title, charset, hreflang, src, media

    This function allows the user to specify a <link> tag item that is
    stored in the @linkTag array to be displayed in the <head> when the
    document is created. Modifies @linkTag.

=head1 NOTE:

 Any methods that only required a single argument (code, string, etc.)
 have now been updated to either take a scalar or you can continue
 passing in the value by name.

 Ex:  $string = "Hello World!";
 $string = makeValidHTML(string => $string);
 or
 $string = makeValidHTML($string);

=head1 NEW FUNCTION CALLING SUPPORT AS OF 2.23:

 The following methods can now be called like a function without
 having to instantiate an instance of the HTMLObject::Base module:

   uriEncode
   encodeString
   formEncode
   formEncodeString
   formDecode
   formDecodeString
   formProtect
   formProtectString

 Example of how to call:

   $result = HTMLObject::Base::uriEncode("uri string to encode");
   $result = HTMLObject::Base::uriEncode($url);

 Restriction:  Currently, to take advantage of this feature, you
 can not call and specify your arguments by name.  You can only
 pass in the string to work with.

 Thus you can not do this:

   $result = HTMLObject::Base::uriEncode(string => $url);

=head1 NEW HTML TAG SUPPORT:

 You can now generate html tags by calling $doc->tagName, where
 tagName is any of the valid HTML/XHTML tags.  If you need to
 specify arguments for the tag, use the name of the argument as the
 key entry and the value as the value entry like so:
 $doc->tag(arg1 => "value", arg2 => "value");

 If you are creating a tag that has nested tags in it, use the
 -content argument to specify the html you want output for the
 body of this tag.

 Ex: $doc->tr(align => "center", valign => "top", -content =>
 $doc->td(-content => "This is a &lt;td&gt; tag."));

 would output:
 <tr align="center" valign="top">
   <td>This is a &lt;td&gt; tag.</td>
 </tr>

 See the htmlTag() method's documentation for more arguments.

 All tags are generated as XHTML valid, but should still work in
 an HTML 4 compatible browser since I'm using the W3C conventions.
 As such, all tags and tag arguments are lowercase only!

 If you encounter a tag that claims to be unknown, but is in the
 XHTML 1.0 spec, please let me know.  The same with any tag arguments.

 This is the list of all currently known tags:

 a abbr b basefont big blockquote br button caption center cite code
 col colgroup dd del dfn dir div dl dt em fieldset font form
 h1 h2 h3 h4 h5 h6 hr i iframe img input ins isindex kbd label
 legend li map menu object ol optgroup p param pre q s samp
 script select small span strike strong sub sup table tbody
 td textarea tfoot th thead tr tt u ul var

 This is the list of all currently known tag arguments:

 type class id style align onfocus onblur onclick ondblclick
 onmousedown onmouseup onmouseover onmousemove onmouseout
 onkeypress onkeydown onkeyup target tabindex accesskey
 shape coords title lang dir name value size multiple
 selected checked disabled label action method href src
 rows cols readonly onselect onchange enctype
 ismap usemap width height border hspace vspace alt
 bgcolor frame rules cellspacing cellpadding for maxlength

=head1 AUTHOR

James A. Pattie, htmlobject@pcxperience.com

=head1 SEE ALSO

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

=cut
