File Coverage

blib/lib/Text/Twiddler.pm

Criterion	Covered	Total	%
statement	83	112	74.1
branch	13	22	59.0
condition	3	9	33.3
subroutine	19	27	70.3
pod	10	10	100.0
total	128	180	71.1

package Text::Twiddler;

use warnings;
use strict;
use Carp;

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

use Class::Std;
use Class::Std::Utils;
use Locale::Maketext::Pseudo;
use List::Cycle;

{
    my %output_ns  :ATTR( :get :init_arg :default);
    my %iterations :ATTR( :get );
    my %longest    :ATTR( :get );
    my %start      :ATTR( :get     :init_arg     :default );
    my %text       :ATTR( :get      :init_arg      :default );
    my %end        :ATTR( :get       :init_arg       :default );
    my %lang       :ATTR(                 :init_arg  :default<> );
    my %sway       :ATTR(                 :init_arg      :default<0>);
    my %frames     :ATTR( :get );
    my %cycle;

    sub START {
        my ($self, $ident, $arg_ref) = @_;

        $lang{ $ident } = ref $arg_ref->{'lang_obj'} && $arg_ref->{'lang_obj'}->can('maketext')
            ? $arg_ref->{'lang_obj'} : Locale::Maketext::Pseudo->new();

        if( $arg_ref->{'output_ns'} ) {
            if( $arg_ref->{'output_ns'}->can('get_output_pre')
                && $arg_ref->{'output_ns'}->can('get_output_str')
                && $arg_ref->{'output_ns'}->can('get_output_pst')
            ) {
                $output_ns{ $ident } = $arg_ref->{'output_ns'};
            }
            else {
                carp $lang{ $ident }->maketext( q{'[_1]' does not have required '[_2]' method, defaulting to '[_3]'}, 'output_ns', 'get_output_*', $output_ns{ $ident } );
            }
        }

        {
            # just in case someone's turned on bytes...
            no bytes;
            $longest{ $ident } = length( $start{ $ident } ) >= length( $end{ $ident } ) ? length( $start{ $ident } ) : length( $end{ $ident } );

            my $twiddle_me_this = [];
            if ( ref $text{ $ident } eq 'ARRAY' ) {
                if ( @{ $text{ $ident } } > 1 ) {
                    @{ $twiddle_me_this } = @{ $text{ $ident } };
                    $text{ $ident } = [sort { length($b) <=> length($a) } @{ $twiddle_me_this } ]->[0]; # assign this the longest for length() calc below
                }
                else {
                    $text{ $ident } = $text{ $ident }->[0];
                }
            }

            $longest{ $ident }    = length( $text{ $ident } ) if length( $text{ $ident } ) > $longest{ $ident };
            $iterations{ $ident } = $longest{ $ident };

            if ( !@{ $twiddle_me_this } ) {
                $twiddle_me_this = Text::Twiddler::FX::standard($text{ $ident })
            }

            if ($sway{ $ident}) {
                push @{ $twiddle_me_this }, reverse @{ $twiddle_me_this } if $sway{ $ident };
                $iterations{ $ident } *= 2;
            }

            @{ $frames{ $ident } } = @{ $twiddle_me_this }; # copy array, do not assign same ref
            $cycle{ $ident }  = List::Cycle->new({ 'values' => $twiddle_me_this });
        }
    }

    sub get_start_twiddler {
        my ($self) = @_;
        $| = 1; # TODO: this more robust or localized
        return $self->get_output_pre() . $self->get_output_str( $self->get_start() );
    }

    sub get_next_twiddler {
        my ($self) = @_;
        return $self->get_output_str( $self->get_next_frame() );
    }

    sub get_next_frame {
        my ($self) = @_;
        return $cycle{ ident $self }->next();
    }

    sub get_end_twiddler {
        my ($self) = @_;
        return $self->get_output_str( $self->get_end() ) . $self->get_output_pst();
    }

    sub get_uniq_str {
        my ($self) = @_;
        return ref($self) . '-' . ident($self);
    }

    sub get_output_pre {
        my ($self) = @_;
        return $output_ns{ ident $self }->get_output_pre( $self );
    }

    sub get_output_str {
        my ($self, $string) = @_;
        return $output_ns{ ident $self }->get_output_str( $self, $string );
    }

    sub get_output_pst {
        my ($self) = @_;
        return $output_ns{ ident $self }->get_output_pst( $self );
    }

    sub get_blank_twiddler {
        my ($self) = @_;
        return $self->get_output_str('') . $self->get_output_pst();
    }
}

package Text::Twiddler::HTML;

sub get_output_pre {
    my ( $output_ns, $twid ) = @_;
    my $id = $twid->get_uniq_str();
    return qq{\n};
}

sub get_output_str {
    my ( $output_ns, $twid, $string ) = @_;
    my $id = $twid->get_uniq_str();

    require HTML::Entities;
    $string = HTML::Entities::encode( $string );

    return qq{document.getElementById("$id").innerHTML ="$string"\n};
}

sub get_output_pst {
    my ( $output_ns, $twid ) = @_;
    return ''; # no-op since in HTML since we always write to the same div
}

package Text::Twiddler::CLI;

sub get_output_pre {
    my ( $output_ns, $twid ) = @_;
    return '';
}

sub get_output_str {
    my ( $output_ns, $twid, $string ) = @_;
    my $len = $twid->get_longest();
    my $bs = '';

    if( $string ne $twid->get_start() ) {
        $bs     = "\b" x $len;
    }

    return  $bs . sprintf('%-' . $len .'s', $string);
}

sub get_output_pst {
    my ( $output_ns, $twid ) = @_;
    return "\n";
}

package Text::Twiddler::FX;

sub standard {
    my ($string) = @_;

    my @twiddle_me_this;
    my @letters = split '', $string;
    for my $lidx ( 0 .. $#letters ) {
        my $part = $letters[0];
        for my $nxt ( 1 .. $lidx ) {
            $part .= $letters[$nxt];
        }
        push @twiddle_me_this, $part;
    }

    return \@twiddle_me_this;
}

sub secret_decoder {
    my ($string) = @_;

    my @twiddle_me_this;
    my @letters = split '', $string;

    return \@twiddle_me_this;
}

1;

__END__