view release on metacpan or  search on metacpan

lib/HTML/Pen.pm  view on Meta::CPAN

require Exporter;

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 Pen ':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 = '1.01';

our ( $T1, $T2, $T3 ) ;
our ( $pen, $DOCS, $follow ) ;
my ( $skipct, $crashlimit, @fh ) ;
my $undef = '' ;


## request initialization
sub new {
	shift @_ if $_[0] eq __PACKAGE__ ;
	$skipct = 0 ;
	$crashlimit = 200000 ;
	@fh = () ;

	my $path = shift @_ unless ref $_[0] ;
	$pen = shift ;
	$pen ||= {} ;
	$path ||= $pen->{request} ;

	my @path = fromFQPath( $path ) ;

	## special variables $DOCS && $follow are historical
	$pen->{path} ||= $path[0] ;
	$DOCS = $pen->{path} ;
	$pen->{request} ||= $path[1] ;
	$follow = $pen->{request} ;

	include( $path || $pen->{request} ) ;
	return bless {}, __PACKAGE__ ;
	}

sub defaultdocs {
	return filePath( @_ ) ;
	}

sub filePath {
	return join '/', @_ if $_[0] =~ m|^/| ;
	return join '/', $pen->{path}, @_ ;
	}

sub fromFQPath {
	my @path = split m|/|, pathHack( $_[0] ) ;
	my $fn = pop @path ;
	my $path = join '/', @path ;
	return ( $path, $fn ) ;
	}

sub include {
	my $fn = shift ;
	my $skip = @_? shift @_: 0 ;

	## hopefully something else barks first...
	return if scalar @fh > 40 ;

	$fn = filePath( $fn ) ;

	my $fh = new FileHandle pathHack( $fn ) ;
	return unless defined $fh ;
	push @fh, $fh ;

	scalar <$fh> while ( $skip-- ) ;
	while (<$fh>) {
		&parseLine( $_ ) ;
		}

	pop @fh ;
	skip( 0 ) ;
	return comment() ;
	}

sub do {
	my $fn = shift ;
	$fn = filePath( $fn ) ;
	do $fn ;
	return @_? $@ || $!: undef ;
	}

## Given a symlink: ln -s /tmp/foobar foo/bar
## 'foo/bar/..' may resolve to '/tmp' instead of 'foo'
## pathHack explicitly performs the following conversion:
## /the/quick/../brown/fox  =>  /the/brown/fox

sub pathHack {
	my $path = shift ;

	my @tokens = ( '' ) ;
	foreach ( grep $_, HTML::Pen::Utils::split( $path, '/' ) ) {
		push @tokens, '' unless $_ eq '/' ;
		$tokens[-1] .= $_ ;
		}

	my @rv = () ;
	foreach ( grep $_, @tokens ) {
		s|//+|/|g ;
		push @rv, $_ unless $_ eq './' || $_ eq '../' ;
		pop @rv if $_ eq '../' ;
		}

	return join '', @rv ;
	}

sub innerParse {