# FrameSet.pm - The FrameSet Class derived from the Base HTML object.
# Created by James Pattie, 04/28/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 naming convention.
# Updated 11/20/2001 - Added support for specifying the DOCTYPE to use.
package HTMLObject::FrameSet;
use HTMLObject::Normal;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
@ISA = qw(HTMLObject::Normal Exporter AutoLoader);
@EXPORT = qw(
);
$VERSION = '2.28';
# supported DOCTYPE's
my %doctypesHash = ( "4.0" =>
{
"frameset" => "",
},
"4.01" =>
{
"frameset" => "",
},
);
my %xhtmlDocTypesHash = ( "1.0" =>
{
"frameset" => "",
},
);
# new
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->setErrorMessage(code => '2000', message => 'FrameSet must be defined');
$self->setErrorMessage(code => '2001', message => 'Invalid Value for scrolling');
$self->setErrorMessage(code => '2002', message => 'Invalid Value for frameborder');
$self->setErrorMessage(code => '2003', message => 'Invalid Content-Type for FrameSet Object');
$self->setTitle("HTMLObject::FrameSet");
$self->{frameSet} = "";
$self->{doctypes} = \%doctypesHash;
$self->{xhtmlDoctypes} = \%xhtmlDocTypesHash;
$self->{htmlVersion} = "4.01";
$self->{htmlDTD} = "frameset";
return $self;
}
#reset
sub reset
{
my $self = shift;
$self->SUPER::reset(@_);
$self->setErrorMessage(code => '2000', message => 'FrameSet must be defined');
$self->setErrorMessage(code => '2001', message => 'Invalid Value for scrolling');
$self->setErrorMessage(code => '2002', message => 'Invalid Value for frameborder');
$self->setErrorMessage(code => '2003', message => 'Invalid Content-Type for FrameSet Object');
$self->setTitle("HTMLObject::FrameSet");
$self->{frameSet} = "";
$self->{doctypes} = \%doctypesHash;
$self->{xhtmlDoctypes} = \%xhtmlDocTypesHash;
$self->{htmlVersion} = "4.01";
$self->{htmlDTD} = "frameset";
}
# displayError - Displays the specified error document and then exits.
sub displayError
{
my $self = shift;
my %args = ( title => 'Error: HTMLObject::FrameSet',
message => 'An Error Occurred!', debug => 0,
@_ # arguments passed in go here.
);
# now call the HTMLObject::Normal->displayError method.
$self->SUPER::displayError(%args);
}
# display
sub display
{
my $self = shift;
my %args = ( debug => 0, @_ );
my $debug = $args{debug};
my $output = "";
if ($self->{weHaveDisplayed})
{
$self->setError(code => "1013");
$self->displayError(message => "You can not call display when we have already displayed ourselves!");
}
$self->{weHaveDisplayed} = 1; # signal we have displayed ourselves.
#make sure that all output is properly indented, this way the user doesn't have to do any indentation to fit our output indentation.
my ($tempHeadString, $tempFrameSet);
my $headString = $self->getHeadString();
my $contentTypeString = $self->getContentType();
my $contentEncoding = $self->getCharEncoding();
my $titleString = $self->getTitle();
my $language = $self->getLanguage();
($tempHeadString = $headString) =~ s/^(.*)$/ $1/mg; # currently 4 spaces.
($tempFrameSet = $self->{frameSet}) =~ s/^(.*)$/ $1/mg;
# make sure that we have a frame set to display
if (length $self->{frameSet} == 0)
{
$self->setError(code => '2000');
$self->displayError(title => 'display', message => 'You must define a FrameSet!');
}
if ($contentTypeString =~ /text\/html/i)
{
# display Cookies if needed (they must be displayed before Content-Type).
my $tempStr = $self->displayCookies();
$output .= $tempStr if (length $tempStr > 0);
$output .= "Content-Type: $contentTypeString\n\n";
# output the Document Type header.
if ($self->{xhtml})
{
$output .= "{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 .= "{xhtml} ? "xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"$language\" " : "") . "lang=\"$language\">\n";
$output .= " \n";
# display Meta Tags if needed.
$tempStr = $self->displayMetaTags();
$output .= $tempStr if (length $tempStr > 0);
$output .= " $titleString\n";
$output .= " $tempHeadString" if (length $headString > 0);
# display the JavaScript related code.
$tempStr = $self->displayJavaScriptHead();
$output .= "$tempStr\n" if (length $tempStr > 0);
$output .= " \n";
$output .= $tempFrameSet;
$output .= "\n";
}
else
{
$self->setError(code => '2003');
$self->displayError(title => 'display', message => 'Only Content-Type = "text/html" is valid in a FrameSet document!');
}
print $output if (!$debug);
if ($debug == 1)
{
$output = $self->formEncodeString(string => $output); # fixup all special characters.
$output =~ s/ / /g;
$output =~ s/\t/ /g; # replace each tab with 4 spaces
$output =~ s/\n/
\n/gm; # make all line breaks be
's.
}
return $output;
}
# outerFrameset
# parameters: rows, cols, content, frameborder, border, bordercolor,
# class, id, style, title
sub outerFrameset
{
my $self = shift;
my %args = ( @_, );
if (!exists $args{'content'})
{
$self->doRequiredParameterError('outerFrameset', 'content');
}
my $rows = $args{'rows'};
my $cols = $args{'cols'};
my $content = $args{'content'};
my $frameborder = $args{'frameborder'};
my $bordercolor = $args{'bordercolor'};
if (length $rows == 0 && length $cols == 0)
{
$self->doRequiredParameterError('outerFrameset', 'rows and/or cols');
}
if (length $content == 0)
{
$self->doRequiredParameterError('outerFrameset', 'content');
}
if (length $frameborder > 0)
{
# make sure it is yes or no
if ($frameborder !~ /yes|no/i)
{
$self->setError(2002);
$self->displayError(title => 'outerFrameset', message => "'$frameborder' is invalid for frameborder.");
}
}
$content =~ s/^(.*)$/ $1/mg; #Indent the content by 2 spaces.
$self->{frameSet} = " 0)
{
$self->{frameSet} .= " rows=\"$rows\"";
}
if (length $cols > 0)
{
$self->{frameSet} .= " cols=\"$cols\"";
}
if (length $frameborder > 0)
{
$self->{frameSet} .= " frameborder=\"$frameborder\"";
}
if (length $args{'border'} > 0)
{
$self->{frameSet} .= " border=\"$args{'border'}\"";
}
if (length $bordercolor > 0)
{
$self->{frameSet} .= " bordercolor=\"$bordercolor\"";
}
$self->{frameSet} .= " class=\"$args{bodyClass}\"" if (length $args{bodyClass} > 0);
$self->{frameSet} .= " id=\"$args{bodyID}\"" if (length $args{bodyID} > 0);
$self->{frameSet} .= " style=\"$args{bodyStyle}\"" if (length $args{bodyStyle} > 0);
$self->{frameSet} .= " title=\"$args{bodyTitle}\"" if (length $args{bodyTitle} > 0);
$self->{frameSet} .= $self->{bodyCustomArgs} if (length $self->{bodyCustomArgs} > 0);
# display the JavaScript frameset attributes.
my $tempStr = $self->displayJavaScriptBody();
$self->{frameSet} .= $tempStr if (length $tempStr > 0);
$self->{frameSet} .= ">\n$content\n";
}
# innerFrameset
# parameters: rows, cols, content, frameborder, border, bordercolor, class, id, style, title
sub innerFrameset
{
my $self = shift;
my %args = ( @_, );
if (!exists $args{'content'})
{
$self->doRequiredParameterError('innerFrameset', 'content');
}
my $rows = $args{'rows'};
my $cols = $args{'cols'};
my $content = $args{'content'};
my $frameborder = $args{'frameborder'};
my $bordercolor = $args{'bordercolor'};
if (length $rows == 0 && length $cols == 0)
{
$self->doRequiredParameterError('innerFrameset', 'rows and/or cols');
}
if (length $content == 0)
{
$self->doRequiredParameterError('innerFrameset', 'content');
}
if (length $frameborder > 0)
{
# make sure it is yes or no
if ($frameborder !~ /yes|no/i)
{
$self->setError(2002);
$self->displayError(title => 'innerFrameset', message => "'$frameborder' is invalid for frameborder.");
}
}
$content =~ s/^(.*)$/ $1/mg; # Indent the content by 2 spaces.
my $output = " 0)
{
$output .= " rows=\"$rows\"";
}
if (length $cols > 0)
{
$output .= " cols=\"$cols\"";
}
if (length $frameborder > 0)
{
$output .= " frameborder=\"$frameborder\"";
}
if (length $args{'border'} > 0)
{
$output .= " border=\"$args{'border'}\"";
}
if (length $bordercolor > 0)
{
$output .= " bordercolor=\"$bordercolor\"";
}
$output .= " class=\"$args{bodyClass}\"" if (length $args{bodyClass} > 0);
$output .= " id=\"$args{bodyID}\"" if (length $args{bodyID} > 0);
$output .= " style=\"$args{bodyStyle}\"" if (length $args{bodyStyle} > 0);
$output .= " title=\"$args{bodyTitle}\"" if (length $args{bodyTitle} > 0);
$output .= ">\n$content\n";
return $output;
}
# createFrame
# parameters: src, name, marginwidth, marginheight, scrolling, noresize, bordercolor, frameborder, border,
# class, id, style, title
sub createFrame
{
my $self = shift;
my %args = ( @_, );
if (!exists $args{'src'})
{
$self->doRequiredParameterError('createFrame', 'src');
}
my $src = $args{'src'};
my $scrolling = $args{'scrolling'};
my $frameborder = $args{'frameborder'};
if (length $src == 0)
{
$self->doRequiredParameterError('createFrame', 'src');
}
if (length $scrolling > 0)
{
# make sure it is yes, no, or auto
if ($scrolling !~ /yes|no|auto/i)
{
$self->setError(2001);
$self->displayError(title => 'createFrame', message => "'$scrolling' is invalid for scrolling.");
}
}
if (length $frameborder > 0)
{
# make sure it is yes or no
if ($frameborder !~ /yes|no/i)
{
$self->setError(2002);
$self->displayError(title => 'createFrame', message => "'$frameborder' is invalid for frameborder.");
}
}
my $output = " 0)
{
$output .= " name=\"$args{'name'}\"";
}
if (length $args{'marginwidth'} > 0)
{
$output .= " marginwidth=\"$args{'marginwidth'}\"";
}
if (length $args{'marginheight'} > 0)
{
$output .= " marginheight=\"$args{'marginheight'}\"";
}
if (length $scrolling > 0)
{
$output .= " scrolling=\"$scrolling\"";
}
if (exists $args{'noresize'})
{
$output .= " noresize=\"1\"";
}
if (length $args{'bordercolor'} > 0)
{
$output .= " bordercolor=\"$args{'bordercolor'}\"";
}
if (length $frameborder > 0)
{
$output .= " frameborder=\"$frameborder\"";
}
if (length $args{'border'} > 0)
{
$output .= " border=\"$args{'border'}\"";
}
$output .= " class=\"$args{bodyClass}\"" if (length $args{bodyClass} > 0);
$output .= " id=\"$args{bodyID}\"" if (length $args{bodyID} > 0);
$output .= " style=\"$args{bodyStyle}\"" if (length $args{bodyStyle} > 0);
$output .= " title=\"$args{bodyTitle}\"" if (length $args{bodyTitle} > 0);
$output .= " />\n";
return $output;
}
# createNoframe
# takes a string
sub createNoframe
{
my $self = shift;
if (!defined $_[0])
{
$self->doRequiredParameterError('createNoframe', 'content');
}
my $content = shift;
$content =~ s/^(.*)$/ $1/mg; # Indent the content by 2 spaces.
my $output = "<![CDATA[\n$content\n]]>\n";
return $output;
}
# bool setHTMLInfo(version, dtd, xhtml)
# requires:
# optional: version, dtd, xhtml - 0/1
# returns: 0=error, 1=ok
# summary: Validates version and type and sets the htmlVersion and htmlDTD variables.
# If dtd not defined it defaults to "frameset". If version not defined it defaults to "4.01"
# as long as xhtml = 0, otherwise if xhtml = 1 then version defaults to "1.0".
sub setHTMLInfo
{
my $self = shift;
my %args = ( version => "4.01", dtd => "frameset", xhtml => "0", displayDTD => 1, @_ );
my $version = $args{version};
my $dtd = $args{dtd};
my $xhtml = $args{xhtml};
my $displayDTD = $args{displayDTD};
my $errStr = "HTMLObject::FrameSet->setHTMLInfo() - Error!
\n";
if ($displayDTD !~ /^(0|1)$/)
{
$self->setError(code => '1017');
$self->displayError(title => 'setHTMLInfo', message => $errStr . "displayDTD = '$displayDTD' is invalid!
\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!
\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!
\n");
}
}
else
{
if ($version !~ /^(4\.0|4\.01)$/)
{
$self->setError(code => '1015');
$self->displayError(title => 'setHTMLInfo', message => $errStr . "version = '$version' is invalid!
\n");
}
}
if ($dtd !~ /^(frameset)$/)
{
$self->setError(code => '1016');
$self->displayError(title => 'setHTMLInfo', message => $errStr . "dtd = '$dtd' is invalid!
\n");
}
$self->{htmlVersion} = $version;
$self->{htmlDTD} = $dtd;
$self->{xhtml} = $xhtml;
$self->{displayDTD} = $displayDTD;
return 1;
}
1;
__END__
# Below is the stub of documentation for your module. You better edit it!
=head1 NAME
HTMLObject::FrameSet - Perl extension for HTMLObject.
=head1 SYNOPSIS
use HTMLObject::FrameSet;
my $frameSet = HTMLObject::FrameSet->new();
my $innerFrameset = $frameSet->createFrame(src => 'tester2.cgi',
noresize => '', frameborder => 'no',
scrolling => 'auto');
$innerFrameset .= $frameSet->createFrame(src => 'tester2.cgi');
# test the new onbeforeunload support.
$frameSet->onbeforeunload("return 'You are about to leave via onbeforeunload!'");
$frameSet->outerFrameset(rows => "*,*", content => $innerFrameset);
$frameSet->display(); # display the frameset document.
=head1 DESCRIPTION
The HTMLObject::Frameset Object builds upon the HTMLObject::Normal object to
provide the user with a quick and easy way to create Dynamic FrameSets. See
the documentation.html file for more info.
By deriving from HTMLObject::Normal, you can now specify javascript to be
output in the or