ちびたんくが往く

substrって部分文字列の取得だけだと思っていたのですが、置換もできるのですね。

% perl -wle '

    my ( $str, $search, $replace ) = ( shift, "123", "ZZ" );

    print "bf_replace=", $str;

    substr(

           $str,

           rindex( $str, $search ),

           length( $str )

    ) = $replace;

    print "af_replace=", $str;

' abcde123あいう45fg6789えお0xy1z23か123きくけこ123

bf_replace=abcde123あいう45fg6789えお0xy1z23か123きくけこ123

af_replace=abcde123あいう45fg6789えお0xy1z23か123きくけこZZ

hkobaさんのサポートのおかげで解決しました。ありがとうございました。
ShiftJISファイルの文字列ばらしがうまくいかなかったのは、改行コードの問題でした。
ということで、昨日の行き詰まりから先を追記しました。

■■■ターミナル（utf8）から読み込んだ文字列をばらす■■■

% perl -MEncode -e '

    binmode(STDOUT, ":utf8");

    my $str = <STDIN>;

    #my $str_u = decode("utf8", $str);

    my $str_u = decode_utf8($str);

    print join "-", split //, $str_u;

'

私のnameはhoeふがだ

私-の-n-a-m-e-は-h-o-e-ふ-が-だ-

% perl -MIO::All -MEncode -e '

    binmode(STDOUT, ":utf8");

    my @lines = io(shift)->slurp;

    for my $i (@lines) {

        my $str_s = decode("shiftjis", $i);

        print $str_s;

        print join "-", split //, $str_s;

    }

    #print join "n", Encode->encodings();

' work/perl/sjis.select

私のnameはhoeふがだ

--の-n-a-m-e-は-h-o-e-ふ-が-だ-

% perl -MIO::All -Mencoding=utf8 -MEncode -e '

    my $str = <STDIN>;

    (my $ans = $str) =~ s/x0D?x0A?$//;

    #(my $ans = $str) =~ tr/x0Dx0A//d;

    print $ans;

' | od -c

私のnameはhoeふがだ

% perl -MIO::All -Mencoding=utf8 -MEncode -e '

    for (io(shift)->slurp) {

        #(my $after = decode("shiftjis", $_)) =~ s/x0D?x0A?$/x0A/;

        #(my $after = decode("shiftjis", $_)) =~ tr/x0Dx0A/x0A/d;

        (my $after = decode("shiftjis", $_)) =~ s/rn/n/g;

        print join "-", split //, $after;

    }

' work/perl/sjis.select

私-の-n-a-m-e-は-h-o-e-ふ-が-だ-

Y-o-u-r- -n-a-m-e- -i-s- -ふ-ー-ば-ー-



% perl -MIO::All -Mencoding=utf8 -MEncode -e '

    sub conv {

        #(my $after = decode("shiftjis", shift)) =~ s/x0D?x0A?$/x0A/;

        #(my $after = decode("shiftjis", shift)) =~ tr/x0Dx0A/x0A/d;

        (my $after = decode("shiftjis", shift)) =~ s/rn/n/g;

        return $after;

    }

    print join "-", split //, conv $_ for io(shift)->slurp;

' work/perl/sjis.select

私-の-n-a-m-e-は-h-o-e-ふ-が-だ-

Y-o-u-r- -n-a-m-e- -i-s- -ふ-ー-ば-ー-

% perl -le '

    my ($a, $b, $c) = map { 10 * $_ } 1..3;

    print join "-",  $a, $b, $c;

    ($a, $b, $c) = (0) x 3;

    print join "-",  $a, $b, $c;

    ($a, $b, $c) = 0 x 3;

    print join "-",  $a, $b, $c;

'

■■■ 指定ディレクトリ下のファイルの中身を表示 ■■■

% perl -MIO::All -e '

    my $contents = io(shift)->all;

    print $contents;

' ./work/perl/study/sum.pl | nkf -w | less



% perl -MIO::All -MData::Dumper -e '

    my @lines = io(shift)->slurp;

    print $_ for @lines;

' ./work/perl/study/sum.pl | nkf -w | less



% perl -MIO::All -e '

    $_->type eq "file"

        and $_->filename =~ /.*.t$/

        and print "/_/_/_/_/_/ $_ /_/_/_/_/_/?n", $_->all

    for io(shift)->all(0);

' ./work/t | nkf -w | less

% perl -MIO::All -MPOSIX=strftime -MUser::grent -e '

    printf "%s %s %s %s?n"

        , $_->name

        , scalar getpwuid($_->uid)

        , $_->size

        , strftime("%Y-%m-%d %T", localtime($_->mtime))

    for sort { $b->mtime <=> $a->mtime } io(shift)->All_Files;

' ./other/mt

% cat > work/t/hoehoe.t

hoe



fuga

foo bar



% perl -MIO::All -e '

    io(shift)->[5] = "appendddd.";

' ~/work/t/hoehoe.t

perlのモジュールいじりしてたら、気づいた時には朝の5時だった。
List::Compareいじりにどんだけ時間かかっとるんじゃろ。
しかもベンチマーク取ってみた結果、あんま使えなそうだし。
ま、いっか。楽しかったから。
プログラミングしてると時間忘れちゃう。やっぱ好きなんだろかね。

■■■ 2つの文字列で共通する割合を返す ■■■

% perl -MString::Compare -le '

    my ( $a, $b, $c, $d ) = qw( Fug fuga fug ug );

    print join " ", map { compare( $a, $_ ) } $b, $c, $d;

'

■■■ 複数のリストから順に要素を取り出して1つにまとめる ■■■

% perl -MList::MoreUtils=mesh -le '

    my @a = qw| aaa bbb ccc ddd |;

    my @b = 1..5;

    my @c = q| xyz |;

    my @mesh = mesh @a, @b, @c;

    print "{", join ",", @mesh, "}";

'



% perl -MXXX=-dumper -MList::MoreUtils=mesh -le '

    my @item = qw| item-A item-B item-C item-D |;

    my @price = qw| 1500 980 10000 |;

    my %mesh = mesh @item, @price;

    XXX %mesh;

'

% perl -MXXX=-dumper -MList::MoreUtils=mesh -le '

    my @item = qw| item-A item-B item-C item-D item-E |;

    my @price = qw| 1500 980 10000 980 1500 |;

    my @priority = ( 4, 5, 1, 3, 2 );

    my @mesh = mesh @price, @priority;

    my %info = map { 

                                  my $i = $_ * 2;

                                  +$item[$_] => [ $mesh[$i], $mesh[++$i] ]

                       } 0..$#item;

    XXX sort {

                      ( $a->[0] <=> $b->[0] )

                  or ( $a->[1] <=> $b->[1] )

           } map { $info{$_} } keys %info;

'



% perl -MXXX=-dumper -MList::MoreUtils=mesh -le '

    my @item = qw| item-A item-B item-C item-D item-E |;

    my @price = qw| 1500 980 10000 980 1500 |;

    my @priority = ( 4, 5, 1, 3, 2 );

    my @mesh = mesh @price, @priority;

    my %info = map {

                                  my $i = $_ * 2;

                                  +$item[$_] => [ $mesh[$i], $mesh[++$i] ]

                       } 0..$#item;

    XXX sort {

                      ( $info{$a}->[0] <=> $info{$b}->[0] )

                  or ( $info{$a}->[1] <=> $info{$b}->[1] )

           } keys %info;

'

■■■ ある文字列とリストを比較して相違文字数を返す ■■■

% perl -MText::Levenshtein=distance -le '

    my @a = qw( fugako fug fuga uga );

    print join " ", distance( "fug-a", @a );

'