use IO::Handle;
use utf8;
use Encode;
STDOUT->autoflush(1);
STDERR->autoflush(1);
binmode(STDOUT, ":encoding(gbk)");

our @unit_f = ("", "角");            #分省略，最后补上
our @part = ("", "萬", "亿");        #元省略，最后补上
our @unit = ("", "拾", "佰", "仟");  #同上
our @cnum = qw/零 壹 贰 叁 肆 伍 陆 柒 捌 玖 拾/;

foreach (
    1.01, 
    900000000, 
    0.0,
    7.2,
    12300100.12, 
    101010101
) {
    printf &main($_) . "\n";
}
<STDIN>;

sub main {
    my $inp = shift;
    my ($str, $sect) = ("", "");
    my ($ni, $nf, $i) = ("", "", undef);

    return "零元" if ($inp == 0);

    #整数部分和小数部分
    ($ni, $nf) = split(/\./, sprintf("%.2f", $inp));

    #处理整数部分
    $i = 0;
    while ($ni ne "") {
        $ni=~s/(\d{0,4})$//;       #每四位数为一段进行截取
        $sect = &func($1, \@unit);
                                   # 如果某段大写返回为空（0000），则缩略
                                   # 例如壹亿，而不是壹亿萬
        if ($sect ne "") {
            $str = $sect . $part[$i] . $str;       
        }
        $i++;
    }
    $str .="元" if ($str ne "");

    #处理角和分
    $sect = &func($nf, \@unit_f);
    if ($sect ne "") {
        $str = $str . $sect;
        $str = $str ."分" unless ($sect=~/角$/);
    }

    return $str;
}

sub func {
    our @cnum;
    my ($num, $unit) = (shift, shift);
    my @ints = reverse( split("", $num) );  #反转成 (个,十,佰,仟)
    my $prev = 1;
    my $begin = 0;
    my $i;
    my $str = "";

    #略过低位连续出现的零
    #例如，一百零拾零元简写为：一百元
    while ( 
        defined $ints[$begin]
            and
        $ints[$begin] == 0 
    ) {
        $begin++;
    }

    foreach $i ($begin .. $#ints) {
        if ( 
            $ints[$i] == 0
        ) {
            if ($prev != 0) {
                $str = $cnum[$ints[$i]] . $str;   #零
                $prev = 0;
            }
            next;
        }
        $prev = $ints[$i];
        $str = $cnum[$ints[$i]] . $unit->[$i] . $str;
    }
    return $str;
}
复制代码