view release on metacpan or  search on metacpan

lib/Text/Sprintf/Zenkaku.pm  view on Meta::CPAN

package Text::Sprintf::Zenkaku;
use 5.008001;
use strict;
use warnings;
use utf8;
use Carp;
use Encode;

our $VERSION = "0.09";

use Exporter 'import';
our @EXPORT_OK = qw(sprintf);

our $cp932 = Encode::find_encoding("cp932");

our $conversions = qr/\A[cduoxefgXEGbBpnaA]\Z/;
$conversions = qr/\A[cduoxefgXEGbBpn]\Z/ if $] lt 5.022000;
$conversions = qr/\A[cduoxefgXEGbpn]\Z/ if $] lt 5.010000;

sub calc_width {
    my ($w, $s) = @_;

    my $ofs;
    if ($w >= 0) {
        $ofs = $w - ((length $cp932->encode($s)) - (length $s));
    } else {
        $ofs = (abs $w) - ((length $cp932->encode($s)) - (length $s));
        $ofs *= -1;
    }

    return $ofs;
}

sub sprintf {
    my @argv = @_;
    my $fmt  = defined $argv[0] ? $argv[0] : "";

    my $ofs   = 0;
    my $state = "IDL";

    my $index   = 1;
    my $tmp     = "";
    my $fmt_new = "";
    my $length  = length $fmt;
    my $is_uniq = {};

    while ($ofs < $length) {
        my $s = substr $fmt, $ofs, 1;
        if ($state eq "IDL") {
            if ($s eq "%") {
                $tmp   = $s;
                $state = "READ_FORMAT";
            } else {
                $fmt_new .= $s;
            }
        } elsif ($state eq "READ_FORMAT") {
            if ($s eq "%") {
                # 'a percent sign' literal
                $fmt_new .= $tmp . $s;
                $tmp = "";
                $state = "IDL";

            } elsif ($s eq "s") {
                # %s
                $tmp .= $s;

                if ($tmp =~ /^%([1-9][0-9]*)\$( *)\*([1-9][0-9]*)\$s$/) {
                    my $s_index = int $1;
                    my $space   = $2;
                    my $w_index = int $3;

                    my $s = $_[$s_index];
                    my $w = $_[$w_index];

                    my $width = calc_width($w, $s);
                    if (not exists $is_uniq->{$w_index}) {
                        $argv[$w_index] = $width;
                        $is_uniq->{$w_index}++;