File Coverage

blib/lib/XML/Code.pm

Criterion	Covered	Total	%
statement	3	88	3.4
branch	0	38	0.0
condition	0	12	0.0
subroutine	1	17	5.8
pod	15	16	93.7
total	19	171	11.1

package XML::Code;

use vars qw ($VERSION);

$VERSION = '0.4';

sub new{
	my $who = shift;
	my $class = ref ($who) || $who;
	my $this = {
	   '' => shift,
	   '' => [],
	   '' => 1};
	return bless $this, $class;
}

sub version{
	my $this = shift;
	$this->{''} = shift;
}

sub doctype{
	my $this = shift;
	$this->{''} = shift;
}

sub encoding{
	my $this = shift;
	$this->{''} = shift;
   $this->{''} = '1.0' unless $this->{''};
}

sub stylesheet{
	my $this = shift;
	$this->{''} = shift;
}

sub comment{
	my $this = shift;
	my $comment = {
	   '' => '!',
	   '' => shift};
	bless $comment;
	$this->add_child ($comment);
}

sub pi{
	my $this = shift;
	my $pi = {
	   '' => '?',
	   '' => shift};
	bless $pi;
	$this->add_child ($pi);
}

sub name{
	my $this = shift;
	return $this->{''};
}

sub escape{
	my $this = shift;
	my $escape = shift;
	$this->{''} = $escape;
}

sub add_child{
	my $this = shift;
	my $children = shift;
	push @{$this->{''}}, $children;
}

sub add_textnode{
	my $this = shift;
	my $text = shift;
	my $textnode = new XML::Code ('=');
	$textnode->escape ($this->{''});
	$textnode->set_text ($text);
	push @{$this->{''}}, $textnode;
}

sub add_empty{
	my $this = shift;
	my $name = shift;
	my $emptynode = new XML::Code ($name);
	push @{$this->{''}}, $emptynode;
}

sub set_text{
	my $this = shift;
	my $text = shift;
	$this->{''} = $text;
}

sub text{
   my $this = shift;
   return $this->{'text'};
}

sub code{
	my $this = shift;
	my $tab_level = shift || 0;
	my $suppress_tab = shift || 0;

	$suppress_tab = 1 if $tab_level == -1;

	my $tab = "\t" x ($tab_level) unless $suppress_tab;

	my $name = $this->{''};
	my $text = $this->{''} || '';
	my $escape = $this->{''};

	my $code = '';

	my $prolog;
	$prolog = " version=\"$this->{''}\"" if $this->{''};
	$prolog .= " encoding=\"$this->{''}\"" if $this->{''};
	$code = "\n" if $prolog;
	$code .= "{''}>\n" if $this->{''};
	$code .= "{''}\"?>\n"
		if $this->{''};

	$text = escape_text ($text) if $escape;

	if ($name eq '!'){
	   $code .= "$tab\n";
	}

	elsif ($name eq '?'){
	   $code .= "$tab\n";
	}

	elsif ($name eq '='){
	   $code .= $text;
	}

	else{
    	my $children = $this->{''};

    	$code .= "$tab<$name";
    	foreach my $attribute (sort keys %$this){
		    my $value = $this->{$attribute};
			$value = escape_text ($value) if $escape;
    		$code .= " $attribute=\"$value\"" unless $attribute =~ m{^<};
    	}

    	if (scalar @$children){
    	   $code .= $text ? ">$text" : ">\n";
    	   for (my $count = 0; $count != scalar @$children; $count++){
    	   	   $code .= $$children[$count]->code ($tab_level != -1 ? $tab_level + 1 : -1,
			   	   $count == 0 && length ($text) ? 1 : 0);
    	   }
    	   $code .= "$tab\n";
    	}
    	else{
    	   $code .= $text ? ">$text\n" : "/>\n";
    	}
	}

	return $code;
}

sub escape_text{
	my $text = shift;
	$text =~ s{\&}{\&}gm;
	$text =~ s{<}{\<}gm;
	$text =~ s{>}{\>}gm;
	return $text;
}

return 1;

__END__