# -*- perl -*-
#
# HTML::EP - A Perl based HTML extension.
#
#
# Copyright (C) 1998 Jochen Wiedmann
# Am Eisteich 9
# 72555 Metzingen
# Germany
#
# Email: joe@ispsoft.de
#
#
# Portions Copyright (C) 1999 OnTV Pittsburgh, L.P.
# 123 University St.
# Pittsburgh, PA 15213
# USA
#
# Phone: 1 412 681 5230
# Developer: Jason McMullan
# Developer: Erin Glendenning
#
#
# All rights reserved.
#
# You may distribute this module under the terms of either
# the GNU General Public License or the Artistic License, as
# specified in the Perl README file.
#
############################################################################
use HTML::Parser ();
package HTML::EP::Parser;
$HTML::EP::Parser::VERSION = '0.01';
@HTML::EP::Parser::ISA = qw(HTML::Parser);
sub new {
my $self = shift->SUPER::new(@_);
$self->{'_ep_tokens'} = [];
$self->{'_ep_text'} = undef;
$self;
}
sub declaration {
my($self, $decl) = @_;
$self->text("");
}
sub start {
my($self, $tag, $attr, $attrseq, $origtext) = @_;
return $self->text($origtext) unless $tag =~ /^ep-/;
push(@{$self->{'_ep_tokens'}},
{'type' => 'S',
'tag' => $tag,
'attr' => $attr,
'attrseq' => $attrseq,
'origtext' => $origtext});
$self->{'_ep_text'} = undef;
}
sub end {
my($self, $tag, $origtext) = @_;
return $self->text($origtext) unless $tag =~ /^ep-/;
push(@{$self->{'_ep_tokens'}},
{'type' => 'E', 'tag' => $tag, 'origtext' => $origtext});
$self->{'_ep_text'} = undef;
}
sub text {
my($self, $text) = @_;
if (my $t = $self->{'_ep_text'}) {
$t->{'text'} .= $text;
} else {
push(@{$self->{'_ep_tokens'}},
($self->{'_ep_text'} = {'type' => 'T', 'text' => $text}));
}
}
sub comment {
my($self, $comment) = @_;
$self->text("");
}
package HTML::EP::Tokens;
sub new {
my $proto = shift;
my $self = { (@_ == 1) ? %{shift()} : @_ };
die "Missing token array" unless exists $self->{'tokens'};
$self->{'first'} = 0 unless exists $self->{'first'};
$self->{'last'} = @{$self->{'tokens'}} unless exists $self->{'last'};
bless($self, (ref($proto) || $proto));
}
sub Clone {
my($proto, $first, $last) = @_;
my $self = {%$proto};
$self->{'first'} = $first if defined $first;
$self->{'last'} = $last if defined $first;
bless($self, ref($proto));
}
sub First {
my $self = shift;
if (@_) { $self->{'first'} = shift() } else { $self->{'first'} }
}
sub Last {
my $self = shift;
if (@_) { $self->{'last'} = shift() } else { $self->{'last'} }
}
sub Token {
my $self = shift();
my $first = $self->{'first'};
return undef if $first >= $self->{'last'};
$self->{'first'} = $first+1;
$self->{'tokens'}->[$first];
}
sub Replace {
my($self, $index, $token) = @_;
$self->{'tokens'}->[$index] = $token;
}
1;