File Coverage

blib/lib/HTML/SimpleParse.pm

Criterion	Covered	Total	%
statement	63	70	90.0
branch	30	38	78.9
condition	5	6	83.3
subroutine	14	16	87.5
pod	14	14	100.0
total	126	144	87.5

package HTML::SimpleParse;

use strict;
use vars qw($VERSION $FIX_CASE);

$VERSION = '0.12';
my $debug = 0;

sub new {
  my $pack = shift;

  my $self = bless {
		    'text' => shift(),
		    'tree' => [],
		    @_
		   }, $pack;

  $self->parse() if defined $self->{'text'} and length $self->{'text'};
  return $self;
}

sub text {
  my $self = shift;
  $self->{'text'} = shift if @_;
  return $self->{'text'};
}

sub tree { @{$_[0]->{'tree'}} }

sub parse {
  # Much of this is a dumbed-down version of HTML::Parser::parse.

  my $self = shift;
  my $text = \ $self->{'text'};
  my $tree = $self->{'tree'};

  # Parse html text in $$text.  The strategy is to remove complete
  # tokens from the beginning of $$text until we can't decide whether
  # it is a token or not, or the $$text is empty.

  @$tree = ();
  while (1) {
    my ($content, $type);

    # First we try to pull off any plain text (anything before a "<" char)
    if ($$text =~ /\G([^<]+)/gcs) {
      $content = $1; $type = 'text';

      # Then, SSI, comments, and markup declarations (usually )
      # ssi:
      # comment:
      # markup:
    } elsif ($$text =~ /\G<(!--(\#?).*?--)>/gcs) {
      $type = ($2 ? 'ssi' : 'comment');
      $content = $1;

    } elsif ($$text =~ /\G<(!.*?)>/gcs) {
      $type = 'markup';
      $content = $1;

      # Then, look for an end tag
    } elsif ($$text =~ m|\G<(/[a-zA-Z][a-zA-Z0-9\.\-]*\s*)>|gcs) {
      $content = $1; $type = 'endtag';

      # Then, finally we look for a start tag
      # We know the first char is <, make sure there's a >
    } elsif ($$text =~ /\G<(.*?)>/gcs) {
      $content = $1; $type = 'starttag';

    } else {
      # the string is exhausted, or there's no > in it.
      push @$tree, {
		    'content' => substr($$text, pos $$text),
		    'type'    => 'text',
		   } unless pos($$text) eq length($$text);
      last;
    }

    push @$tree, {
		  'content' => $content,
		  'type'    => $type,
		  'offset'  => ($type eq 'text' ?
				pos($$text) - length($content) :
				pos($$text) - length($content) - 2),
		 };
  }

  $self;
}


$FIX_CASE = 1;
sub parse_args {
  my $self = shift;  # Not needed here
  my $str = shift;
  my $fix_case = ((ref $self and exists $self->{fix_case}) ? $self->{fix_case} : $FIX_CASE);
  my @returns;

  # Make sure we start searching at the beginning of the string
  pos($str) = 0;

  while (1) {
    next if $str =~ m/\G\s+/gc;  # Get rid of leading whitespace

    if ( $str =~ m/\G
	 ([\w.-]+)\s*=\s*                         # the key
	 (?:
	  "([^\"\\]*  (?: \\.[^\"\\]* )* )"\s*    # quoted string, with possible whitespace inside,
	  |                                       #  or
	  '([^\'\\]*  (?: \\.[^\'\\]* )* )'\s*    # quoted string, with possible whitespace inside,
	  |                                       #  or
	  ([^\s>]*)\s*                            # anything else, without whitespace or >
	 )/gcx ) {

      my ($key, $val) = ($1, $+);
      $val =~ s/\\(.)/$1/gs;
      push @returns, ($fix_case==1 ? uc($key) : $fix_case==-1 ? lc($key) : $key), $val;

    } elsif ( $str =~ m,\G/?([\w.-]+)\s*,gc ) {
      push @returns, ($fix_case==1 ? uc($1)   : $fix_case==-1 ? lc($1)   : $1  ), undef;
    } else {
      last;
    }
  }

  return @returns;
}


sub execute {
  my $self = shift;
  my $ref = shift;
  my $method = "output_$ref->{type}";
  warn "calling $self->$method(...)" if $debug;
  return $self->$method($ref->{content});
}

sub get_output {
  my $self = shift;
  my ($method, $out) = ('', '');
  foreach ($self->tree) {
    $out .= $self->execute($_);
  }
  return $out;
}


sub output {
  my $self = shift;
  my $method;
  foreach ($self->tree) {
    print $self->execute($_);
  }
}

sub output_text      {   $_[1]; }
sub output_comment   { "<$_[1]>"; }
sub output_endtag    { "<$_[1]>"; }
sub output_starttag  { "<$_[1]>"; }
sub output_markup    { "<$_[1]>"; }
sub output_ssi       { "<$_[1]>"; }

1;
__END__