view release on metacpan or  search on metacpan

CMTemplate.pm  view on Meta::CPAN

    # again.
    $self->__end_block__; # both beginning and ending tag.
    # Keep track of this and only open it again if needed.
    $self->__add_raw__( $filename, $text, $mtime );
}

sub __onECHO__ {
    my $self = shift;
    $self->__debug__(\@_);
    my $contents = shift;

    my $node = $self->__top_TPL__( 'ECHO' );
    my $echonode = _ECHO_->new( $self );
    $echonode->expr( $contents );
    $node->blk( $echonode );
    $self->__end_block__;
}

sub __onBREAK__ {
    my $self = shift;
    $self->__debug__(\@_);
    my $contents = shift;

    my $node = $self->__top_TPL__( 'BREAK' );
    my $breaknode = _BREAK_->new( $self );
    $node->blk( $breaknode );
    $self->__end_block__;
}

sub __onCONTINUE__ {
    my $self = shift;
    $self->__debug__(\@_);
    my $contents = shift;

    my $node = $self->__top_TPL__( 'CONTINUE' );
    my $continuenode = _CONTINUE_->new( $self );
    $node->blk( $continuenode );
    $self->__end_block__;
}

sub __onEXEC__ {
    my $self = shift;
    $self->__debug__(\@_);
    my $contents = shift;
    
    my $node = $self->__top_TPL__( 'EXEC' );
    my $execnode = _EXEC_->new( $self );
    $execnode->expr( $contents );
    $node->blk( $execnode );
    $self->__end_block__;
}

sub __onCOMMENT__ {
    my $self = shift;
    $self->__debug__(\@_);
    my $contents = shift;

    # NOP: Just eat the tag
}

sub __process_cdata__ {
    my $self = shift;
    $self->__debug__(\@_);
    my ($cdata) = @_;

    # If we are in a TPL node, then we should just add the text to the current
    # text in that node.  Otherwise, something went wrong.  We should always
    # be prepared to receive text when it comes.
    my $node = $self->__top_TPL__( 'text' );
    $node->text( $node->text . $cdata );
    $self->__debug__( "New CDATA length: " . length( $node->text ) );
}

# This function takes a chunk of text and decides what to do with it.  It works
# in a similar fashion to expat, which will take text until you quit giving it
# to it.  It simply looks for tags and data in between.  When a complete tag is
# found, it passes the information off to a function to have it processed.
# When cdata is found (character data) it dumps it out.  Note that there is
# no guarantee that the cdata will come back all at once.  This function does
# not do any output buffering on cdata.  If it isn't in a tag, it gives you
# everything that it currently has, whether it is the entire set of text
# or not.
sub __process_block__ {
    my $self = shift;
    $self->__debug__(\@_);
    my $str =  shift;

    # This function only looks for tokens and keeps track of whether or not
    # it is inside of a tag.  Once a complete tag has been found, it will
    # send the name of that tag and all remaining text inside of it to the
    # appropriate function.
    # If it reaches the end of a buffer and is not inside of a tag, it
    # accumulates all text and sends it out to the cdata function.

    # Append to the buffer and continue where we left off.
    $self->{strbuf} .= $str;

    # Note that if we are already inside of a tag, we search from a few
    # characters before the boundary.  Otherwise, we search from the beginning
    # of the unprocessed buffer.
    my $curpos = ($self->{parserintag}) ? 
        $self->{buflen} - $HTML::CMTemplate::tagEndLen + 1: 
        $self->{bufstart};
    $self->__debug__( "Curpos: $curpos" );

    $self->{buflen} += length($str);
    $self->__debug__( "New Buflen: " . $self->{buflen} );
    while ($curpos < $self->{buflen}) {
        # In a tag.  Get the rest of it, if possible, and send it out for
        # processing.
        if ($self->{parserintag}) {
            $self->__debug__( 'STATE: inside of a tag' );
            # Try to find the end of the tag.
            my $pos = index( $self->{strbuf}, $HTML::CMTemplate::tagEnd, $curpos );
            $self->__debug__( "End tag position: $pos" );
            # If we found it, we get all of the stuff inside of the tag and dump
            # it into a function.
            if ($pos > -1) {
                # Found the end tag.  Send it on its way.
                # Get the internals of the tag:
                my $start = $self->{tagstart} + $HTML::CMTemplate::tagStartLen;
                my $tag = substr( $self->{strbuf}, $start, $pos - $start );
                if ($tag =~ m/^(\w+)(\s+(.*?)\s*)?$/s) {
                    # $1 contains the name of the tag
                    # $3 contains the rest of the tag's text, if there is any.
                    # TODO: Make the function call configurable by a hash or
                    # something.
                    $self->__process_tag__($1, (defined($3))?$3:'');
                    # Once the tag is processed, we are no longer in a tag.
                    # Move the current position to where we left off and
                    # continue the loop.
                }
                # Special case for block tags with no expression, like 'else'
                elsif ($tag =~ m/^(\w+)\s*:\s*$/s) {
                    $self->__debug__(
                        "Found an expressionless block tag: $tag" );
                    $self->__process_tag__($1, ':');
                }
                else {
                    # The tag was not of the format <?=name expression?>
                    # So, we take everything inside of the <?= and ?> and
                    # treat it like it was the expression for the default tag.
                    # The default tag is set up to be 'echo' by default.
                    $self->__debug__( "Found a shortcut tag: $tag" );
                    $self->__process_tag__(
                        $HTML::CMTemplate::tagNameDefault, $tag);
                }
                $self->{parserintag} = 0;
                $curpos = $pos + $HTML::CMTemplate::tagEndLen;
                # Check that the next character is not an endline.  If it is,
                # we need to eat it.
                # TODO: What happens on Windows?  Do we need to move it two?
                $curpos++ if (substr($self->{strbuf}, $curpos, 1) eq "\n");
                # Important to move up the bufstart flag.  We have, after all,
                # used up the buffer to this point.
                $self->{bufstart} = $curpos;
            }
            else {
                # No ending tag found.  We need to continue accumulating buffer.
                last;
            }
        }
        # Not in a tag.  Search for a starting tag or something that looks
        # like it might be one.  Send out all text.  If a tag is found,
        # we need to put ourselves into a tag state and set the tagstart
        # index.
        else {
            $self->__debug__( "STATE: Not in a tag" );
            # NOTE: There is a tricky boundary case here.  If the start tag
            # is spanning buffer boundaries (this usually won't happen,
            # especially if the file is read in one line at a time, but it
            # will definitely happen if it is read in arbitrary sized chunks)
            # it could get missed by the parser.  (A full substring match will
            # fail until the entire tag is seen.)  So, when getting ready
            # to spit out text, we need to check back a few characters for
            # the first character of a start tag.  If it is there and it is
            # not escaped somehow, we only send out the text up to that
            # character.  We then defer searching for the start tag until
            # the next section of buffer is read in.
            my $pos = index( $self->{strbuf}, $HTML::CMTemplate::tagStart, $curpos);
            $self->__debug__( "Start tag position: $pos" );
            # If we found a start tag, we need to dump the text out and
            # set the tag state.  TODO: Check for escaped tags!
            if ($pos > -1) {
                # Found the start tag.  Change state and get out.
                $self->{parserintag} = 1;
                $self->{tagstart} = $pos;
                if ($pos > $curpos) {
                    $self->__process_cdata__( 
                        substr( $self->{strbuf}, $curpos, $pos - $curpos )
                        );
                    $curpos = $pos;
                }
                # exhausted our buffer to this point.
                $self->{bufstart} = $curpos;
            }
            else {
                # No start tag found.  Double check that the first character
                # of the tag is not in the end of the buffer somewhere.  If it
                # is, then send out the text up to that character.  Otherwise,
                # send everything out as text.
                my $firstchar = substr( $HTML::CMTemplate::tagEnd, 0, 1 );
                my $fpos = index( 
                    $self->{strbuf},
                    $firstchar,
                    $self->{buflen} - $HTML::CMTemplate::tagEndLen + 1
                    );
                # If nothing like a tag was found, set the position to be
                # the character after the end of the buffer.  Otherwise,
                # use the position of the tag character.
                $fpos = ($fpos > -1) ? $fpos : $self->{buflen};
                $self->__process_cdata__(
                    substr( $self->{strbuf}, $curpos, $fpos - $curpos )
                    );
                $curpos = $fpos;
                $self->{bufstart} = $curpos;
            }
        }
    }

    # We need to do some boundary checking here.  If, for example, the bufstart
    # flag is beyond the end of the buffer, we should just erase the buffer.
    # It's utility is exhausted.
    # Otherwise, we need to determine whether it makes sense to kill off part
    # of the buffer.
    if ($self->{bufstart} > 0) {
        $self->__debug__( "Start of buffer not at the beginning.  Reducing." );
        if ($self->{bufstart} >= $self->{buflen}) {
            $self->__debug__( "Buffer completely exhausted.  Resetting." );
            # Buffer is exhausted.  Reset everyone.
            $self->{bufstart} = 0;
            $self->{strbuf} = '';
            $self->{tagstart} = 0;
            $self->{buflen} = 0;
        }
        else {
            $self->__debug__( "Buffer partially exhausted.  Resetting." );
            # Buffer is at least partially exhausted.  No point in keeping
            # the unused portions around.  XXX: Do we need to hold off on this
            # case?  Should we only kill it if the remaining portion is smaller
            # than the unused portion?  What kind of metric should determine
            # this?
            my $start = $self->{bufstart};
            $self->{bufstart} = 0;
            $self->{buflen} -= ($start + 1);
            $self->{tagstart} -= $start;
            $self->{strbuf} = substr( $self->{strbuf}, $start );
            $self->__debug__( "New buffer length: " . $self->{buflen} );
        }
    }
}
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
# USER SPACE STUFF
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
=pod

I<get_includes()>

Returns an arrayref of included files.

=cut

sub get_includes() {
    my $self = shift;
    my @includes = (keys(%{$self->{parsedtable}}), keys(%{$self->{rawtable}}));
    return \@includes;
}