view release on metacpan or  search on metacpan

lib/BoutrosLab/TSVStream/IO/Role/Writer/Fixed.pm  view on Meta::CPAN

package BoutrosLab::TSVStream::IO::Role::Writer::Fixed;

# safe Perl
use warnings;
use strict;
use Carp;

use BoutrosLab::TSVStream::IO::Role::Base::Fixed;

=head1 NAME

    BoutrosLab::TSVStream:Writer

=cut

use Moose::Role;
use Moose::Util::TypeConstraints;
use namespace::autoclean;
use List::MoreUtils qw(all zip);
use Try::Tiny;

with 'BoutrosLab::TSVStream::IO::Role::Base::Fixed';

has append => ( is => 'ro', lazy => 1, isa => 'Bool', default => '0' );

enum 'WriteHeaderType', [qw(write skip)];

has header => (
	is      => 'ro',
	lazy    => 1,
	isa     => 'WriteHeaderType',
	default => sub { my $self = shift; $self->append ? 'skip' : 'write' }
	);

has pre_headers => (
	is      => 'ro',
	isa     => 'ArrayRef[Str]',
	default => sub { [] }
	);

has extra_class_params => (
	is      => 'ro',
	isa     => 'ArrayRef[Str]',
	default => sub { [] }
	);

around BUILDARGS => sub {
	my $orig  = shift;
	my $class = shift;
	my $arg   = ref($_[0]) ? $_[0] : { @_ };

	my %valid_arg = (
		file               => 1,
		handle             => 1,
		header             => 1,
		class              => 1,
		comment            => 1,
		pre_comment        => 1,
		pre_header         => 1,
		header_fix         => 1,
		extra_class_params => 1,

		pre_headers        => 1,
		append             => 1,
		dyn_fields         => 1
		);
	$arg->{_valid_arg} = \%valid_arg;
	$arg->{_open_mode} = $arg->{append} ? '>>' : '>';
	$class->$orig( $arg );
	};

sub _list_headers {
	my $self = shift;
	return ( $self->fields );
	}

sub BUILD {
	my $self = shift;
	$self->_write_lines( $self->pre_headers ) if $self->pre_header;
	if ($self->header eq 'write') {