view release on metacpan or  search on metacpan

t/00-tsvstream.t  view on Meta::CPAN

### 00-tsvstream.t #############################################################################
# Basic tests for tsvstream objects

### Includes ######################################################################################

# Safe Perl
use warnings;
use strict;

use Carp;
use File::Temp;
use FindBin qw($Bin);
use lib "$Bin/../lib";

use Test::More tests => 10;
use Test::Exception;

### Tests #################################################################################

package TestFooBar;

use Moose;
use namespace::autoclean;
use MooseX::ClassAttribute;

class_has '_fields' => (is => 'ro', isa => 'ArrayRef', default => sub { [ qw(foo bar) ] } );

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

has 'foo'    => ( is => 'rw', isa => 'Str' );
has 'bar'    => ( is => 'rw', isa => 'Str' );

__PACKAGE__->meta->make_immutable;

package main;

sub _open_reader {
	my $testname = shift;
	my $args     = shift;
	my $reader;
	subtest "$testname - create reader" => sub {
		plan tests => 2;
		lives_ok { $reader = TestFooBar->reader(@$args) } "can create a stream reader ($testname - create reader)";
		isa_ok( $reader, 'BoutrosLab::TSVStream::IO::Reader::Fixed', "... it is a reader object ($testname - create reader)" );
		};
	return $reader;
	}

sub _open_writer {
	my $testname = shift;
	my $args     = shift;
	my $writer;
	subtest "$testname - create writer" => sub {
		plan tests => 2;
		lives_ok { $writer = TestFooBar->writer(@$args) } "can create a stream writer ($testname - create writer)";
		isa_ok( $writer, 'BoutrosLab::TSVStream::IO::Writer::Fixed', "... it is a writer object ($testname - create writer)" );
		};
	return $writer;
	}

sub _scan_stream {
	my $testname = shift;
	my $reader   = shift;
	my $writer   = shift;
	subtest "$testname - scan data" => sub {
		plan tests => $writer ? 17 : 12;
		my $count = 1;
		my $foobar;
		while ( lives_ok { $foobar = $reader->read } "read record($count) ($testname - scan data" ) {
			last unless defined $foobar;
			isa_ok( $foobar, 'TestFooBar', "... it is a TestFooBar ($testname - scan data" );
			for my $field (qw(foo bar)) {
				is( $foobar->$field, "$field$count",
					" ...     with the correct $field field value ($testname - scan data" );
				}
			lives_ok { $writer->write_comments( $reader->read_comments ) } "...    and its comments can be written ($testname - scan data" if $writer;
			lives_ok { $writer->write( $foobar ) } "...    and its fields can be written ($testname - scan data" if $writer;
			}
		continue { ++$count }

		is( $foobar, undef, "... got undef for EOF ($testname - scan data" );
		is( $count,  3,     "... ... at expected time ($testname - scan data" );
		lives_ok { $writer->write_comments( $reader->read_comments ) } "... trailing comments can be written ($testname - scan data" if $writer;
		lives_ok { undef $reader } "delete reader ($testname - scan data";
		};
	}