File Coverage

blib/lib/XML/Directory/String.pm

Criterion	Covered	Total	%
statement	50	91	54.9
branch	7	20	35.0
condition	1	3	33.3
subroutine	12	18	66.6
pod	0	11	0.0
total	70	143	48.9

package XML::Directory::String;

require 5.005_03;
BEGIN { require warnings if $] >= 5.006; }

use strict;
use File::Spec::Functions ();
use Carp;
use XML::Directory;

@XML::Directory::String::ISA = qw(XML::Directory);

sub parse_dir {
    my $self = shift;
    $self->SUPER::parse;
    return scalar @{$self->{xml}};
}

sub parse {
    my $self = shift;
    $self->SUPER::parse;
    return scalar @{$self->{xml}};
}

sub get_arrayref {
    my $self = shift;
    return $self->{xml};
}

sub get_array {
    my $self = shift;
    my $xml = $self->{xml};
    return @$xml;
}

sub get_string {
    my $self = shift;
    my $xml = $self->{xml};
    return join "\n", @$xml, '';
}

sub doStartDocument {
    my $self = shift;
    $self->{xml} = [];
    $self->{level} = 0;
    push @{$self->{xml}},
      "{encoding}\"?>";

    if ($self->{doctype}) {
	my $doctype = $self->_doctype;
	push @{$self->{xml}}, $doctype;
    }
}

sub doEndDocument {
}

sub doStartElement {
    my ($self, $tag, $attr, $qname) = @_;
    my $pref = '';
    $pref = $self->_ns_prefix unless $qname;
    push @{$self->{xml}},
      '  ' x $self->{level}++
	. "<$pref"
	  . "$tag "
 	    . join(' ', map {qq/$_->[0]="$_->[1]"/} @$attr)
 	      . ">";
}

sub doEndElement {
    my ($self, $tag, $qname) = @_;
    my $pref = '';
    $pref = $self->_ns_prefix unless $qname;
    push @{$self->{xml}},
      '  ' x --$self->{level}
	. "
	  . "$tag>"
	    ;
}

sub doElement {
    my ($self, $tag, $attr, $value, $qname) = @_;
    my $pref = '';
    $pref = $self->_ns_prefix unless $qname;
    my $element = '  ' x $self->{level}
      . "<$pref"
      . "$tag "
      . join(' ', map {qq/$_->[0]="$_->[1]"/} @$attr)
      . '>';
    $element =~ s/ >$/>/;
    $element .= $value if defined $value;
    $element .= "
    $element .= "$tag>";
    push @{$self->{xml}}, $element;
}

sub doError {
    my ($self, $n, $par) = @_;
    my $msg = $self->_msg($n);
    $msg = "[Error $n] $msg: $par";

    unless ($self->{catch_error}) {
	croak "$msg\n"

    } else {

	$self->doStartDocument;

	if ($self->{ns_enabled}) {
	    my @attr = ();
	    my $decl = $self->_ns_declaration;
	    push @attr, [$decl => $self->{ns_uri}];
	    $self->doStartElement('dirtree', \@attr);
	} else {
	    $self->doStartElement('dirtree', undef);
	}

	my @attr2 = ([number => $n]);
	$msg =~ s/&/&/g;
	$msg =~ s/
	$msg =~ s/>/>/g;
	$self->doElement('error', \@attr2, $msg);

	$self->doEndElement('dirtree');
	$self->{error} = $n;
    }
}

sub _ns_prefix {
    my $self = shift;

    my $pref = '';
    if ($self->{ns_enabled} && $self->{ns_prefix}) {
	$pref = "$self->{ns_prefix}:";
    }
    return $pref;
}

sub _doctype {
    my $self = shift;

    my $doctype = '
      . '"-//GA//DTD XML-Directory 1.0 Level_DET_//EN"'
	. "\n    "
	  . '"http://www.gingerall.org/dtd/XML-Directory/1.0/'
	    . 'dirtree-level_DET_.dtd">';

    if ($self->{details}) {
	$doctype =~ s/_DET_/$self->{details}/g;
    } else {
	$doctype =~ s/_DET_/2/g;
    }
    return $doctype;
}

1;

__END__