File Coverage

blib/lib/SGML/PYX.pm

Criterion	Covered	Total	%
statement	78	79	98.7
branch	23	24	95.8
condition	6	6	100.0
subroutine	12	12	100.0
pod	2	2	100.0
total	121	123	98.3

package SGML::PYX;

use strict;
use warnings;

use Class::Utils qw(set_params);
use Encode qw(encode_utf8);
use Error::Pure qw(err);
use Tag::Reader::Perl;
use PYX qw(comment end_element char instruction start_element);
use PYX::Utils qw(decode entity_decode);

our $VERSION = 0.05;

# Constructor.
sub new {
	my ($class, @params) = @_;

	# Create object.
	my $self = bless {}, $class;

	# Output callback.
	$self->{'output'} = sub {
		my (@data) = @_;

		print join "\n", map { encode_utf8($_) } @data;
		print "\n";

		return;
	};

	# Process params.
	set_params($self, @params);

	# Object.
	$self->{'_tag_reader'} = Tag::Reader::Perl->new;

	# Object.
	return $self;
}

# Parse file.
sub parsefile {
	my ($self, $sgml_file) = @_;

	# Set file.
	$self->{'_tag_reader'}->set_file($sgml_file);

	# Process.
	while (my ($data, $tag_type, $line, $column)
		= $self->{'_tag_reader'}->gettoken) {

		# Data.
		if ($tag_type eq '!data') {
			$self->{'output'}->(char(decode(entity_decode($data))));

		# Comment.
		} elsif ($tag_type eq '!--') {
			$data =~ s/^$//ms;
			$self->{'output'}->(comment($data));

		# End of element.
		} elsif ($tag_type =~ m/^\//ms) {
			my $element = $data;
			$element =~ s/^<\///ms;
			$element =~ s/>$//ms;
			$self->{'output'}->(end_element($element));

		# Begin of element.
		} elsif ($tag_type =~ m/^\w+/ms) {
			$data =~ s/^
			$data =~ s/>$//ms;
			my $end = 0;
			if ($data =~ s/\/$//ms) {
				$end = 1;
			}
			(my $element, $data) = ($data =~ m/^([^\s]+)\s*(.*?)$/ms);
			my @attrs = $self->_parse_attributes($data);
			$self->{'output'}->(start_element($element, @attrs));
			if ($end) {
				$self->{'output'}->(end_element($element));
			}

		# Doctype.
		} elsif ($tag_type eq '!doctype') {
			# Nop.

		# CData.
		} elsif ($tag_type eq '![cdata[') {
			$data =~ s/^
			$data =~ s/\]\]>$//ms;
			$self->{'output'}->(char(decode(entity_decode($data))));

		# Instruction.
		} elsif ($tag_type =~ m/^\?/ms) {
			$data =~ s/^<\?//ms;
			$data =~ s/\s*\?>$//ms;
			my ($target, $code) = split m/\s+/ms, $data, 2;
			$self->{'output'}->(instruction($target, $code));

		} else {
			err "Unsupported tag type '$tag_type'.";
		}
	}

	return;
}

# Parse attributes.
sub _parse_attributes {
	my ($self, $data) = @_;

	my $original_data = $data;
	my @attrs;
	while ($data) {

		#  or
		if ($data =~ m/^([_\w:][\.\-\w:]*)\s*=\s*"(.*?)"\s*(.*?)$/ms

			#  or
			|| $data =~ m/^([_\w:][\.\-\w:]*)\s*=\s*'(.*?)'\s*(.*?)$/ms

			#  or .
			|| $data =~ m/^([_\w:][\.\-\w:]*)\s*=\s*([^\s]+)\s*(.*?)$/ms) {

			push @attrs, $1, $2;
			$data = $3;

		#
		} elsif ($data =~ m/^([_\w:][\.\-\w:]*)\s*=\s*$/ms) {
			push @attrs, $1, '';
			$data = '';

		#
		} elsif ($data =~ m/^([_\w:][\.\-\w:]*)\s*(.*?)$/ms) {
			push @attrs, $1, $1;
			$data = $2;
		} else {
			err 'Problem with attribute parsing.',
				'data', $original_data;
		}
	}

	return (@attrs);
}

1;

__END__