File Coverage

blib/lib/Tags/Output.pm

Criterion	Covered	Total	%
statement	149	155	96.1
branch	39	44	88.6
condition	9	12	75.0
subroutine	27	27	100.0
pod	7	7	100.0
total	231	245	94.2

package Tags::Output;

use strict;
use warnings;

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

our $VERSION = 0.16;

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

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

	# Get default parameters.
	$self->_default_parameters;

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

	# Check parameters to right values.
	$self->_check_params;

	# Initialization.
	$self->reset;

	# Object.
	return $self;
}

# Finalize Tags output.
sub finalize {
	my $self = shift;

	while (@{$self->{'printed_tags'}}) {
		$self->put(['e', $self->{'printed_tags'}->[0]]);
	}

	return;
}

# Flush tags in object.
sub flush {
	my ($self, $reset_flag) = @_;

	my $ouf = $self->{'output_handler'};
	my $ret;
	if (ref $self->{'flush_code'} eq 'ARRAY') {
		$ret = join $self->{'output_sep'}, @{$self->{'flush_code'}};
	} else {
		$ret = $self->{'flush_code'};
	}

	# Output callback.
	$self->_process_callback(\$ret, 'output_callback');

	if ($ouf) {
		no warnings;
		print {$ouf} $ret or err 'Cannot write to output handler.';
		undef $ret;
	}

	# Reset.
	if ($reset_flag) {
		$self->reset;
	}

	# Return string.
	return $ret;
}

# Return array of opened elements.
sub open_elements {
	my $self = shift;

	return @{$self->{'printed_tags'}};
}

# Deprecated.
sub open_tags {
	my $self = shift;

	warn "Method open_tags() is deprecated";

	return $self->open_elements;
}

# Put tags code.
sub put {
	my ($self, @data) = @_;

	# For every data.
	foreach my $tags_structure_ar (@data) {

		# Bad data.
		if (ref $tags_structure_ar ne 'ARRAY') {
			err 'Bad data.';
		}

		# Input 'Tags' item callback.
		if (defined $self->{'input_tags_item_callback'}) {
			$self->{'input_tags_item_callback'}->($tags_structure_ar)
		}

		# Split to type and main tags structure.
		my ($type, @tags_struct) = @{$tags_structure_ar};

		# Attributes.
		if ($type eq 'a') {
			$self->_check_arguments(\@tags_struct, 1, 2);
			$self->_put_attribute(@tags_struct);

		# Begin of tag.
		} elsif ($type eq 'b') {
			$self->_check_arguments(\@tags_struct, 1, 1);
			$self->_put_begin_of_tag(@tags_struct);

		# CData.
		} elsif ($type eq 'cd') {
			$self->_put_cdata(@tags_struct);

		# Comment.
		} elsif ($type eq 'c') {
			$self->_put_comment(@tags_struct);

		# Data.
		} elsif ($type eq 'd') {
			$self->_put_data(@tags_struct);

		# End of tag.
		} elsif ($type eq 'e') {
			$self->_check_arguments(\@tags_struct, 1, 1);
			$self->_put_end_of_tag(@tags_struct);

		# Instruction.
		} elsif ($type eq 'i') {
			if ($self->{'strict_instruction'}) {
				$self->_check_arguments(\@tags_struct, 1, 2);
			}
			$self->_put_instruction(@tags_struct);

		# Raw data.
		} elsif ($type eq 'r') {
			$self->_put_raw(@tags_struct);

		# Other.
		} else {
			if (! $self->{'skip_bad_tags'}) {
				err 'Bad type of data.';
			}
		}
	}

	# Auto-flush.
	if ($self->{'auto_flush'}) {
		$self->flush;
		$self->_reset_flush;
	}

	return;
}

# Reset.
sub reset {
	my $self = shift;

	# Flush code.
	$self->_reset_flush;

	# Printed tags.
	$self->{'printed_tags'} = [];

	return;
}

# Check arguments.
sub _check_arguments {
	my ($self, $tags_struct_ar, $min_arg_num, $max_arg_num) = @_;

	my $arg_num = scalar @{$tags_struct_ar};
	if ($arg_num < $min_arg_num || $arg_num > $max_arg_num) {
		err 'Bad number of arguments.',
			'\'Tags\' structure', join ', ', @{$tags_struct_ar};
	}

	return;
}

# Check parameters to rigth values.
sub _check_params {
	my $self = shift;

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

		err 'Output handler is bad file handler.';
	}

	# Check auto-flush only with output handler.
	if ($self->{'auto_flush'} && ! defined $self->{'output_handler'}) {
		err 'Auto-flush can\'t use without output handler.';
	}

	return;
}

# Default parameters.
sub _default_parameters {
	my $self = shift;

	# Auto-flush.
	$self->{'auto_flush'} = 0;

	# Input 'Tags' item callback.
	$self->{'input_tags_item_callback'} = undef;

	# Output callback.
	$self->{'output_callback'} = sub {
		my ($data_sr, $self) = @_;

		if (defined $self->{'output_encoding'}) {
			${$data_sr} = Encode::encode(
				$self->{'output_encoding'},
				${$data_sr},
			);
		}

		return;
	};

	# Output encoding.
	$self->{'output_encoding'} = undef;

	# Set output handler.
	$self->{'output_handler'} = undef;

	# Output separator.
	$self->{'output_sep'} = "\n";

	# Skip bad tags.
	$self->{'skip_bad_tags'} = 0;

	# Strict instruction.
	$self->{'strict_instruction'} = 1;

	return;
}

# Process dala callback.
sub _process_callback {
	my ($self, $data_r, $callback_type) = @_;

	# Process data callback.
	if (defined $self->{$callback_type}
		&& ref $self->{$callback_type} eq 'CODE') {

		$self->{$callback_type}->($data_r, $self);
	}

	return;
}

# Attributes.
sub _put_attribute {
	my ($self, $attr, $value) = @_;

	push @{$self->{'flush_code'}}, 'Attribute';

	return;
}

# Begin of tag.
sub _put_begin_of_tag {
	my ($self, $tag) = @_;

	push @{$self->{'flush_code'}}, 'Begin of tag';

	unshift @{$self->{'printed_tags'}}, $tag;

	return;
}

# CData.
sub _put_cdata {
	my ($self, @cdata) = @_;

	push @{$self->{'flush_code'}}, 'CData';

	return;
}

# Comment.
sub _put_comment {
	my ($self, @comments) = @_;

	push @{$self->{'flush_code'}}, 'Comment';

	return;
}

# Data.
sub _put_data {
	my ($self, @data) = @_;

	push @{$self->{'flush_code'}}, 'Data';

	return;
}

# End of tag.
sub _put_end_of_tag {
	my ($self, $tag) = @_;

	push @{$self->{'flush_code'}}, 'End of tag';

	shift @{$self->{'printed_tags'}};

	return;
}

# Instruction.
sub _put_instruction {
	my ($self, $target, $code) = @_;

	push @{$self->{'flush_code'}}, 'Instruction';

	return;
}

# Raw data.
sub _put_raw {
	my ($self, @raw_data) = @_;

	push @{$self->{'flush_code'}}, 'Raw data';

	return;
}

# Reset flush code.
sub _reset_flush {
	my $self = shift;

	$self->{'flush_code'} = [];

	return;
}

1;

__END__