File Coverage

blib/lib/Lingua/Poetry/Haiku/Finder.pm

Criterion	Covered	Total	%
statement	76	79	96.2
branch	10	12	83.3
condition	2	2	100.0
subroutine	15	16	93.7
pod	3	3	100.0
total	106	112	94.6

use 5.012;
use strict;
use warnings;

package Lingua::Poetry::Haiku::Finder;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.002';

use Moo;
use Types::Standard -types;
use List::Util 'sum0';
use Lingua::Sentence;
use namespace::autoclean;

use Lingua::Poetry::Haiku::Finder::Sentence;

my @LINE_LENGTHS = ( 5, 7, 5 );
my $HAIKU_LENGTH = sum0 @LINE_LENGTHS;

has text => (
	is        => 'ro',
	isa       => Str,
	required  => !!1,
);

has sentences => (
	is        => 'lazy',
	isa       => ArrayRef[ InstanceOf[ __PACKAGE__ . '::Sentence' ] ],
	init_arg  => undef,
);

has haikus => (
	is        => 'lazy',
	isa       => ArrayRef[ Str ],
	init_arg  => undef,
);

has _splitter => (
	is        => 'lazy',
	isa       => Object,
	builder   => sub { 'Lingua::Sentence'->new("en") },
	handles   => {
		'_split_array' => 'split_array',
	},
);

{
	my $class = __PACKAGE__ . '::Sentence';

	sub _build_sentences {
		my ( $self ) = ( shift );

		my $text = $self->text;
		$text =~ s/\s+/ /sg;
		$text =~ s/^\s+//s;
		$text =~ s/\s+$//s;

		return [
			map $class->new( text => $_ ), $self->_split_array( $text )
		];
	}
}

sub _format_haiku {
	my ( $self, $sentences ) = ( shift, @_ );
	my @parts = map {
		my $end = ( __PACKAGE__ . '::NonWord' )->new( text => ' ' );
		@{ $_->parts }, $end;
	} @{ $sentences };

	my @lines;
	my $current_line = 0;

	while ( @parts ) {
		my $part = shift @parts;
		if ( $part->is_word ) {
			my $current_line_length = sum0 map $_->syllables, @{ $lines[$current_line] || [] };
			if ( $current_line_length >= $LINE_LENGTHS[$current_line] ) {
				++$current_line;
			}
		}
		push @{ $lines[$current_line] ||= [] }, $part;
	}

	return join "\n", map {
		my @line = @$_;
		my $text = join "", map $_->text, @line;
		$text =~ s/\s+/ /sg;
		$text =~ s/^\s+//s;
		$text =~ s/\s+$//s;
		$text;
	} @lines;
}

sub _build_haikus {
	my ( $self ) = ( shift );

	my @sentences = @{ $self->sentences };
	my @found;
	STARTER: for my $start_index ( 0 .. $#sentences ) {
		ENDER: for my $end_index ( $start_index .. $#sentences ) {
			my @slice = @sentences[ $start_index .. $end_index ];
			my $slice_syllables = sum0 map $_->syllables, @slice;

			if ( $slice_syllables == $HAIKU_LENGTH ) {
				push @found, $self->_format_haiku( \@slice );
			}
			elsif ( $slice_syllables > $HAIKU_LENGTH ) {
				next STARTER;
			}
		}
	}

	return \@found;
}

sub from_text {
	my ( $class, $text ) = ( shift, @_ );
	return $class->new( text => $text );
}

sub from_filehandle {
	my ( $class, $fh ) = ( shift, @_ );
	my $text = do { local $/; <$fh> };
	return $class->from_text( $text );
}

sub from_filename {
	my ( $class, $filename ) = ( shift, @_ );
	open my $fh, '<', $filename or die "Cannot open $filename: $!";
	return $class->from_filehandle( $fh );
}

1;

__END__