view release on metacpan or  search on metacpan

lib/Apache/XPP.pm  view on Meta::CPAN

# Apache::XPP
# -------------
# $Revision: 1.32 $
# $Date: 2002/02/15 05:00:01 $
# -----------------------------------------------------------------------------
=head1 NAME

XPP (XPML Page Parser) - An embedded perl language designed to co-exist with HTML

=cut

package Apache::XPP;

=head1 SYNOPSIS

 use Apache::XPP;
 my $xpp = Apache::XPP->new( Apache->request );
 $xpml->run;

=head1 REQUIRES

 Apache
 Apache::Constants
 File::stat
 FileHandle
 HTTP::Request
 LWP::UserAgent

=cut

use Carp;
use strict;
use vars qw( $AUTOLOAD $debug $debuglines );

BEGIN {
    $Apache::XPP::REVISION       = (qw$Revision: 1.32 $)[-1];
    $Apache::XPP::VERSION        = '2.02';
}

use Apache::XPP::Cache;
use Apache::XPP::PreParse;

if ($INC{ 'Apache.pm' }) {
	eval q{
		use Apache();
		use Apache::Constants qw(:response);
	};
}


use Carp;
use File::stat;
use FileHandle;
use HTTP::Request;
use LWP::UserAgent;

=head1 EXPORTS

Nothing

=head1 DESCRIPTION

Apache::XPP is an HTML parser which on run time compiles and runs embedded perl code.

=head1 CLASS VARIABLES

=over

=item C<$Apache::XPP::main_class>

XPP sub-classes must set $Apache::XPP::main_class to the name of the
sub-class. This will allow xinclude/include to work properly.

=cut

$Apache::XPP::main_class = 'Apache::XPP';

=item C<$debug>

Activates debugging output.  All debugging output is sent to STDERR.

At present there are only 4 levels of debugging :
 0 - no debugging (default)
 1 - some debugging
 2 - verbose debugging
 3 - adds some Data::Dumper calls

=item C<$debuglines>

Optionally, you can activate the $debuglines, which will cause all
debugging output to include the line numbers (in this file) of the debugging.

=back

=cut

$debug		= 0;
$debuglines	= 0;

=head1 METHODS

=over

=item C<handler> ( $r )

The Apache handler hook. This is the entry point for the Apache module.  It
takes the Apache request object ($r) as its parameter and builds a new XPP
object to handle the request. In order to support the procedural nature
of include() and xinclude() a global is defined. If you subclass Apache::XPP
replace the value of the global L<"$Apache::XPP::main_class"> with your class name.

=cut

sub handler ($$) {

lib/Apache/XPP.pm  view on Meta::CPAN

		
		
		$self->code->( $self, @_ );
		return 1;
	} else {
		return undef;
	}
} # END method run


=item C<returnrun> ( @arguments )

Calls C<run> with @arguments as specified, catching all output destined for STDOUT, and
returning the results as a string.

=cut
sub returnrun {
	my $self	= shift;
	my $class	= ref($self) || return undef;
	local(*XPP_TIE);
	warn "xpp: tying STDOUT" . ($debuglines ? '' : "\n") if ($debug);
	my $tieobj	= tie(*XPP_TIE, 'XPP::Tie');
	
	my $fh	= select( XPP_TIE );
	$self->run( @_ );
	select( $fh );
	
	my $content	= $tieobj->content();
#	untie(*XPP_TIE);
	return $content;
} # END method returnrun


=item C<load> ( $filename )

Returns the code specified by $filename.  If $filename begins with a url specifier
(e.g. http://), LWP::UserAgent will be used to retrieve the file.  If $filename
begins with a '/', it will be treated as a rooted filename.  Otherwise the filename
will be as a file relative to XPPIncludeDir

=cut
sub load {
	my $self		= shift;
	my $filename	= shift;
	my $counter		= shift;	# don't recurse
	warn "xpp: loading source ($filename)" . ($debuglines ? '' : "\n") if ($debug);
	
	if ((substr($filename,0,1) eq '/') or ((substr($filename,0,2) eq './') and ($counter))) {
		my $fh = new FileHandle;
		warn "xpp:\tattempting to load $filename" . ($debuglines ? '' : "\n") if ($debug);
#		if (($filename =~ m{^(/[/\-\w\.]+)$}) && ($fh->open($1))) {
		if ($fh->open($filename)) {
			local($/)	= undef;
			return <$fh>;
		} else {
			warn "xpp:\tfailed to load file $filename ($!)" . ($debuglines ? '' : "\n");
			return undef;
		}
	} elsif ($filename =~ m{^(?:.+)?://(?:.+)$}) {
		my $ua	= LWP::UserAgent->new;
		my $req	= HTTP::Request->new( 'GET', $filename );
		my $res	= $ua->request( $req );
		warn "xpp:\tattempting to load $filename from LWP::UserAgent" . ($debuglines ? '' : "\n") if ($debug);
		if ($res->is_success) {
			return $res->content;
		} else {
			warn "xpp:\tfailed to load file $filename ($!)" . ($debuglines ? '' : "\n");
			return undef;
		}
	} else {
		my $qualified	= $self->qualify( $filename );
		warn "xpp:\tqualifying filename, and attempting to load '${qualified}'" . ($debuglines ? '' : "\n") if ($debug);
		return $self->load( $qualified, 1 ) unless ($counter);
		return undef;
	}
} # END method load


sub mtime {
	my $self		= shift;
	my $filename	= ref($self) ? $self->filename : shift;
	my $counter		= shift;
	warn "xpp: checking mtime of file ($filename)" . ($debuglines ? '' : "\n") if ($debug);
	
	if (substr($filename,0,1) eq '/') {
		my $mtime = undef;
		unless (-f $filename) {
			return undef;
		}
		
		my $st = stat($filename);	# using File::stat
		if (ref($st) && $st->can('mtime')) {
			return $st->mtime;
		} else {
			warn "xpp:\tcannot stat file ($filename): $!" . ($debuglines ? '' : "\n") if ($debug);
			return undef;
		}
	} elsif ($filename =~ m{^((?:.+)?://(?:.+))$}) { 
		my $ua	= LWP::UserAgent->new;
		my $req	= HTTP::Request->new( 'GET', $filename );
		my $res	= $ua->request( $req );
		if (my $headers = $res->headers) {
			return $headers->last_modified;
		} else {
			warn "xpp:\tfailed to get mtime for url ($!)" . ($debuglines ? '' : "\n") if ($debug);
			return undef;
		}
	} else {
		warn "xpp:\tattempting to qualify filename, and mtime again '${filename}'" . ($debuglines ? '' : "\n") if ($debug);
		return $self->mtime( $self->qualify( $filename ), 1 ) unless ($counter);
		return undef;
	}
} # END method mtime


=item C<qualify> ( $filename )

Qualifies the passed name to a fully rooted filename by using either C<incdir> or C<docroot>.

=cut
sub qualify {
	my $self		= shift;
	my $filename	= shift;
	carp "xpp: qualifying filename ($filename)" . ($debuglines ? '' : "\n") if ($debug);
	
	if (substr($filename,0,1) eq '/') {
		warn "xpp:\tqualifying document rooted file" . ($debuglines ? '' : "\n") if ($debug >= 2);
		if ($filename =~ m{^(/[/\-\w\.]+)$}) {
			return join('', $self->docroot, $1);
		}
	} elsif ($filename =~ m{^((?:.+)?://(?:.+))$}) {
		warn "xpp:\tassuming URL is already qualified" . ($debuglines ? '' : "\n") if ($debug >= 2);
		return $1;
	} else {
		warn "xpp:\tqualifying include rooted file" . ($debuglines ? '' : "\n") if ($debug >= 2);
		warn "xpp:\tfilename: $filename" . ($debuglines ? '' : "\n") if ($debug >= 2);;
		if ($filename =~ m{^([/\-\w\.]+)$}) {
			my $r = $self->r();
			my $incdir = $self->incdir($r);
			return ($incdir) ? join('/', $incdir, $1) : $1;
		}
	}
	
	warn "xpp: qualify failed on filename '$filename'!" . ($debuglines ? '' : "\n") if ($debug);
	return undef;
} # END method qualify


=item C<incdir> (  )

Returns the include directory from which C<include> and C<xinclude> will retrieve source
from by default.  See C<include>, C<xinclude>, and C<load> for more documentation on this
process.

=cut
sub incdir {
	my $self	= shift;
	my $r		= (ref $self) ? $self->r : shift;
	#Not cleaning up for now, why not cache for the life of a process.
	#$r->register_cleanup(sub {undef $Apache::XPP::_cache::incdir}) unless (defined $Apache::XPP::_cache::incdir);