File Coverage

blib/lib/XML/PYX.pm

Criterion	Covered	Total	%
statement	10	58	17.2
branch	0	26	0.0
condition	0	6	0.0
subroutine	4	6	66.6
pod			n/a
total	14	96	14.5

# $Id: PYX.pm,v 1.9 2000/06/21 17:05:51 matt Exp $

package XML::PYX;

use strict;
use vars qw($VERSION);

$VERSION = '0.07';

$XML::PYX::Lame = 0;

sub encode {
	my $text = shift;
	$text =~ s/\n/\\n/g;
	return $text;
}

sub parse {
	my $output = shift;
	my $ioref;
	my $arg = shift @_;

	if (ref($arg) and UNIVERSAL::isa($arg, 'IO::Handler')) {
		$ioref = $arg;
	} else {
		eval {
			$ioref = *{$arg}{IO};
		};
	}
	if (!defined($ioref)) {
		die "Can't get filehandle!\n";
	}
	my $xml;
	# may have already done $ioref in parse, so rewind
	seek($ioref,0,0);
	{
		local $/;
		$xml = <$ioref>;
	}
	my $res;
	my @stack;
	while($xml =~ m/\G([^<]*)(<([\?!\/]?)([\w\-]+))?/gc) {
		my ($data, $type, $tag) = ($1, $3, $4);
#		warn "$data $type $tag\n";
		if (length $data) {
			$res .= $output->("-" . encode($data) . "\n");
		}

		last unless $type || $tag;

		if ($type eq '?') {
			if ($xml =~ m/\G\s+(.*?)\?>/gcs) {
				# processing instruction
				my $data = $1;
				$res .= $output->("?$tag " . encode($data) . "\n");
			}
			else {
				die "Invalid psuedo XML: No end to processing instruction\n";
			}
		}
		elsif ($type eq '!') {
			if ($tag eq '--') {
				# comment
				if ($xml =~ m/\G(.*?)-->/gcs) {
					# pyx doesn't support comments!
				}
				else {
					die "Invalid psuedo XML: No end to comment\n";
				}
			}
			else {
				die "Invalid tag
			}
		}
		elsif ($type eq '/') {
			# close element
			if ($tag eq $stack[0]) {
				shift @stack;
				if ($xml =~ m/\G\s*>/gc) {
					$res .= $output->(")$tag\n");
				}
				else {
					die "Invalid psuedo XML: Bad close tag\n";
				}
			}
			else {
				die "Invalid psuedo XML: Close tag mismatch\n";
			}
		}
		else {
			# start element
			unshift @stack, $tag;
			$res .= $output->("($tag\n");
			while($xml =~ m/\G(\s*(\w+)\s*=\s*(["'])(.*?)\3|>)/gcs) {
				last if $1 eq '>';
				my ($key, $val) = ($2, $4);
				$res .= $output->("A$key " . encode($val) . "\n");
			}
		}
	}
	return $res;
}

{
	package XML::PYX::Parser;
	use vars qw/@ISA/;

	use XML::Parser;

	@ISA = 'XML::Parser';

	sub new {
		my ($class, %args) = (@_, 'Style' => 'PYX', '_output' => sub { shift; });
		if ($args{Validating}) {
			require XML::Checker::Parser;
			@ISA = 'XML::Checker::Parser';
		}
		$class->SUPER::new(%args);
	}

	sub parse {
		my $self = shift;
		if ($XML::PYX::Lame) {
			return XML::PYX::parse($self->{_output}, @_);
		}
		return $self->SUPER::parse(@_);
	}
}

{
	package XML::PYX::Parser::ToCSF;
	use vars qw/@ISA/;

	use XML::Parser;

	@ISA = 'XML::Parser';

	sub new {
		my ($class, %args) = (@_, 'Style' => 'PYX', '_output' => sub { print shift; undef; });
		if ($args{Validating}) {
			require XML::Checker::Parser;
			@ISA = 'XML::Checker::Parser';
		}
		$class->SUPER::new(%args);
	}

	sub parse {
		my $self = shift;
		if ($XML::PYX::Lame) {
			return XML::PYX::parse($self->{_output}, @_);
		}
		return $self->SUPER::parse(@_);
	}
}

{
	package XML::Parser::PYX;

	use vars qw/$_PYX/;

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

	sub Final {
		return $_PYX;
	}

	sub Init {
		undef $_PYX;
	}

	sub Char {
		my ($e, $t) = @_;
		$_PYX .= $e->{_output}->("-" . XML::PYX::encode($t) . "\n");
	}

	sub Start {
		my ($e, $tag, @attr) = @_;
		$_PYX .= $e->{_output}->("($tag\n");

		while(@attr) {
			my ($key, $val) = (shift(@attr), shift(@attr));
			$_PYX .= $e->{_output}->("A$key " . XML::PYX::encode($val) . "\n");
		}

	}

	sub End {
		my ($e, $tag) = @_;
		$_PYX .= $e->{_output}->(")$tag\n");
	}

	sub Proc {
		my ($e, $target, $data) = @_;
		$_PYX .= $e->{_output}->("?$target " . XML::PYX::encode($data) . "\n");
	}
}

1;
__END__