File Coverage

blib/lib/Website.pm

Criterion	Covered	Total	%
statement	3	164	1.8
branch	0	116	0.0
condition	0	37	0.0
subroutine	1	8	12.5
pod	0	7	0.0
total	4	332	1.2

package Website;
use strict;
########################################################################
# Website - Perl extension for as engine to render template-driven
# applications, designed to run quickly in CGI and mod_perl environments
########################################################################
my $package = __PACKAGE__;
our $VERSION = '1.14.01';
$| = 1;

#-----  GLOBAL VARS
my %Var; # Variables to replace
my $contentType; # 1=Content-type is already set / 0=it's not set yet
my $begin_block = '$/; # Suppress free comment lines
			   $next = 0 if /^/;
			   next if $next;

			foreach my $Key (keys %Var) {
				my $to_be_replaced = 0;
				if ($Glob_Args{'output'}) {
					$to_be_replaced = 1 if /$start_seq/;
				}

				s/$start_seq$Key$stop_seq/$Var{$Key}/g;

				if ($Glob_Args{'output'}) {
					unless ($Glob_Args{_Lo_Row}) {
						print TUNING
						sprintf("%08d", $rowcount), "\t$Key\n"
						if $_ !~ /$start_seq/ && $to_be_replaced;
					}
				}
			}

			next if /{%.+%}$/; # supress unresolved lines

			$Params{'save_as'} ? print SAVE : print;
		}
		$rowcount++;

		if ($Glob_Args{_Tune_File_Exists}) {
			next if $#Parse_Lines < 1;
			if ($rowcount > $Parse_Lines[0]) {
				@Parse_Lines = @Parse_Lines[1 .. $#Parse_Lines];
				# At line $rowcount, we will just output the file
				# until we reach line number $Parse_Lines[0] - 2
				while () {
					last if $rowcount++ > $Parse_Lines[0] - 2;
					print;
				}
				foreach my $Key (keys %Var) {
					s/$start_seq$Key$stop_seq/$Var{$Key}/g;
				}
				print;
			}
		}

		if ($Glob_Args{'output'} && $Glob_Args{_Lo_Row}) {
			last if $rowcount > $Glob_Args{_Hi_Row};
		}

	} # end while

	if ($Glob_Args{'output'}) {
		print while ;
	}

	close WS_F;
	close TUNING
		if $Glob_Args{'output'} && !$Glob_Args{_Tune_File_Exists};

	if ($Params{'save_as'}) {
		print SAVE qq~

		~, "\n" unless $Params{'quiet'};
		close SAVE ;
	}
	else {
		unless ($Params{'quiet'}) {
		print qq~

		~, "\n" unless $Params{'quiet'};
		}
	}
}

sub let {
	my $self = shift;

	my $Key   = shift;
	my $Value = shift;
	my $Block = shift || '';

	Debug "$Key = $Value" if $self->{'debug'};

	if ($Block) {
		$Var{"_$Block\t" . sprintf("%08d", $Glob_Args{"BLOCK_$Block"}++) . "\t$Key"} = $Value;
	}
	else {
		$Var{$Key} = $Value;
	}
}

sub block ($$@) {
	my $self = shift;
	my $block_name = shift;
	my %block_args = @_;

	push @block_names, $block_name;
	$print_block{$block_name} = $block_args{'print'};
}

sub workdir ($) {
	my $dir_separator = '/'; # ZZ change this to \ on windows
	my @elems = split /$dir_separator/, $_[0];

	((join $dir_separator, @elems[0 .. $#elems - 1]), $elems[$#elems]);
}

####  Error  #################################################
sub Error ($) {
	print "Content-type: text/html\n\n" unless $contentType;
	print "ERROR ($package): $_[0]\n";
	exit(1);
}

####  Debug  ###################################################
sub Debug ($)  {
	print "Content-type: text/html\n\n" unless $contentType; $contentType++;
	print "[ $package ] $_[0]\n";
}

############################################################
####  Used Warning / Error Codes  ##########################
############################################################
#	Next free W Code: 1000
#	Next free E Code: 1002

1;

__END__