Template::Direct::Base - Basic class for content sections


Template-Direct documentation Contained in the Template-Direct distribution.

Index


Code Index:

NAME

Top

Template::Direct::Base - Basic class for content sections

DESCRIPTION

Top

  Provide the low level functions applicable to all content sections

METHODS

Top

$class->new( $data )

  Create a new instance object.

$construct->singleTag( )

  Return true if this construct will be a single tag.
  i.e [tag/]

$construct->subTags( )

  Should return a list of valid child tags.

$construct->hasTag( $name )

  Return true if this construct has a named tag.

$construct->hasSubTag( $name )

  Return true if this construct has a named sub tag.

$construct->allSubTags( )

  Return an ARRAY ref of sub tag objects.

$construct->addSubTag( $name, $index, $data )

  Used internally to add a sub tag element to this construct.

$construct->addEndSubTag( $name, $index )

  Complete a sub tag by closing it, used internally.

$construct->endTag( )

  The tag id for the end tag of this construct.

$construct->startTag( )

  The tag id for the start tag of this construct.

$construct->setEndTag( $index )

  Set the id of the end tag of this construct.

$construct->addChild( $object )

  Used internally to add a child construct to this one.

$construct->setParent( $object )

  Set the parent object of this construct to $object.

$construct->setClassParent( $object )

  Set the last parent which had the same class as this construct.

$construct->children( )

  Return an ARRAY ref of child constructs.

$construct->parent( )

  Return the parent construct (if available)

$construct->depth( )

  Return the depth number for this tag.

$construct->classParent( )

  Return the next parent with the same class as this one.

$construct->classDepth( )

  Return the depth number for this tag counting only tags
  of the same class as this one.

$construct->getParent( $depth )

  Get a parent at a certain depth.

$construct->getClassParent( $depth )

  Get the class parent of a certin depth.

$construct->compile( $data, $content, %p )

  Used internally to cascade the compilation to all children
  and replace and variables with $data as required.

$construct->compileChildren( $data, $content, %p )

  Used internally, loop through all children and compile them
  with the same data and content.

$object->getOptions( $line )

  Returns a hash ref of name vale pairs and described as a string in line.

  The line: "var='xyz' depth=0" becomes { var => 'xyz', depth => '0' }

$object->getSection( $content, $start, $end )

  Returns a section of a content between two tag indexes.
  Having two sections with the same tag indexes is not valid
  It's expected that code that deals with listing splits up
  it's calls to this method as a matter of structure.

$construct->getLocation( $content, $tagIndex )

  Replaces a tag location with a temporty pointer.

$construct->getFullSection( $content )

  Returns getSection of the current objects start and end tags

$construct->setSection( $content, $result )

  Sets the section back into the content (see getSection)

$construct->setTagSection( $content, $tagIndex, $with )

  Sets the section back into the content tag directly

$construct->getAppendedSection( $content, $startEntry, $endEntry )

  Returns the content between start and end tags, removing the start tag but
  only removing the end tag if it's an end tag for the start tag.

$construct->replaceData( \$content, $data )

 Replace all instances in content with required data

$construct->cleanContent( \$content )

 Removes any remaining content syntax from content

AUTHOR

Top

  Martin Owens - Copyright 2007, AGPL


Template-Direct documentation Contained in the Template-Direct distribution.
package Template::Direct::Base;

use strict;
use warnings;

use Template::Direct::Conditional;
use Template::Direct::List;
use Template::Direct::SubPage;
use Template::Direct::Maths;
use Carp;

sub new {
    my ($class, %p) = @_;
	my $self = bless { 'subtagindex' => {}, %p }, $class;
	return $self;
}

sub singleTag { 0 }

sub subTags { die "SubTags needs to be created in the parent class of: ".ref($_[0])."\n" }

sub hasTag {
	my ($self, $tagName) = @_;
	return defined($self->subTags()->{$tagName})
}

sub hasSubTag {
	my ($self, $name) = @_;
	return defined($self->{'subtagindex'}->{$name});
}

sub allSubTags { return $_[0]->{'subtags'} || [] }

sub addSubTag {
	my ($self, $name, $index, $data) = @_;
	$self->{'subtags'} = [] if not defined($self->{'subtags'});
	push @{$self->{'subtags'}}, [ $name, $index, $data ];
	$self->{'subtagindex'}->{$name} = $index;
}

sub addEndSubTag {
	my ($self, $name, $index) = @_;
	push @{$self->{'subtags'}}, [ $name, $index, 'END' ];
}

sub endTag { $_[0]->{'endTag'}; }

sub startTag { $_[0]->{'startTag'} }

sub setEndTag {
	my ($self, $index) = @_;
	$self->{'endTag'} = $index;
}

sub addChild {
	my ($self, $object) = @_;
	$self->{'children'} = [] if not defined($self->{'children'});
	push @{$self->{'children'}}, $object;
}

sub setParent {
	my ($self, $object) = @_;
	$self->{'parent'} = $object;
	$self->{'depth'} = $object->depth() + 1;
}

sub setClassParent {
	my ($self, $object) = @_;
	$self->{'classParent'} = $object;
	$self->{'classDepth'} = $object->depth() + 1;
}

sub children    { shift->{'children'}    || [] }

sub parent      { shift->{'parent'}      || undef }

sub depth       { shift->{'depth'}       || 0 }

sub classParent { shift->{'classParent'} || undef }

sub classDepth  { shift->{'classDepth'}  || 0 }

sub getParent {
	my ($self, $depth) = @_;
	$depth = 0 if not $depth;
	if($depth == 0) {
		return $self;
	}
	return $self->parent($depth-1);
}

sub getClassParent {
	my ($self, $depth) = @_;
	$depth = 0 if not $depth;
	if($depth == 0) {
		return $self;
	}
	return $self->classParent($depth-1);
}

sub compile {
	my ($self, $data, $content, %p) = @_;
	$self->compileChildren( $data, $content, %p );
	$self->replaceData( $content, $data );
}

sub compileChildren {
	my ($self, $data, $content, %p) = @_;
	foreach my $child (@{$self->children()}) {
		$child->compile( $data, $content, %p );
	}
}

sub getOptions {
	my ($self, $opt) = @_;
	my $results = {};

	while($opt =~ s/(\w+)=["']([^"']*)(?<!\\)["']//) {
		$results->{$1} = $2;
	}

	foreach my $o (split(/(?<!\\)\s+/, $opt)) {
		if($o =~ /(\w+)=(.*)?/) {
			$results->{$1} = $2;
		} else {
			$results->{$o} = 1;
		}
	}

	return $results;
}

sub getSection {
	my ($self, $content, $start, $end) = @_;
	my $result = '';
	if($$content =~ s/\{\{TAG$start\}\}([\w\W]*?)\{\{TAG$end\}\}/{{PH}}/) {
		$result = $1;
	}
	return $result;
}

sub getLocation {
	my ($self, $content, $tagindex) = @_;
	$$content =~ s/\{\{TAG$tagindex\}\}/{{PH}}/;
	return 1;
}

sub getFullSection {
	my ($self, $content) = @_;
	return $self->getSection($content, $self->startTag(), $self->endTag());
}

sub setSection {
    my ($self, $content, $result) = @_;
	if(defined $result) {
	    $$content =~ s/\{\{PH\}\}/$result/;
	} else {
		$$content =~ s/\{\{PH\}\}//;
	}
}

sub setTagSection {
    my ($self, $content, $index, $result) = @_;
    $$content =~ s/\{\{TAG$index\}\}/$result/;
}

sub getAppendedSection {
	my ($self, $content, $start, $end) = @_;

	my $result      = '';
	my $replaceWith = '';
	my $startIndex  = $start->[1];
	my $endIndex    = defined($end) ? $end->[1] : 'FAKEEND';

	# The start tag must be the same as the end tag and the
	# end tag must BE an offical END tag.
	if(defined($end) and ($start->[0] ne $end->[0] or $end->[2] ne 'END')) {
		# The end tag isn't related so we just put it back.
		# It's used as a marker for where the current start
		# tag ends rather than a real end tag, although I'd
		# like for people to use end tags properly and I
		# figure html gurus will as a matter of habbit.
		$replaceWith = '{{TAG'.$end->[1].'}}';
	} elsif(not defined($end)) {
		# Should also deal with tags that reach to the end of the scope.
		$$content .= '{{TAGFAKEEND}}';
	}

	if($$content =~ s/\{\{TAG$startIndex\}\}([\w\W]*?)\{\{TAG$endIndex\}\}/$replaceWith/) {
        $result = $1;
    }

	return $result;
}

sub replaceData
{
    my ($self, $content, $data) = @_;
	# The extra 1 in getDatum forces a scalar string (no undefs or structs)
    $$content =~ s/(?<!\\)\$([\w\-_]+)/ $data->getDatum($1, forceString => 1) /eg;
    $$content =~ s/(?<!\\)\$\{([\w\-_]+)\}/ $data->getDatum($1, forceString => 1) /eg;
    return $content;
}


sub cleanContent {
	my ($self, $content) = @_;
	# We could remove spare structures here:
	#$$content =~ s/(?<!\\)\[.+\]//g;
	# Remove variables,remove stroked variables
	$$content =~ s/(?<!\\)\$[\w\-_]+//g;
	$$content =~ s/(?<!\\)\$\{[\w\-_]+?\}//g;
	# Unescape brackets and dollar signs
	$$content =~ s/\\([\[\]\$])/$1/g;
	return $content;
}

1;