use strict;

package HtmlBlocks;

#----------------------------------------------------------------------
# Extract named blocks from file and put in a hash

sub extract {
    my ($input) = @_;
    return _parse ($input, Extracter->new());
}

#----------------------------------------------------------------------
# Substitute html in hash for blocks with same name in input

sub substitute {
    my ($input, $html) = @_;
    return _parse ($input, Substituter->new ($html));
}

#----------------------------------------------------------------------
# Wrap hash items in comments

sub wrap {
    my ($hash) = @_;

    while (my ($key, $value) = each %$hash) {
	$hash->{$key} = "<!-- begin $key -->\n$value\n<!-- end $key -->\n";
    }

    return $hash;
}

#----------------------------------------------------------------------
# Parse named blocks in html file

sub _parse {
    my ($input, $object) = @_;

    my @token = split (/(<!--\s*(?:begin|end)\s+.*?-->)/i, $input);

    foreach my $token (@token) {
	if ($token =~ /<!--\s*begin\s+(\w+).*?-->/) {
	    $object->enter ($token, $1);

	} elsif ($token =~ /<!--\s*end\s+(\w+).*?-->/) {
	    $object->leave ($token, $1);

	} else {
	    $object->mid ($token);
	}
    }

    return $object->disgorge;
}

package Extracter;

#----------------------------------------------------------------------
# Initialize state

sub new {
    my ($pkg) = @_;

    my $self = {};

    $self->{html} = {};
    $self->{stack} = [];

    return bless ($self, $pkg);
}

#----------------------------------------------------------------------
# Push new block on the stack

sub enter {
    my ($self, $token, $id) = @_;

    push (@{$self->{stack}}, $id);
    $self->mid ($token);
}

#----------------------------------------------------------------------
# Remove block from the stack and add to hash

sub leave {
    my ($self, $token, $newid) = @_;

    my $oldid = pop (@{$self->{stack}});
    die "Mismatched ids: $oldid and $newid\n" if $newid ne $oldid;

    $self->{html}{$oldid} .= $token;
    $self->mid ($token);
}

#----------------------------------------------------------------------
# Add token to all blocks on the stack

sub mid {
    my ($self, $token) = @_;

    foreach my $id (@{$self->{stack}}) {
	$self->{html}{$id} .= $token;
    }
}

#----------------------------------------------------------------------
# Return hash 

sub disgorge {
    my ($self) = @_;
    return $self->{html};
}

package Substituter;

#----------------------------------------------------------------------
# Initialize structure

sub new {
    my ($pkg, $html) = @_;

    my $self = {};

    $self->{stack} = [];
    $self->{html} = $html;
    $self->{text} = '';

    return bless ($self, $pkg);
}

#----------------------------------------------------------------------
# Handle new named block
 
sub enter {
    my ($self, $token, $id) = @_;

    if (@{$self->{stack}}) {
	push (@{$self->{stack}}, $id);

    } elsif (exists $self->{html}{$id}) {
	$self->{text} .= $self->{html}{$id};
	push (@{$self->{stack}}, $id);

    } else {
	$self->{text} .= $token;
    }
}

#----------------------------------------------------------------------
# Remove named block from stack

sub leave {
    my ($self, $token, $newid) = @_;

    if (@{$self->{stack}}) {
	my $oldid = pop (@{$self->{stack}});
	die "Mismatched ids: $oldid and $newid\n" if $newid ne $oldid;

    } else {
	$self->{text} .= $token;
    }
}

#----------------------------------------------------------------------
# Add token to output text if we are not in a named block

sub mid {
    my ($self, $token) = @_;
    $self->{text} .= $token unless @{$self->{stack}};
}

#----------------------------------------------------------------------
# Return output text

sub disgorge {
    my ($self) = @_;
    return $self->{text};
}

1;

__END__

=pod

=head1 NAME

HtmlBlocks - HTML Block extraction and substitution

=head1 SYNOPSIS

    use HtmlBlocks;

    # Parse input file and substitute into template

    my $hash = HtmlBlocks::extract ($input);

    or

    my $hash = HtmlBlocks::wrap ($hash);

    my $output = HtmlBlocks::substitute ($template, $hash);


=head1 DESCRIPTION

This module forms the back end of a simple templating system. Regions
of an html template are delimeted by special comments. The substitute
subroutine replaces thes regions with the corresponding values in a
hash. The extract subroutine will create a hash from an existing html
file. By combining the two subroutines, you can merge the content of
one page with another.

So two subroutines in this module are designed to be called:

=over 4

=item $hash = HtmlBlocks::extract ($input);

This subroutine parses a string, extracts all the comment delimeted
blocks and places them in a hash indexed by the block's id.

=item $output = HtmlBlocks::substitute ($template, $html);

This subroutine replaces comment delimeted blocks contained in the
template string with values in a hash with the same id. The result is
the resulting string.

=item $hash = HtmlBlocks::wrap ($hash);

As an alternative to extracting items from a web page, you can create
comment delimeted blocks from an already existing hash.

=back

=head1 SYNTAX

Comment blocks in the template are wrapped in html comments that look
like

    <!-- begin name -->
    <!-- end name -->

where name is any identifier string.

=head1 AUTHOR

Bernie Simon (http://carelesshand.net)

=head1 LICENSE

Copyright Bernard Simon, 2005. You may use this file as you wish as
long as this copyright notice is maintained.