view release on metacpan or  search on metacpan

SSI.pm  view on Meta::CPAN

package CGI::SSI;
use strict;

use HTML::SimpleParse;
use File::Spec::Functions; # catfile()
use FindBin;
use LWP::UserAgent;
use HTTP::Response;
use HTTP::Cookies;
use URI;
use Date::Format;

our $VERSION = '0.92';

our $DEBUG = 0;

sub import {
    my($class,%args) = @_;
    return unless exists $args{'autotie'};
    $args{'filehandle'} = $args{'autotie'} =~ /::/ ? $args{'autotie'} : caller().'::'.$args{'autotie'};
    no strict 'refs';
    my $self = tie(*{$args{'filehandle'}},$class,%args);
    return $self;
}

my($gmt,$loc,$lmod);

sub new {
    my($class,%args) = @_;
    my $self = bless {}, $class;

    $self->{'_handle'}        = undef;

    my $script_name = '';
    if(exists $ENV{'SCRIPT_NAME'}) {
		($script_name) = $ENV{'SCRIPT_NAME'} =~ /([^\/]+)$/;
    }

    tie $gmt, 'CGI::SSI::Gmt', $self;
    tie $loc, 'CGI::SSI::Local', $self;
    tie $lmod, 'CGI::SSI::LMOD', $self;

    $ENV{'DOCUMENT_ROOT'} ||= '';
    $self->{'_variables'}     = {
        DOCUMENT_URI    =>  ($args{'DOCUMENT_URI'} || $ENV{'SCRIPT_NAME'}),
        DATE_GMT        =>  $gmt,
        DATE_LOCAL      =>  $loc,
        LAST_MODIFIED   =>  $lmod,
        DOCUMENT_NAME   =>  ($args{'DOCUMENT_NAME'} || $script_name),
        DOCUMENT_ROOT   =>  ($args{'DOCUMENT_ROOT'} || $ENV{DOCUMENT_ROOT}),
                                };

    $self->{'_config'}        = {
        errmsg  =>  ($args{'errmsg'}  || '[an error occurred while processing this directive]'),
        sizefmt =>  ($args{'sizefmt'} || 'abbrev'),
        timefmt =>  ($args{'timefmt'} ||  undef),
                                };

	$self->{_max_recursions} = $args{MAX_RECURSIONS} || 100; # no "infinite" loops
	$self->{_recursions} = {};

	$self->{_cookie_jar}  = $args{COOKIE_JAR} || HTTP::Cookies->new();

    $self->{'_in_if'}     = 0;
    $self->{'_suspend'}   = [0];
    $self->{'_seen_true'} = [1];

    return $self;
}

sub TIEHANDLE {
    my($class,%args) = @_;
    my $self = $class->new(%args);
    $self->{'_handle'} = do { local *STDOUT };
    my $handle_to_tie = '';
    if($args{'filehandle'} !~ /::/) {
		$handle_to_tie = caller().'::'.$args{'filehandle'};
    } else {
		$handle_to_tie = $args{'filehandle'};
    }
    open($self->{'_handle'},'>&'.$handle_to_tie) or die "Failed to copy the filehandle ($handle_to_tie): $!";
    return $self;
}

sub PRINT {
    my $self = shift;
    print {$self->{'_handle'}} map { $self->process($_) } @_;
}

sub PRINTF {
    my $self = shift;
    my $fmt  = shift;
    printf {$self->{'_handle'}} $fmt, map { $self->process($_) } @_;
}

sub CLOSE {
	my($self) = @_;
	close $self->{'_handle'};
}

sub process {
    my($self,@shtml) = @_;
    my $processed = '';
    @shtml = split(/(<!--#.+?-->)/s,join '',@shtml);
    local($HTML::SimpleParse::FIX_CASE) = 0; # prevent var => value from becoming VAR => value
    for my $token (@shtml) {
#	next unless(defined $token and length $token);
        if($token =~ /^<!--#(.+?)\s*-->$/s) {
            $processed .= $self->_process_ssi_text($self->_interp_vars($1));
		} else {
	        next if $self->_suspended;
		    $processed .= $token;
		}
    }
    return $processed;
}

sub _process_ssi_text {
    my($self,$text) = @_;

	# are we suspended?
    return '' if($self->_suspended and $text !~ /^(?:if|else|elif|endif)\b/);

SSI.pm  view on Meta::CPAN

Note that you'll need to pass the name of the filehandle to C<tie()> as 
a named parameter. Other named parameters are possible, as detailed 
below. These parameters are the same as those passed to the C<new()> 
method. However, C<new()> will not tie a filehandle for you.

CGI::SSI has it's own flavor of SSI. Test expressions are Perlish. 
You may create and use multiple CGI::SSI objects; they will not 
step on each others' variables.

Object-Oriented methods use the same general format so as to imitate 
SSI directives:

    <!--#include virtual="/foo/bar.footer" -->

  would be

    $ssi->include(virtual => '/foo/bar.footer');

likewise,

    <!--#exec cgi="/cgi-bin/foo.cgi" -->

  would be

    $ssi->exec(cgi => '/cgi-bin/foo.cgi');

Usually, if there's no chance for ambiguity, the first argument may 
be left out:

    <!--#echo var="var_name" -->

  could be either

    $ssi->echo(var => 'var_name');

  or

    $ssi->echo('var_name');

Likewise,

    $ssi->set(var => $varname, value => $value)

  is the same as 

    $ssi->set($varname => $value)

=over 4

=item $ssi->new([%args])

Creates a new CGI::SSI object. The following are valid (optional) arguments: 

 DOCUMENT_URI    => $doc_uri,
 DOCUMENT_NAME   => $doc_name,
 DOCUMENT_ROOT   => $doc_root,
 errmsg          => $oops,
 sizefmt         => ('bytes' || 'abbrev'),
 timefmt         => $time_fmt,
 MAX_RECURSIONS  => $default_100, # when to stop infinite loops w/ error msg
 COOKIE_JAR      => HTTP::Cookies->new,

=item $ssi->config($type, $arg)

$type is either 'sizefmt', 'timefmt', or 'errmsg'. $arg is similar to 
those of the SSI C<spec>, referenced below.

=item $ssi->set($varname => $value)

Sets variables internal to the CGI::SSI object. (Not to be confused 
with the normal variables your script uses!) These variables may be used 
in test expressions, and retreived using $ssi->echo($varname). These
variables also will not be available in external, included resources.

=item $ssi->echo($varname)

Returns the value of the variable named $varname. Such variables may 
be set manually using the C<set()> method. There are also several built-in 
variables:

 DOCUMENT_URI  - the URI of this document
 DOCUMENT_NAME - the name of the current document
 DATE_GMT      - the same as 'gmtime'
 DATE_LOCAL    - the same as 'localtime'
 LAST_MODIFIED - the last time this script was modified

=item $ssi->exec($type, $arg)

$type is either 'cmd' or 'cgi'. $arg is similar to the SSI C<spec> 
(see below).

=item $ssi->include($type, $arg)

Similar to C<exec>, but C<virtual> and C<file> are the two valid types.
SSI variables will not be available outside of your CGI::SSI object, 
regardless of whether the virtual resource is on the local system or
a remote system.

=item $ssi->flastmod($type, $filename)

Similar to C<include>.

=item $ssi->fsize($type, $filename)

Same as C<flastmod>.

=item $ssi->printenv

Returns the environment similar to Apache's mod_include.

=item $ssi->cookie_jar([$jar])

Returns the currently-used HTTP::Cookies object. You may optionally
pass in a new HTTP::Cookies object. The jar is used for web requests
in exec cgi and include virtual directives.

=back

=head2 FLOW-CONTROL METHODS

The following methods may be used to test expressions. During a C<block> 
where the test $expr is false, nothing will be returned (or printed, 
if tied).

=over 4

=item $ssi->if($expr)

The expr can be anything Perl, but care should be taken. This causes 
problems:

 $ssi->set(varname => "foo");
 <!--#if expr="'\$varname' =~ /^foo$/" -->ok<!--#endif -->

The $varname is expanded as you would expect. (We escape it so as to use 
the C<$varname> within the CGI::SSI object, instead of that within our 
progam.) But the C<$/> inside the regex is also expanded. This is fixed 
by escaping the C<$>:

 <!--#if expr="'\$varname' =~ /^value\$/" -->ok<!--#endif -->

The expressions used in if and elif tags/calls are tricky due to
the number of escapes required. In some cases, you'll need to 
write C<\\\\> to mean C<\>. 

=item $ssi->elif($expr)

=item $ssi->else

=item $ssi->endif


=back

=head1 SEE ALSO

C<Apache::SSI> and the SSI C<spec> at
http://www.apache.org/docs/mod/mod_include.html

=head1 AUTHOR

(c) 2000-2005 James Tolley <james@bitperfect.com> All Rights Reserved.

This is free software. You may copy and/or modify it under
the same terms as perl itself.

=head1 CREDITS

Many Thanks to Corey Wilson and Fitz Elliot for bug reports and fixes.