File Coverage

blib/lib/CGI/Template.pm

Criterion	Covered	Total	%
statement	54	161	33.5
branch	15	74	20.2
condition	1	3	33.3
subroutine	8	14	57.1
pod	7	8	87.5
total	85	260	32.6

package CGI::Template;

use 5.012004;
use strict;
use warnings;
use Carp;

require Exporter;


use vars qw(
	$VERSION $FORM_CHECK @ISA @EXPORT @EXPORT_OK $DOCTYPE $STRICT
	$TRANSITIONAL $FRAMESET $HTML5
);



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 CGI::Template ':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 = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw();

our $VERSION = '0.01';


# These variables just define standard HTML DOCTYPEs. We'll use them throughout.
$STRICT       = qq{\n\n};
$TRANSITIONAL = qq{\n\n};
$FRAMESET     = qq{\n\n};
$HTML5	      = qq{};

# Use HTML5 by default.
$DOCTYPE = $HTML5;




#
#
#
sub new {
	my $class = shift;

	my %passed_hash = @_;

	my $doctype        = $passed_hash{doctype};
	my $request_method = $passed_hash{request};
	my $template_dir   = $passed_hash{templates};

	$template_dir = "templates" unless $template_dir;

	my $crm = $ENV{'REQUEST_METHOD'};

	if( $request_method ){
		if( $request_method =~ /^get$/i ){
			unless( $crm =~ /^get$/i ){
				&error("Incorrect request method");
			}

		} elsif( $request_method =~ /^post$/i ){
			unless( $crm =~ /^post$/i ){
				&error("Incorrect request method");
			}

		} else {
			croak "CGI::Template : Invalid request argument passed to new(): $request_method";
		}
	}


	$doctype = "" unless $doctype;

	if( $doctype =~ /^transitional$/i || $doctype =~ /^loose$/i ){
		$DOCTYPE = $TRANSITIONAL;

	} elsif( $doctype =~ /^frameset$/i ){
		$DOCTYPE = $FRAMESET;

	} elsif( $doctype =~ /^strict$/i ){
		$DOCTYPE = $STRICT;

	} elsif( $doctype =~ /^html5$/i ){
		$DOCTYPE = $HTML5;

	} elsif( $doctype =~ /^none$/i ){
		$DOCTYPE = "";

	} elsif( $doctype =~ /^$/i ){
		$DOCTYPE = $HTML5;

	} else {
		croak "CGI::Template : Invalid doctype argument passed to new(): $doctype";
	}

	my $path = $ENV{PATH_INFO};
	if( $path ){
		$path =~ s/^\/+//;
		$path =~ s/\/+$//;
	}

	my $self = {
		path      => $path,
		templates => $template_dir,
	};
	my $template = &_check_template( $template_dir );
	$self->{template} = $template if( $template );

	bless($self, $class);
	return $self;

}




sub header {
	my $self = shift;
	my %passed_hash = @_;

	my $header = "Content-type: text/html\n";

	my $redirect = 0;
	foreach my $i (keys %passed_hash){
		if( $i =~ /-cookie/ ){
			$header .= "Set-Cookie: " . $passed_hash{$i} . "\n";

		} elsif( $i =~ /-content-type/ ) {
			$header =~ s/text\/html/$passed_hash{$i}/;

		} elsif( $i =~ /-redirect/ ) {
			$header =~ s/Content-type: .*?\n/Status: 302 Found\nLocation: $passed_hash{$i}\n/m;
			$redirect++;

		} else {
			$header .= "$i: " . $passed_hash{$i} . "\n";
		}
	}

	$header .= "\n";
	$header .= $DOCTYPE unless $redirect;

	return $header;
}

sub path {
	my $self = shift;
	return $self->{path};
}


sub content {
	my $self = shift;
	my %hash = @_;

	croak "CGI::Template : No template set!" unless defined $self->{template};

	my $data = $self->{template};

	foreach my $i (keys %hash){
		$data =~ s/#!$i!#/$hash{$i}/g;
	}

	return $data;
}

sub replace_template {
	my $self = shift;
	my $template = shift;
	$self->{template} = $template;
}

sub error {
	my $self = shift;
	my $message = shift;

	my $template_dir = $self->{templates};

	my $error_template = '';
	if( -e "$template_dir/error.html" ){
		my $fail = 0;
		open INFILE, "$template_dir/error.html" or $fail = 1;
		if( $fail ) { croak "CGI::Template : Couldn't open error template: $template_dir/error.html"; return 0; }
		{
			local $/;
			$error_template = ;
		}
		close INFILE;
	}

	$error_template = qq{

			Error

				Oops!
				#!MESSAGE!#




	} unless( $error_template );

	$error_template =~ s/#!MESSAGE!#/$message/g;
	print &header;
	print $error_template;
	exit;

}


sub get_template {
	my $self = shift;
	my $file = shift;
	my %passed_hash = @_;
	my $fail = 0;

	my $template_dir = $self->{templates};

	my @templates = (
		"$template_dir/$file.html",
		"$template_dir/$file",
	);

	my $tn = '';
	foreach my $i (@templates){
		if( -e $i ){
			$tn = $i;
			last;
		}
	}

	unless($tn){
		carp "CGI::Template : Couldn't find valid template: ".join(", ", @templates)." called by $tn";
		return (0) unless $tn;
	}


	open INFILE, $tn or $fail = 1;
	if( $fail ) { carp "CGI::Template : Couldn't open template: $file, called by $tn"; return 0; }

	my $data = '';
	{
		local $/;
		$data = ;
	}
	close INFILE;

	foreach my $i (keys %passed_hash){
		$i = uc($i);
		$data =~ s/#!$i!#/$passed_hash{$i}/g;
	}

	return $data;


}

sub template {
	my $self = shift;
	return $self->{template};
}



###########################################################
# PRIVATE METHODS
###########################################################

sub _check_template {
	my $template_dir = shift;

	my $name = $0;

	$name =~ s/\/$//;
	$name =~ s/^.*\///;
	$name =~ s/\.cgi$//;
	$name =~ s/\.pl$//;

	my @templates = (
		"$template_dir/$name.html",
		"$template_dir/$name",
		"$template_dir/default.html"
	);


	my $head_template = '';
	if( -e "$template_dir/head.html" ){
		my $fail = 0;
		open INFILE, "$template_dir/head.html" or $fail = 1;
		if( $fail ) { croak "CGI::Template : Couldn't open general template: $template_dir/head.html, called by $name"; return 0; }
		{
			local $/;
			$head_template = ;
		}
		close INFILE;
	}

	my $tn = '';
	foreach my $i (@templates){
		if( -e $i ){
			$tn = $i;
			last;
		}
	}

	return (0) unless $tn;

	my $fail = 0;
	open INFILE, $tn or $fail = 1;

	if( $fail ) { carp "CGI::Template : Couldn't open template: $tn, called by $name"; return 0; }

	my $data = '';
	{
		local $/;
		$data = ;
	}
	close INFILE;

	my $template = "";

	if( $head_template ){
		$template = $head_template;
		$template =~ s/#!DATA!#/$data/;
	} else {
		$template = $data;
	}

	return $template;

}







1;
__END__