kansuuji.pl

#!/usr/bin/perl
use utf8;
use strict;
use warnings;

use Encode;
use URI::Escape;
use File::Slurp;

my $q = ($ENV{QUERY_STRING})
    ? uri_unescape($ENV{QUERY_STRING})
    : shift;
$q =~ s/^n\=//;

my $file = './hoge.txt';

print "Content-type:text/plain\n\n";
print encode_utf8(num2kanji($q)."\n");

sub num2kanji_re {
    my $num = shift;
    my $kanji = num2kanji($num);

    my @hoge = read_file($file);
    push @hoge, encode_utf8($num.':'.$kanji."\n");
    write_file($file, @hoge);

    $kanji =~ tr/零一二三四五六七八九十百千万億兆/JALHDSYBGMFXPRTQ/;
    return $kanji;
}

sub num2kanji {
    my $num = shift;
    return '零' if ($num ==0);

    my $i = 1;
    my %kk = (
        '0' => '',
        '4' => '万',
        '8' => '億',
        '12' => '兆',
    );

    my $text = '';

    if (length($num) <= 4) {
        return unit2kanji($num);
    }

    my $rest = $num;
    my @bus = sort {$a <=> $b} keys %kk;
    for my $bu (@bus) {
        if (length($num) > $bu) {
            my $unit = substr $num, -($bu+4), 4;
            
            #warn $kk{$bu} . ', '.$unit;
            my $ukanji = unit2kanji($unit, $bu);
            if ($ukanji) {
                $text = $ukanji.$kk{$bu}.$text;
            }
        }
    }

    return $text;

}

sub unit2kanji {
    my $num = shift;
    my $bu = shift;

    my %k = (
        '0' => '',
        '1' => '十',
        '2' => '百',
        '3' => '千',
    );

    my $text = '';
    my $rest = $num;
    for my $u (sort {$b <=> $a} keys %k) {
        my $unit = $rest;
        $rest = $rest % (10**$u);
        $unit = ($unit - $rest) / (10**$u);
        
        if ($unit != 0) {
            $text .= unit2kansuuji($unit, $u, $bu).$k{$u};
        }
    }

    return $text;
}

sub unit2kansuuji {
    my $num = shift;
    my $unit = shift;
    my $bu = shift;
    if ($num == 1 && $unit != 0) {
        return '';
    }
    $num =~ tr/123456789/一二三四五六七八九/;
    return $num;
}