File Coverage

blib/lib/HTML/XHTML/Lite.pm

Criterion	Covered	Total	%
statement	15	93	16.1
branch	0	70	0.0
condition	0	12	0.0
subroutine	5	9	55.5
pod	2	4	50.0
total	22	188	11.7

package HTML::XHTML::Lite;

use 5.006;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use HTML::XHTML::Lite ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = qw( start_page end_page getvars );

our @EXPORT = qw(
start_page end_page getvars
);

our $VERSION = '0.06';


# Preloaded methods go here.

sub start_page
{
use HTTP::Date;
use Time::Local;

$_[0]={} unless defined $_[0];

my %p=%{$_[0]};
my $page;

$p{content_type}='text/html' unless defined $p{content_type};
my $charset=(defined $p{charset} ? uc($p{charset}) : 'UTF-8');
$p{title}='Untitled Document' unless defined $p{title};
$p{dctitle}=$p{title} unless defined $p{dctitle};
$p{lang}=(defined $p{lang} ? $p{lang} : 'en');
$p{foaftitle}='FOAF' unless defined $p{foaftitle};

if ($p{feed})
{
	$p{feedtype}="application/rss+xml" unless defined $p{feedtype};
	$p{feedtitle}="RSS Feed for $p{title}" unless defined $p{feedtitle};
}

my $now=time2str(time());
my $expires=(defined $p{expires} ? time2str(iso2time($p{expires})) : $now);

unless ($p{isfile})
{
	$page.="Expires: $expires\n";
	$page.="Date: $now\n";
	$page.="Content-type: $p{content_type}; charset=$charset\n\n";
}

$page.="\n" unless $p{noxml} || $p{nohead};
$page.="\n" unless $p{nodoctype} || $p{nohead};

$page.=<


$p{title}






EOT

$page.="\n" if defined $p{description};
$page.="\n" if defined $p{creator};
$page.="\n" if defined $p{identifier};
$page.="\n" if defined $p{subject};
$page.="\n" if defined $p{rights};
$page.="\n" if defined $p{created};
$page.="\n" if defined $p{modified};
$page.="\n" if defined $p{date};

if (defined $p{legacy} && defined $p{description} && defined $p{subject})
{
	my $kwds=$p{subject};
	$kwds=~s/;/,/g;
	$page.="\n";
	$page.="\n";
}

$page.="\n" if defined $p{csssrc};
$page.="$p{css}\n" if defined $p{css};
$page.="\n"
	if defined $p{feed};
$page.="\n"
	if defined $p{foaf};
$page.=$p{extras} if defined $p{extras};
$page.="\n";

if (defined $p{body})
{
	$page.=$p{body};
	my %footp=%p;
	$footp{string}=1;
	$page.=end_page(\%footp);
}

if ($p{string})
{
	return $page;
}
else
{
	print $page;
}

} #

sub end_page
{
	my $page;

	$_[0]={} unless defined $_[0];

	my %p=%{$_[0]};
	$page.="\n\n";

	if ($p{string})
	{
		return $page;
	}
	else
	{
		print $page;
	}
}

sub iso2time
{
	$_[0] =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/ or return undef;
	return timelocal($6,$5,$4,$3,$2-1,$1-1900);
}

sub getvars
{
	# A 'Lite' version of CGI.pm's param function
	# Returns a reference to a hash of arrays of
	# name/value pairs.

	my (@nvps,%vars);

	# Look after anything coming from a
	# POST form
	if (lc($ENV{REQUEST_METHOD}) eq 'post')
	{
		read(STDIN, my $postdata, $ENV{CONTENT_LENGTH});
		push(@nvps,split(/&/,$postdata));
	}

	# Pick up anything passed through the
	# query string, either by a GET form
	# or direct by URI
	my $qs=$ENV{QUERY_STRING};
	$qs=~s/&/;/g;
	push(@nvps,split(/;/,$qs));

	foreach my $nv (@nvps)
	{
		my @a=split(/=/,$nv);
		$a[0]=~tr/+/ /;
		$a[0]=~s/%([\da-f][\da-f])/chr(hex($1))/egi;
		$a[1]="" unless defined $a[1];
		$a[1]=~tr/+/ /;
		$a[1]=~s/%([\da-f][\da-f])/chr(hex($1))/egi;
		push @{$vars{$a[0]}},$a[1];
	}
	return %vars;
}

1;
__END__