File Coverage

blib/lib/PYX/Parser.pm

Criterion	Covered	Total	%
statement	69	97	71.1
branch	24	40	60.0
condition	5	12	41.6
subroutine	11	13	84.6
pod	5	5	100.0
total	114	167	68.2

package PYX::Parser;

use strict;
use warnings;

use Class::Utils qw(set_params);
use Encode qw(decode);
use Error::Pure qw(err);
use Readonly;

# Constants.
Readonly::Scalar my $EMPTY_STR => q{};

our $VERSION = 0.07;

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

	# Parse callbacks.
	$self->{'callbacks'} = {
		'attribute' => undef,
		'comment' => undef,
		'data' => undef,
		'end_element' => undef,
		'final' => undef,
		'init' => undef,
		'instruction' => undef,
		'rewrite' => undef,
		'start_element' => undef,
		'other' => undef,
	},

	# Input encoding.
	$self->{'input_encoding'} = 'utf-8';

	# Non parser options.
	$self->{'non_parser_options'} = {};

	# Output rewrite.
	$self->{'output_rewrite'} = 0;

	# Output handler.
	$self->{'output_handler'} = \*STDOUT;

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

	# Check output handler.
	if (defined $self->{'output_handler'}
		&& ref $self->{'output_handler'} ne 'GLOB') {

		err 'Bad output handler.';
	}

	# Processing line.
	$self->{'_line'} = $EMPTY_STR;

	# Object.
	return $self;
}

# Get actual parsing line.
sub line {
	my $self = shift;
	return $self->{'_line'};
}

# Parse PYX text or array of PYX text.
sub parse {
	my ($self, $pyx, $out) = @_;
	if (! defined $out) {
		$out = $self->{'output_handler'};
	}

	# Input data.
	my @text;
	if (ref $pyx eq 'ARRAY') {
		@text = @{$pyx};
	} else {
		@text = split /\n/ms, $pyx;
	}

	# Parse.
	if ($self->{'callbacks'}->{'init'}) {
		&{$self->{'callbacks'}->{'init'}}($self);
	}
	foreach my $line (@text) {
		$self->_parse($line, $out);
	}
	if ($self->{'callbacks'}->{'final'}) {
		&{$self->{'callbacks'}->{'final'}}($self);
	}
	return;
}

# Parse file with PYX data.
sub parse_file {
	my ($self, $input_file, $out) = @_;
	open my $inf, '<', $input_file;
	$self->parse_handler($inf, $out);
	close $inf;
	return;
}

# Parse PYX handler.
sub parse_handler {
	my ($self, $input_file_handler, $out) = @_;
	if (! $input_file_handler || ref $input_file_handler ne 'GLOB') {
		err 'No input handler.';
	}
	if (! defined $out) {
		$out = $self->{'output_handler'};
	}
	if ($self->{'callbacks'}->{'init'}) {
		&{$self->{'callbacks'}->{'init'}}($self);
	}
	while (my $line = <$input_file_handler>) {
		chomp $line;
		$self->_parse($line, $out);
	}
	if ($self->{'callbacks'}->{'final'}) {
		&{$self->{'callbacks'}->{'final'}}($self);
	}
	return;
}

# Parse text string.
sub _parse {
	my ($self, $line, $out) = @_;
	$line = decode($self->{'input_encoding'}, $line);
	$self->{'_line'} = $line;
	my ($type, $value) = $line =~ m/\A([A()\?\-_])(.*)\Z/;
	if (! $type) {
		$type = 'X';
	}

	# Attribute.
	if ($type eq 'A') {
		my ($att, $attval) = $line =~ m/\AA([^\s]+)\s*(.*)\Z/;
		$self->_is_sub('attribute', $out, $att, $attval);

	# Start of element.
	} elsif ($type eq '(') {
		$self->_is_sub('start_element', $out, $value);

	# End of element.
	} elsif ($type eq ')') {
		$self->_is_sub('end_element', $out, $value);

	# Data.
	} elsif ($type eq '-') {
		$self->_is_sub('data', $out, $value);

	# Instruction.
	} elsif ($type eq '?') {
		my ($target, $data) = $line =~ m/\A\?([^\s]+)\s*(.*)\Z/;
		$self->_is_sub('instruction', $out, $target, $data);

	# Comment.
	} elsif ($type eq '_') {
		$self->_is_sub('comment', $out, $value);

	# Others.
	} else {
		if ($self->{'callbacks'}->{'other'}) {
			&{$self->{'callbacks'}->{'other'}}($self, $line);
		} else {
			err "Bad PYX line '$line'.";
		}
	}
	return;
}

# Helper to defined callbacks.
sub _is_sub {
	my ($self, $key, $out, @values) = @_;

	# Callback with name '$key'.
	if (exists $self->{'callbacks'}->{$key}
		&& ref $self->{'callbacks'}->{$key} eq 'CODE') {

		&{$self->{'callbacks'}->{$key}}($self, @values);

	# Rewrite callback.
	} elsif (exists $self->{'callbacks'}->{'rewrite'}
		&& ref $self->{'callbacks'}->{'rewrite'} eq 'CODE') {

		&{$self->{'callbacks'}->{'rewrite'}}($self, $self->{'_line'});

	# Raw output to output file handler.
	} elsif ($self->{'output_rewrite'}) {
		print {$out} $self->{'_line'}, "\n";
	}
	return;
}

1;

__END__