File Coverage

blib/lib/XML/Parser/EasyTree.pm

Criterion	Covered	Total	%
statement	6	57	10.5
branch	0	10	0.0
condition	0	11	0.0
subroutine	2	11	18.1
pod	0	9	0.0
total	8	98	8.1

package XML::Parser::EasyTree;

use strict;
use vars qw($VERSION $Noempty $Latin);

$VERSION = '0.01';

$XML::Parser::Built_In_Styles{EasyTree} = 1;

sub Init {
  my $expat = shift;
  $expat->{Lists} = [];
  $expat->{Curlist} = $expat->{Tree} = [];
}

sub Start {
  my $expat = shift;
  my $tag = shift;
  checkempty($expat);
  my $newlist=[];
  my $newnode={type=>'e',attrib=>{},name=>nsname($expat,$tag),content=>$newlist};
  while (@_) {
    my ($name,$val)=(shift @_,shift@_);
    $newnode->{attrib}{nsname($expat,$name)}=encode($val);
  }
  push @{ $expat->{Lists} }, $expat->{Curlist};
  push @{ $expat->{Curlist} }, $newnode;
  $expat->{Curlist} = $newlist;
}

sub End {
  my $expat=shift;
  checkempty($expat);
  $expat->{Curlist}=pop @{$expat->{Lists}};
}

sub Char {
  my ($expat,$text)=@_;
  my $clist=$expat->{Curlist};
  if (!@$clist || $clist->[-1]{type} ne 't') {
    push @$clist,{type=>'t',content=>''};
  }
  $clist->[-1]{content}.=encode($text);
}

sub Proc {
  my ($expat,$target,$value)=@_;
  checkempty($expat);
  my $clist=$expat->{Curlist};
  push @$clist,{type=>'p',target=>encode($target),content=>encode($value)};
}

sub Final {
  my $expat = shift;
  checkempty($expat);
  delete $expat->{Curlist};
  delete $expat->{Lists};
  $expat->{Tree};
}

sub nsname {
  my ($parser,$name)=@_;
  if ($parser->{Namespaces}) {
    my $ns=$parser->namespace($name)||'';
    $name="{$ns}".$name;
  }
  return encode($name);
}

sub encode {
  my $text=shift;
  if ($Latin) {
    $text=~s{([\xc0-\xc3])(.)}{
      my $hi = ord($1);
      my $lo = ord($2);
      chr((($hi & 0x03) <<6) | ($lo & 0x3F))
     }ge;
  }
  $text;
}

sub checkempty() {
  my $expat=shift;
  if ($Noempty) {
    my $clist=$expat->{Curlist};
    if (@$clist && $clist->[-1]{type} eq 't' && $clist->[-1]{content}=~/^\s+$/) {
      pop @$clist;
    }
  }
}

1;
__END__