File Coverage

blib/lib/Text/Cloze.pm

Criterion	Covered	Total	%
statement	45	45	100.0
branch	13	14	92.8
condition	2	3	66.6
subroutine	10	10	100.0
pod	4	4	100.0
total	74	76	97.3

package Text::Cloze;

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv('0.0.1');

use List::Util qw/shuffle/;

my %default = (
    hint => 'blank',
    max => 0,
    regex => '\\S+',
    start => 1,
    stop => 1,
    word => 5,
);

sub new {
    my ($class, %args) = @_;
    $args{start} = $args{stop} = delete $args{sentence} if $args{sentence};
    $args{$_} ||= $default{$_} for keys %default;
    bless sub {
        my ( $pre, $change, $post ) = change( shift , @args{qw/start stop/} );
        my $n = 0;
        my @removed = ();
        $change =~ s{$args{regex}}
                    {++$n % $args{word} ? $& : replace( $removed[@removed] = $&, $args{hint} )}eg;
        s/^\W+//, s/\W+$//, $_ = ucfirst for @removed;
        return ( @removed, $pre.$change.$post );
    }, $class;
}

sub change {
    my ( $text, $start, $stop ) = @_;
    my ( $pre, $change, $post ) = ('') x 3;
    my @sentences = sentences_from( $text );
    for ( my $i = 0; $i < @sentences; $i++ ) {
        $pre .= $sentences[$i], next if $i < $start;
        $post .= $sentences[$i], next if $i >= @sentences - $stop;
        $change .= $sentences[$i];
    }
    return ( $pre, $change, $post );
}

sub sentences_from {
    local $_ = shift;
    return m/
        [(`'"]*             # Beginning punctuation

        .+?                 # Sentence words

        (?:
            # End of sentence
            [.?!] [)`'"]*

            (?:
                # slurp rest of whitespace at end of string...
                (?: \s* \Z )
                | # or look ahead to make sure another sentence occurs
                (?= \s+ [(`'"]* [A-Z] )
            )
            | \Z
        )
    /xmsg;

}

sub replace {
    my ( $word, $hint ) = @_;
    my ( $punct_begin, $punct_end, $return ) = ('') x 3;
    $punct_begin .= $_, $word =~ s/^\W+// for $word =~ m/^\W+/g;
    $punct_end   .= $_, $word =~ s/\W+$// for $word =~ m/\W+$/g;
    $return .= '_' x 15 if $hint =~ /blank/;
    $return  = $punct_begin.$return;
    $return .= '('.( length $word ).')' if $hint =~ /count/;
    $return .= '('.( join '', shuffle(split '', $word) ).')' if $hint =~ /scramble/;
    $return .= $punct_end;
}

1; # Magic true value required at end of module
__END__