# -------------------------------------------------------------------------------------
# lib::PSP 0.3
# -------------------------------------------------------------------------------------
# Author   : Jean-Michel Hiver                         (c) Jean-Michel Hiver, 2001.
# 
# lib::PSP (Perl Server Pages) is a lightweight template module which is designed with
# one main thing in mind: SPEED. Its syntax is inspired from JSP (Java Server Pages)
# and it works on the same principle.
# 
# When running under mod_perl, the page is compiled once and then stored into memory
# as a coderef. lib::PSP detects when a page has been modified and recompiles it when
# necessary.
# 
# All rights reserved. Unauthorized use, modification or redistribution is stricly
# forbidden.
# -------------------------------------------------------------------------------------
package lib::PSP;
use strict;
use Carp;
use vars qw /$BASE_DIR $FILE2CODE $FILE2TIME/;

# You need to set that variable in order to tell the lib::PSP object where to
# find the pages you'll want to process.
$BASE_DIR  = undef;

# These hashrefs are here to keep the compiled code somewhere into memory
# and keep track of the last modification date in order recompile lib::PSP pages
# only when necessary.
$FILE2CODE = {};
$FILE2TIME = {};


##
# $self->new ($file);
# -------------------
#   $file: a SCALAR which gives the path of the file relatively to $BASE_DIR
#   Returns a new lib::PSP object.
##
sub new
{
    my $class = shift;
    $class = ref $class || $class;
    my $file = shift;
    
    my $self = bless {}, $class;
    $self->{file} = $file;
    $self->{vars} = [ @_ ];
    return $self;
}


##
# $self->compile;
# ---------------
#   Returns a code reference that will spit the page on STDOUT when executed.
##
sub compile
{
    my $self = shift;
    my $file = $self->file_path;
    
    if (defined $FILE2TIME->{$file} and $FILE2TIME->{$file} > $self->file_time)
    {
	return $FILE2CODE->{$file};
    }
    else
    {
	my $source = '$CODE = sub { ' . $self->code . ' };';
	my $CODE = undef;
	eval "$source";
	confess $@ if $@;
	
	$FILE2TIME->{$file} = time;
	$FILE2CODE->{$file} = $CODE;
	
	return $CODE;
    }
}


##
# $self->code;
# ------------
#   Generates the Perl code that will be compiled for this lib::PSP.
##
sub code
{
    my $self = shift;
    my $data = $self->source;
    my $tokens = $self->_tokenize ($data);
    my $result = [];
    
    while (@{$tokens})
    {
        my $token = $tokens->[0];
	
        if ($token =~ /^<%.*%>$/gsm)
        {
	    next if ($self->_process_comment   ($tokens, $result));
	    next if ($self->_process_eval      ($tokens, $result));   
	    next if ($self->_process_macro     ($tokens, $result));
	    next if ($self->_process_star_code ($tokens, $result));
	    next if ($self->_process_code      ($tokens, $result));
	    confess "'$token' is not recognized !!!";
	}
	else
	{
	    $self->_process_text ($tokens, $result);
	}
    }
    
    my @declare = ();
    if (@{$self->{vars}})
    {
	push @declare, "\$_ = { \@_ };\n";
	push @declare, map { "my \$$_ = \$_->{$_};\n" } @{$self->{vars}}; 
    }
    return join '', @declare, @{$result};
}


##
# $self->_process_text;
# ---------------------
#   Returns a print statement for the bit of text that needs
#   being printed
##
sub _process_text
{
    my $self = shift;
    my $tokens = shift;
    my $result = shift;
    
    my $token = shift (@{$tokens});
    my @split = split /\n|\r/, $token;
    $token = join '\n', map { quotemeta ($_) } @split;
    push @{$result}, 'print "' . $token . '";' . "\n";
}


##
# $self->_process_comment;
# ------------------------
#   <%-- this is a comment, we don't want it to appear --%>
##
sub _process_comment
{
    my $self   = shift;
    my $tokens = shift;
    my $result = shift;
    my $token  = $tokens->[0];
    
    if ($token =~ /^<%\-\-.*\-\-%>$/s)
    {
	shift @{$tokens};
	return 1;
    }
    return;
}


##
# $self->_process_eval;
# ---------------------
#   Prints the last evaluated Perl expression
#   <%= 1 + 1 %>, <%= $cgi->param ('foo') %>
##
sub _process_eval
{
    my $self   = shift;
    my $tokens = shift;
    my $result = shift;
    my $token  = $tokens->[0];
    
    if ($token =~ /^<%=.*%>$/s)
    {
	$token =~ s/^<%=//;
	$token =~ s/%>$//;
	push @{$result}, 'print eval { ' . $token . ' }; print "[ $@ ]" if ($@);' . "\n";
	shift @{$tokens};
	return 1;
    }
    return;
}


##
# $self->_process_macro;
# ----------------------
#   Includes another page into the current one, i.e.
#   <%@ menu_bar.psp %> would include 'menu_bar.psp'
##
sub _process_macro
{
    my $self   = shift;
    my $tokens = shift;
    my $result = shift;
    my $token  = $tokens->[0];

    if ($token =~ /^<%\@.*%>$/s)
    {
	my ($file) = $token =~ /^<%\@\s*(.*?)\s*%>$/;
	my $psp = $self->new ($file);

	push @{$result}, $psp->code;
	shift (@{$tokens});
	return 1;
    }
    return;
}


##
# $self->_process_code;
# ---------------------
#   Includes Perl code which will be executed.
##
sub _process_code
{
    my $self   = shift;
    my $tokens = shift;
    my $result = shift;
    my $token  = $tokens->[0];
    
    if ($token =~ /^<%.*%>$/gsm)
    {
	$token =~ s/^<%\s+//;
	$token =~ s/\s+%>$//;
	$token .= ';' unless ($token =~ /\s*;\s*$/);
	push @{$result}, $token . "\n";
	shift (@{$tokens});
	return 1;
    }
    return;
}


##
# $self->_process_star_code;
# --------------------------
#   If you don't want to do something like:
#   <% foreach my $count (1..100) { %>
#     ...
#   <% } %>
#
#   Do this instead:
#   <%* foreach my $count (1..100) %>
#     ...
#   <%* end-foreach %>
##
sub _process_star_code
{
    my $self   = shift;
    my $tokens = shift;
    my $result = shift;
    my $token  = $tokens->[0];
    
    if ($token =~ /^<%\*\s*(foreach|for|while|if).*%>/)
    {
	$token =~ s/^<%\*\s+//;
	$token =~ s/\s+%>$//;
	push @{$result}, $token . " {\n";
	shift (@{$tokens});
	return 1;
    }
    elsif ($token =~ /^<%\*\s*(else|elsif).*%>/)
    {
	$token =~ s/^<%\*\s+//;
	$token =~ s/\s+%>$//;
	push @{$result}, "\n} " . $token . " {\n";
	shift (@{$tokens});
	return 1;
    }
    elsif ($token =~ /^<%\*\s*end.*%>/)
    {
	shift (@{$tokens});
	push @{$result}, "\n}\n";
	return 1;
    }
    else
    {
	return;
    }
}


##
# $self->_tokenize;
# -----------------
#   Returns the data to parse as a list of tokens:
#   ( 'some text', '<% a_tag %>', 'some more text', '<% end-a_tag %>' etc.
##
sub _tokenize
{
    my $self = shift;
    my $data = shift;
    
    my @tags  = ();
    (defined $data) and (@tags = $data =~ /(<%.*?%>)/gs);
    
    my @split = ();
    (defined $data) and (@split = split /<%.*?%>/gs, $data);
   
    my $tokens = [];
    while (@split)
    {
        push @{$tokens}, shift @split;
        push @{$tokens}, shift @tags if (@tags);
    }
    
    return $tokens;
}


##
# $self->source;
# ---------------
#   Returns the raw lib::PSP page before it's compiled or
#   even turned to Perl code.
##
sub source
{
    my $self = shift;
    return $self->{data} if (defined $self->{data});
    
    my $file = $self->file_path;
    
    (-e $file) or confess ("$file does not exist!");
    open FP, "<$file" or confess ("Cannot read-open $file!");
    my $data = join '', <FP>;
    close FP;
    
    return $data;
}


##
# $self->file;
# -------------
#   Accessor for file name.
##
sub file
{
    my $self = shift;
    my $file = shift || return $self->{file};
}


##
# $self->file_time;
# -----------------
#   Returns the last modification time of the lib::PSP
#   in seconds since the epoch.
##
sub file_time
{
    my $self = shift;
    my $path = $self->file_path;
    
    my @stat = stat ($path);
    return $stat[9];
}


##
# $self->_filepath;
# -----------------
#   Full file path for current lib::PSP.
##
sub file_path
{
    my $self = shift;
    my $file = $self->file;
    $file = $BASE_DIR . '/' . $file if (defined $BASE_DIR);
    return $file;
}


1;


=head1 SYNOPSIS

--== lib::PSP 0.1 ==--

(c) Jean-Michel Hiver, 2001.
jhiver@cisedi.com. http://cisedi.com.

lib::PSP (Perl Server Pages) is a lightweight template module which is designed with
one main thing in mind: SPEED. Its syntax is inspired from JSP (Java Server Pages)
and it works on the same principle.

When running under mod_perl, the page is compiled once and then stored into memory
as a coderef. lib::PSP detects when a page has been modified and recompiles it when
necessary.

=head1 USAGE

=head2 Example of a simple CGI script using lib::PSP:

    #!/usr/bin/perl
    use CGI;
    use lib::PSP;
    
    $lib::PSP::BASE_DIR = '/var/www/html'; # NO trailing slash !
    main();

    sub main
    {
        my $cgi = new CGI;
        my $psp = new lib::PSP ('my_simple_page.html');
        print $cgi->header();
        $psp->compile->();
    }

As you can see, this is quite simple: all you need to do is to set $lib::PSP::BASE_DIR
properly and then create a lib::PSP object with the right file path relatively to
$lib::PSP::BASE_DIR.

Then, in order to spit out the page, you need to grab the perl code reference which
is produced by the compile lib::PSP compile() method and execute it. This closure means
that the code which is being executed has access to all variables in the current
scope.

Warning: It also means that the code can actually CHANGE these variables...


=head2 How the my_simple_page.html could look

    <html>
      <body>
      
      <%-- This is a comment, it will not appear in the output --%>
      <%-- Prints all CGI parameters --%>

      <table>
        <tr>
          <td><strong>Name</strong></td>
          <td><strong>Value</strong></td>
        </tr>

        <% foreach my $param ($cgi->param) %>
          <tr>
            <td><%= $param %></td>
            <td><%= $cgi->param ($param) %></td>
          </tr>
        <% end-foreach %>      

      </body>
    </html>


=head1 Different tags

=head2 Comments

Comments can be used just like HTML comment tags, but they
will not appear in the page (whilst HTML comments do).

    <%-- This is a comment. It will not appear anywhere --%>


=head2 Expression evaluation

This tag will evaluate the expression and print out the result.
The expression can be any kind of valid Perl code.

    2 + 2 equals <%= 2+2 %>
    You are using the browser <%= $ENV{HTTP_USER_AGENT} %>;


=head2 Macros

You can include other pages (which I call macros because you could
define whatever you want in them: Perl functions, HTML, etc) into
your current page.

    <%@ menu.psp %>


=head2 Perl code

You can put some Perl code in order to do various things:

    <%-- Looping through a list of values --%>
    <% for (1..100) { %> <%= $_ %> <% } %>

    <%-- Defining some kewl functions --%>
    <% sub current_time { return time } %>
    It is <%= current_time() %> since the epoch

    <%-- testing / switching values, altering them, etc. etc. -->


=head2 Star code

Look at the following code:

    <% if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) { %>
      You are using MSIE
    <% } else { %>
      You are not using MSIE
    <% } %>

IMHO, the curlies make it really hard to read. Instead, using
star code you can get rid of curlies and write:

    <%* if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) %>
      You are using MSIE
    <%* else %>
      You are not using MSIE
    <%* end-if %>

Starcode supports foreach, for, while,if, else and elsif constructs.

I actually recommend that you limit yourself to using everything but
Perl code in your templates in order to keep a clean separation between
presentation and content, but this is up to you indeed.


=head1 BUGS

* The lib::PSP parser is very simple, and based on an extensive use of Perl regular expressions.
Because it just doesn't know anything about Perl syntax, it's not smart enough to
properly parse something like:

    <%= "This makes the parser fail: %>" %>

However, this would work:

    <%= "This is OK: %" . ">" %>
