File Coverage

blib/lib/Acme/Tategaki.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package Acme::Tategaki;
use 5.008005;
use strict;
use warnings;
use utf8;
use Array::Transpose::Ragged qw/transpose_ragged/;
use Encode qw/encode_utf8 decode_utf8/;
use Data::Dump qw/dump/;

use parent 'Exporter';
our @EXPORT = qw( tategaki tategaki_one_line);

our $VERSION = "0.12";

my @punc = qw(、 。 ， ．);

sub tategaki_one_line {
    my $text = shift;
    return _convert_vertical(($text));

}

sub tategaki {
    my $text = shift;
    $text =~ s/$_\s?/$_　/g for @punc;
    my @text = split /\s/, $text;
    return _convert_vertical(@text);
}

sub _convert_vertical {
    my @text = @_;
    @text = map { [ split //, $_ ] } @text;
    @text = transpose_ragged( \@text );
    @text = map { [ map {$_ || '　' } @$_ ] } @text;
    @text = map { join '　', reverse @$_ } @text;

    for (@text) {
        $_ =~ tr/／‥−－─ー「」→↑←↓＝=,、。〖〗【】…/＼：｜｜｜｜¬∟↓→↑←॥॥︐︑︒︗︘︗︘︙/;
        $_ =~ s/〜/∫ /g;
        $_ =~ s/『/ ┓/g;
        $_ =~ s/』/┗ /g;
        $_ =~ s/［/┌┐/g;
        $_ =~ s/］/└┘/g;
        $_ =~ s/\[/┌┐/g;
        $_ =~ s/\]/└┘/g;
        $_ =~ s/＜/∧ /g;
        $_ =~ s/＞/∨ /g;
        $_ =~ s/
        $_ =~ s/>/∨ /g;
        $_ =~ s/《/∧ /g;
        $_ =~ s/》/∨ /g;
    }
    # print dump @text;

    return join "\n", @text;
}

if ( __FILE__ eq $0 ) {
    print encode_utf8(tategaki decode_utf8 'お前は、すでに、死んでいる。'), "\n";
    print encode_utf8(tategaki_one_line decode_utf8 'お前は、すでに、死んでいる。');
}

1;

__END__