「良いコード／悪いコードで学ぶ設計入門」第3章の前半 #ミノ駆動本
リスト3.1 金額を表すクラス
前回に続いてやっていきます。
そして早速なやむ。
インスタンス変数しか持っていない、典型的なデータクラスです。
Java でいうところのインスタンス変数ってのは、Perl のオブジェクトでいうところのプロパティですかね？
そういう理解でいきます。
というか、このプロパティというのが、本や言語によって「アトリビュート（属性）」とか「フィールド」とか「フィールド変数」っだったりで、似た概念のように思えるのに言葉が違って本当に混乱しましたね。バベルの塔の寓話か。
ここでは、インスタンス化しただけでは利用できない「生焼けオブジェクト」を作ってみます。
こんな感じ？
まぁ、こういうオブジェクトは作らんよね・・・いや、過去に作ってたかも・・・
あ、先のエントリに id:xtetsuji さんがコメント寄せてくれたように、Perl 5.14 からは package foo { } みたいに囲むことできるので、より Java っぽい見た目に近づけますね！
#!/usr/bin/env perl use strict; use warnings; package Money { sub new { my $class = shift; my $self = bless { amount => undef, currency => undef, }, $class; return $self; } } package main; # インスタンス化だけで使おうとしてエラー（当然） my $money = Money->new(); print $money->{amount}; # Use of uninitialized value in print at ... $money->{amount} = 100; print $money->{amount}; # 100
リスト3.2 必ずコンストラクタで初期化する
まずは素直に bless で。
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; package Money { sub new { my $class = shift; my ( $amount, $currency ) = @_; my $self = bless { amount => $amount, currency => $currency, }, $class; return $self; } } package main; my $money = Money->new( 100, 'yen' ); say $money->{amount}; # 100 say $money->{currency}; # yen
xtetsuji さんといえば、Perl の実験的機能を集めたこの記事（と正規表現）。
せっかくなので、Perlの実験的機能である signatures 使ってみます。
前回使った Function::Parameters と違って（実験的機能とはいえ）オフィシャルってのが良いですね。
Function::Parameters みたいにハッシュとかハッシュリファレンス的に渡せるとなお良いんですが・・・いや、そんなの絶対にあるに決まってる。
と思って探すと出てくるんですよね。
www.effectiveperlprogramming.com
仮引数のところでハッシュの %hash で受ければ良いだけでした。納得〜
#!/usr/bin/env perl use strict; use warnings; use v5.034.0; use feature qw/say signatures/; no warnings "experimental::signatures"; package Money { sub new ( $class, %hash ) { my $self = bless \%hash, $class; return $self; } } package main; my $money = Money->new( amount => 100, currency => 'yen' ); say $money->{amount}; # 100 say $money->{currency}; # yen
こうやって、横道に逸れながら学ぶのも良いですね。
本のページ的には 2p ほどしか進んでないですが・・・
リスト3.3
ここまでは単に値をセットしただけなので、-100 円や null などの値を渡せてしまう・・・というところから始まります。
そこで、
- 金額 amount：0以上の整数
- 通過 currency：null以外
というレギュレーションを守るオブジェクトを作ろう、というのが次。
リスト3.4 コンストラクタで正常値のみが確実に設定される仕組み
普通に書くとこんな感じかな
#!/usr/bin/env perl use strict; use warnings; package Money { sub new { my $class = shift; my $hash_ref = shift; if ( $hash_ref->{amount} < 0 ) { die "金額が0以上でありません。"; } if ( $hash_ref->{currency} == "" ) { die "通貨を指定してください。"; } my $self = bless $hash_ref, $class; return $self; } } package main; my $money = Money->new( { amount => 100, currency => '' } ); # 通貨を指定してください。
で、次は Mouse で。
#!/usr/bin/env perl use strict; use warnings; package Money { use Mouse; use Carp qw/croak/; has amount => ( is => 'rw', isa => 'Int', trigger => sub { croak "金額が0以上でありません。" if ( $_[0]->amount < 0 ); }, ); has currency => ( is => 'rw', isa => 'Str', trigger => sub { croak "通貨を指定してください" if ( $_[0]->currency eq "" ); } ); __PACKAGE__->meta->make_immutable(); } package main; my $money = Money->new( amount => 100, currency => '' ); # 通貨を指定してください
コンストラクタが値を設定する前に、処理の対象外となる条件を弾くガード節を置く。
うむうむ。
リスト3.5 Moneyクラスに金額加算メソッドを用意する
add サブルーチンは signatures で書いてみました。
で、なるほど、金額を加算した結果を同じamountプロパティに入れるのがよくないと。
いろんなメソッドで値が変わりまくると、それを追跡するのが大変そうだよね。
#!/usr/bin/env perl use strict; use warnings; package Money { use Mouse; use Carp qw/croak/; use feature qw/signatures/; no warnings "experimental::signatures"; has amount => ( is => 'rw', isa => 'Int', trigger => sub { croak "金額が0以上でありません。" if ( $_[0]->amount < 0 ); }, ); has currency => ( is => 'rw', isa => 'Str', trigger => sub { croak "通貨を指定してください" if ( $_[0]->currency eq "" ); } ); sub add ( $self, $other ) { my $new_amount = $self->amount + $other; $self->amount($new_amount); } __PACKAGE__->meta->make_immutable(); } package main; my $money = Money->new( amount => 500, currency => 'yen' ); $money->add(100); print $money->amount;
リスト3.7 final で普遍にする
Java の final をインスタンス変数に使うと、不変（イミュータブル）にできると。
Perl だったら Mouse の属性のところを rw（read write） から ro （read only）にしておけば良いかな。
プロパティの値を不変にしておくことで、（これから実装する）メソッドが値を書き換えたときに、どんな状態になっているか分からない・・・ということを避けることができる、と。
書き換えできないからね。
なるほどねー。
当然、そうなると先に実装した add メソッドはエラーになる。
amount は read only なプロパティなのに値を変えようとするから。
リスト3.9 変更値を持ったMoneyクラスのインスタンスを生成する
サンプルコードのJavaではaddメソッドの中で直接currencyを使えてる。
class Money { // 省略 Money add (int other){ int added = amount + other; return new Moner(added, currency); } }
けど、Perlではプロパティ値をそのまま持ってく方法がわからんかったので愚直に。
#!/usr/bin/env perl use strict; use warnings; package Money { use Mouse; use Carp qw/croak/; use feature qw/signatures/; no warnings "experimental::signatures"; has amount => ( is => 'ro', isa => 'Int', trigger => sub { croak "金額が0以上でありません。" if ( $_[0]->amount < 0 ); }, ); has currency => ( is => 'rw', isa => 'Str', trigger => sub { croak "通貨を指定してください" if ( $_[0]->currency eq "" ); } ); # amount値を更新したオブジェクトを生成して返す。 sub add ( $self, $other ) { my $new_amount = $self->amount + $other; # 愚直に return Money->new( amount => $new_amount, currency => $self->currency, ); } __PACKAGE__->meta->make_immutable(); } package main; my $money = Money->new( amount => 500, currency => 'yen' ); my $added_money = $money->add(100); print $money->amount . "\n"; # 500 print $added_money->amount . "\n"; # 600
リスト3.10 メソッド引数やローカル変数にもfinalを付け不変にする
え・・・そこまでは考えたことなかったわ。
void doSomething(final int value){ value = 100; // コンパイルエラー }
えっと、Perlではどうやればいい？
use constant は定数宣言だから最初だけだし。
型を提供するモジュールを使って、仮引数の時点で型チェックすることはできるけど（Function::Parameters + Type::Tiny）、書き換え不可にする、読み込みのみにするモジュール・・・あったわ。
まんま、Readonly モジュール。
add メソッドを書き換えます
# 抜粋 # amount値を更新したオブジェクトを生成して返す。 sub add ( $self, $other ) { Readonly my $freeze_other => $other; # 再代入不可の変数を作る my $new_amount = $self->amount + $freeze_other; return Money->new( amount => $new_amount, currency => $self->currency, ); }
いやー、関数の引数まで不変にするとか全然考えたことなかったわ。
でもまぁ、JavaScriptの関数とかは仮引数も含めてほぼ全部const（再代入できない変数宣言）使ってるから、むしろそれが自然か。
おもしろいなー！
ということで今日はここまで。
「良いコード／悪いコードで学ぶ設計入門」を読み始めた
巷で話題の本（2022年春現在）
DMM Books が 30% ポイント還元をやっていたので、他の本と一緒に購入しました。
なんで読もうと思ったか
自分のコードが良いコードではない、という漠然とした不安がありました。
また自分の書いたコードも保守性が低く、これなら書き直したほうが早い・・・となるならマシなほうで、読むのも書き直すの面倒だからやりたくない、とか。
・・・それって良いコード書けていないよね。
そういう状態を脱却する一助になるのではと思いました。
良い「型」を身につけたいです。
時間かけて読む
で、読み進めていくと・・・これはあかん、と。
サンプルコードはJavaで書かれているんですが、変数名やメソッド名はちゃんと意味が通じる名称なので読みやすいです。
読みやすくて、すいすいと読み進めてしまいます。
これはよくない。
よくない読み方をしている。
読みやすいが故に、読み飛ばして栄養素を十分に摂取できない気がしました。
ということで、ちゃんと写経します。
時間はかかるけど、まぁ読んだ冊数を競っているわけではないし。
Javaはわからんし、環境構築の手間も惜しいのでいつものPerlでやります。
リスト2.1 一体何のロジックだろう？
これがダメな理由はわかります。
- 不明瞭な変数名
- 変数への再代入
こういうコードは書いてない（はず）なので、まずは安心。
#!/usr/bin/env perl use strict; use warnings; # RPGにおけるダメージ量計算のコード、らしい # $d ダメージ量 # $p1 プレイヤー本体の攻撃力 # $p2 プレイヤー武器の攻撃力 # $d1 敵本体の防御力 # $d2 敵の防具の防御力 sub damege_culc { my ( $p1, $p2, $d1, $d2 ) = @_; my $d = 0; $d = $p1 + $p2; $d = $d - ( ( $d1 + $d2 ) / 2 ); if ( $d < 0 ) { $d = 0; } return $d; } print damege_culc( 10, 5, 3, 5 ); # 11
リスト2.5 メソッドを呼び出す形に整理
本文ではリスト2.2〜2.4と段階的に改善して行っているのですが、そこは割愛して最終形のコードです。
本来は、Perlのオブジェクトの作法に従ってDamegeCalc.pmとそれを呼び出すdamege.plとかに分けるべきなのでしょうけど、ここは無精して1つのファイルでpackageで分けて書いてみます。
本文のJavaのコードをPerlに翻訳しつつ、やっていることはあまり変わらないように書いてみました。
うちは結構好きです。
ここでの疑問が、estimate_damegeメソッドにわざわざ引数を設定するのはなぜかなぁという・・・うちが想像している呼び出すコードとは違うのかな？ボス戦だけ与えるダメージを半分にする、とかの調整を入れやすくするためかなぁ？
#!/usr/bin/env perl use strict; use warnings; package DamegeCalc; sub new { my $class = shift; my $param = shift; my $self = bless $param, $class; return $self; } sub sum_up_player_attack_power { my $self = shift; return $self->{player_arm_power} + $self->{player_weapon_power}; } sub sum_up_enemy_defence { my $self = shift; return $self->{enemy_body_defence} + $self->{enemy_armor_defence}; } sub estimate_damege { my $self = shift; my $argv = shift; my $total_player_attack_power = $argv->{total_player_attack_power}; my $total_enemy_defence = $argv->{total_enemy_defence}; my $damege_amount = $total_player_attack_power - ( $total_enemy_defence / 2 ); if ( $damege_amount < 0 ) { return 0; } return $damege_amount; } package main; # RPGにおけるダメージ量計算のコード # $damege ダメージ量 # player_arm_power プレイヤー本体の攻撃力 # player_weapon_power プレイヤー武器の攻撃力 # enemy_body_defence 敵本体の防御力 # enemy_armor_defence 敵の防具の防御力 my $damege = DamegeCalc->new( { player_arm_power => 10, player_weapon_power => 5, enemy_body_defence => 3, enemy_armor_defence => 5, } ); my $total_player_attack_power = $damege->sum_up_player_attack_power(); my $total_enemy_defence = $damege->sum_up_enemy_defence(); my $damege_amount = $damege->estimate_damege( { total_player_attack_power => $total_player_attack_power, total_enemy_defence => $total_enemy_defence, } ); print $damege_amount;
メソッドを呼び出す形に整理・改
しかし、Perlで書くと長いな・・・いやいや、便利モジュール使ってみたら？
思い立ったらやってみる。
上記のコードをPerlの便利モジュール使って書き直してみます。
これで、ちょっとJavaっぽいコードになりました（個人の感想です）。
#!/usr/bin/env perl use strict; use warnings; package DamegeCalc; use Mouse; use Function::Parameters; has player_arm_power => ( is => 'ro', isa => 'Int' ); has player_weapon_power => ( is => 'ro', isa => 'Int' ); has enemy_body_defence => ( is => 'ro', isa => 'Int' ); has enemy_armor_defence => ( is => 'ro', isa => 'Int' ); method sum_up_player_attack_power() { return $self->player_arm_power + $self->player_weapon_power; } method sum_up_enemy_defence() { return $self->enemy_body_defence + $self->enemy_armor_defence; } method estimate_damege( :$total_player_attack_power, :$total_enemy_defence ) { my $damege_amount = $total_player_attack_power - ( $total_enemy_defence / 2 ); if ( $damege_amount < 0 ) { return 0; } return $damege_amount; } __PACKAGE__->meta->make_immutable(); package main; my $damege = DamegeCalc->new( player_arm_power => 10, player_weapon_power => 5, enemy_body_defence => 3, enemy_armor_defence => 5, ); my $total_player_attack_power = $damege->sum_up_player_attack_power; my $total_enemy_defence = $damege->sum_up_enemy_defence; my $damege_amount = $damege->estimate_damege( total_player_attack_power => $total_player_attack_power, total_enemy_defence => $total_enemy_defence, ); print $damege_amount;
ゆっくり読む
まずはこの本で良いコードを身につけたいと思います。
おまけ
リスト2.9 クラスにすると強く関係するデータとロジックをまとめられる
さて寝るかー、と思ったら次のコードが2章の最後だったのでここまで書いて寝るとします。
ヒットポイントのダメージ処理と回復処理です。
コンストラクタのところで最小値、最大値を超えないように三項演算子でのチェックが入ってますね。
最終的な値をオブジェクトに入れて返してます。
最初は！？ってなったけど、確かに合理的かも。
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; package HitPoint; use Carp qw/croak/; use Mouse; use Function::Parameters; use constant { MIN => 0, MAX => 999, }; has 'value' => ( is => 'rw', isa => 'Int', trigger => sub { croak MIN . "以上を指定してください" if ( $_[0]->value < MIN ); croak MAX . "以下を指定してください" if ( $_[0]->value > MAX ); }, ); # ダメージを受ける method damege(:$damege_amount){ my $dameged = $self->value - $damege_amount; my $corrected = $dameged < MIN ? MIN : $dameged; return HitPoint->new(value => $corrected); }; # 回復する method recover(:$recover_amount){ my $recovered = $self->value + $recover_amount; my $corrected = MAX < $recovered ? MAX : $recovered; return HitPoint->new(value => $corrected); }; package main; # 初期値10 my $hit_point = HitPoint->new( value => 10 ); say $hit_point->value; # 2000ダメージ $hit_point = $hit_point->damege(damege_amount => 2000); say $hit_point->value; # 結果は0 # 2000回復 $hit_point = $hit_point->recover(recover_amount => 2000); say $hit_point->value; # 結果は999
WEB+DB PRESS vol.128 に共同で寄稿しました
WEB+DB PRESS vol.128 に共同で寄稿しました
ご存知、技術評論社の WEB+DB PRESS。
個人的には基本情報、応用情報の過去問でお世話になった出版社さんでもあります。
Perl入学式校長の id:xtetsuji さん、Perl入学式大阪の id:tomcha0079 さんと共同で Perl Hackers Hub に寄稿しました。
1月終わりくらいに id:papix 氏よりお話をいただき、そこから2ヶ月。
書いて、並び替えて、消して、消して、並び替えて、書いて、消して、消して、消して・・・そんな執筆でした。
物理本を手に取ってみると、本当に印刷されてるーという感動があります。
従来の Perl Hackers Hub よりだいぶ技術レベルは抑えた内容ですが、Perl を独学で学んでいる人に届くといいなぁと思って書きました。
個人的には 2022 年に FizzBuzz の話をぶち込めただけで大満足です。
今月号は4月号だけあって、データベースや Terraform などの特集があり、いかにも新年度！って感じでよいですね。
定期購読されている方の元には既に届いていると思いますが、書店店頭に並ぶのは今週末23日の予定です。
Webからの購入はこちらからどうぞ。
Perl入学式やります
WEB+DB PRESS 掲載記念・・・というわけではないですが、今年も Perl 入学式やります。
Perl入学式は参加者各自にPCを用意いただき、そこにPerl環境を構築した上で学習する勉強会です。
環境構築自体はテキスト・動画を参考に各自で行います。サポートが必要な場合には、Discord というチャット上でサポートをおこないます。
また、Perlで Hello, World! する前に、ターミナルでのシェルの操作から講義を始めます。
初めて「黒い画面」を触る人も安心の構成です。
講義は毎年ほぼ同じ内容を繰り返す、いわばNHKの語学講座方式です。
一回の講習でわからなかったところ（例えばリファレンスとか）は、翌年再参加して、何回でも参加して質問したりしながら身につけていくこともできます。
私もリファレンスが理解できなくて2年通いました。
春開講は5月中旬に実施します。
参加をお待ちしております！
YAPC::Japan::Online 2022 懇親会での「和暦西暦変換」を実況中継風に
YAPC::Japan::Online 2022 から 2週間が経ちました
興奮冷めやらぬ・・・と言いたいのですが、興奮もそこそこに業務の嵐に飲み込まれた2週間でした。
で、やろうと思っていた Perl入学式プレゼンツのお題やるのすっかり忘れておりました。
和暦西暦変換
こんな感じです。
早速やっていきます。もちろん、Perl 入学式の範囲で！
各元号のスタート年は 元号一覧(日本)) を参考とし、以下とします。
- 慶応：1865
- 明治：1868
- 大正：1912
- 昭和：1926
- 平成：1989
- 令和：2019
まずはやってみる
まずは簡単に、愚直にやってみます。
テストケースは慶応1年（1865年）と慶応2年（1866年）です。
#!/usr/bin/env perl use strict; use warnings; use utf8; use Encode qw/decode/; my %era = ( keiou => 1865, ); my $input = decode( 'utf8', $ARGV[0] ); if ( $input =~ /慶応(\w+)年/ ) { my $start_year = $era{keiou}; print $era{keiou} + $1 - 1; }
$ perl wareki-seireki.pl 慶応1年 1865 $ perl wareki-seireki.pl 慶応2年 1866
順調ですね。
簡単に、とは言っていますが、漢字の年号を正しく正規表現で引っ掛けるために
use utf8; use Encode qw/decode/;
しています。
ここは2021年から追加された Perl と日本語 でやったところです。追加しておいてよかったー
同じように明治も追加しておきます。
コードと実行結果
#!/usr/bin/env perl use strict; use warnings; use utf8; use Encode qw/decode/; my %era = ( keiou => 1865, meiji => 1868 ); my $input = decode( 'utf8', $ARGV[0] ); if ( $input =~ /慶応(\w+)年/ ) { my $start_year = $era{keiou}; print $era{keiou} + $1 - 1; } elsif ( $input =~ /明治(\w+)年/ ) { my $start_year = $era{meiji}; print $era{meiji} + $1 - 1; }
$ perl wareki-seireki.pl 明治1年 1868 $ perl wareki-seireki.pl 明治2年 1869
よかよかー
元年対応
このまま大正、昭和と追加していくか・・・というところで思い出します。
なんか、元年対応してたな、と。
元年対応を盛り込みます。
コードと実行結果
#!/usr/bin/env perl use strict; use warnings; use utf8; use Encode qw/decode/; my %era = ( keiou => 1865, meiji => 1868 ); my $input = decode( 'utf8', $ARGV[0] ); if ( $input =~ /慶応(元|\w+)年/ ) { my $start_year = $era{keiou}; if ( $1 =~ /元|1/ ) { print $era{keiou}; } else { print $era{keiou} + $1 - 1; } } elsif ( $input =~ /明治(元|\w+)年/ ) { my $start_year = $era{meiji}; if ( $1 =~ /元|1/ ) { print $era{meiji}; } else { print $era{meiji} + $1 - 1; } }
$ perl wareki-seireki.pl 慶応元年 1865 $ perl wareki-seireki.pl 慶応1年 1865 $ perl wareki-seireki.pl 慶応2年 1866 $ perl wareki-seireki.pl 明治元年 1868 $ perl wareki-seireki.pl 明治1年 1868 $ perl wareki-seireki.pl 明治2年 1869
大丈夫そうですね。
サブルーチンにまとめてみる
さて、このまま大正、昭和と追加して行ってもいいんですが、なんかコードに似たようなところがあります。
if 文の中身のところですね。
if ( $input =~ /慶応(元|\w+)年/ ) { my $start_year = $era{keiou}; if ( $1 =~ /元|1/ ) { print $era{keiou}; } else { print $era{keiou} + $1 - 1; } } elsif ( $input =~ /明治(元|\w+)年/ ) { my $start_year = $era{meiji}; if ( $1 =~ /元|1/ ) { print $era{meiji}; } else { print $era{meiji} + $1 - 1; } }
似たようなところはサブルーチンにまとめるとコードの見通しもよくなりそう？
ってことでやってみます。
そして、ここに来て my $start_year = $era{keiou}; を全く使っていなかったことに気づきます・・・削除。
コードと実行結果
#!/usr/bin/env perl use strict; use warnings; use utf8; use Encode qw/decode/; my %era = ( keiou => 1865, meiji => 1868 ); my $input = decode( 'utf8', $ARGV[0] ); if ( $input =~ /慶応(元|\w+)年/ ) { calc( 'keiou', $1 ); } elsif ( $input =~ /明治(元|\w+)年/ ) { calc( 'meiji', $1 ); } sub calc { my $era_name = shift; my $year = shift; if ( $1 =~ /元|1/ ) { print $era{$era_name}; } else { print $era{$era_name} + $1 - 1; } }
まとまりましたね。
ここらで ok としましょうか・・・と言ったところで気づきます。
サブルーチンの中に $1 がある、ということに。
修正します。
コードと実行結果
#!/usr/bin/env perl use strict; use warnings; use utf8; use Encode qw/decode/; my %era = ( keiou => 1865, meiji => 1868 ); my $input = decode( 'utf8', $ARGV[0] ); if ( $input =~ /慶応(元|\w+)年/ ) { calc( 'keiou', $1 ); } elsif ( $input =~ /明治(元|\w+)年/ ) { calc( 'meiji', $1 ); } sub calc { my $era_name = shift; my $year = shift; if ( $year =~ /元|1/ ) { print $era{$era_name}; } else { print $era{$era_name} + $year - 1; } }
まだまだ！
そして、まだ同じようなコードが見えます。
if ( $input =~ /慶応(元|\w+)年/ ) { calc( 'keiou', $1 ); # 中略 elsif ( $input =~ /明治(元|\w+)年/ ) { calc( 'meiji', $1 );
変化しているのは 慶応 と keiou、 明治 と meiji だけで、あとは同じコードだよね・・・？
というわけで、もう元号を直接ハッシュのkeyに設定してしまいます。こんな感じで。
my %era = ( 慶応 => 1865, 明治 => 1868 );
コードと実行結果
#!/usr/bin/env perl use strict; use warnings; use utf8; use Encode qw/decode/; my %era = ( 慶応 => 1865, 明治 => 1868 ); my $input = decode( 'utf8', $ARGV[0] ); if ( $input =~ /(\w{2,2})(元|\w+)年/ ) { calc( $1, $2 ); } sub calc { my $era_name = shift; my $year = shift; if ( $year =~ /元|1/ ) { print $era{$era_name}; } else { print $era{$era_name} + $year - 1; } }
最後に
これだけ短くなると、もうサブルーチン必要ないのでは？となるので、まとめてしまいます。
それと、元年対応のところの正規表現 /(元|\w+)年/ ) も重複してるので、こちらも整理。
#!/usr/bin/env perl use strict; use warnings; use utf8; use Encode qw/decode/; my %era = ( 慶応 => 1865, 明治 => 1868, 大正 => 1912, 昭和 => 1926, 平成 => 1989, 令和 => 2019, ); my $input = decode( 'utf8', $ARGV[0] ); if ( $input =~ /(\w{2,2})(\w+)年/ ) { if ( $2 eq '元' || $2 == 1 ) { print $era{$1}; } else { print $era{$1} + $2 - 1; } }
Perl入学式範囲外 だったら？
正規表現には名前付きキャプチャというものがあります。これを使って $1, $2 より可読性の高いコードにします。
コードと実行結果
#!/usr/bin/env perl use strict; use warnings; use utf8; use Encode qw/decode/; my %era = ( 慶応 => 1865, 明治 => 1868, 大正 => 1912, 昭和 => 1926, 平成 => 1989, 令和 => 2019, ); my $input = decode( 'utf8', $ARGV[0] ); if ( $input =~ /(?<era>\w{2,2})(?<year>\w+)年/ ) { if ( $+{year} eq '元' || $+{year} == 1 ) { print $era{$1}; } else { print $era{ $+{era} } + $+{year} - 1; } }
とはいえ、3ヶ月後にこのコードを見た自分はちゃんと理解できるだろうか・・・？
プログラム書いてると、自分の馬鹿さ加減が身に染みてるわけです。
というわけで、ここまで書いてきてなんですが、理解を優先して一番最初の愚直なコードにすることもあるかもです。
さらに
やっぱ、漢数字対応はほしいよね？と思って手を出したら、こっちの方が時間かかりましたね・・・よくあることです。
コードと実行結果
#!/usr/bin/env perl use strict; use warnings; use utf8; use Encode qw/decode/; my %era = ( 慶応 => 1865, 明治 => 1868, 大正 => 1912, 昭和 => 1926, 平成 => 1989, 令和 => 2019, ); my %kanji_num = ( 一 => 1, 二 => 2, 三 => 3, 四 => 4, 五 => 5, 六 => 6, 七 => 7, 八 => 8, 九 => 9, 十 => 10, ); my $input = decode( 'utf8', $ARGV[0] ); if ( $input =~ /^(?<era>\w{2,2})(?<year>\w+)年$/ ) { my $era_name = $+{era}; my $year = $+{year}; if ( $year =~ /一|二|三|四|五|六|七|八|九|十/ ) { print $era{$era_name} + kanji_num($year) - 1; } elsif ( $year eq '元' || $year == 1 ) { print $era{$1}; } else { print $era{$era_name} + $year - 1; } } sub kanji_num { my $kan_suuji = shift; # 10の桁、1の桁がある場合（ex.二十二） if ( $kan_suuji =~ /^(\w)十(\w)$/ ) { return $kanji_num{$1} * 10 + $kanji_num{$1}; } # 10の桁が1の場合（ex.十二） elsif ( $kan_suuji =~ /^十(\w)$/ ) { return 10 + $kanji_num{$1}; } # 10の桁のみ場合（ex.二十） elsif ( $kan_suuji =~ /^(\w)十$/ ) { return $kanji_num{$1} * 10; } # 1桁のみと十のみの場合（ex.二） elsif ( $kan_suuji =~ /^(\w)$/ ) { return $kanji_num{$1}; } }
YAPC::Japan::Online 2022 に 裏トークA で参加しました ＆ スライド拾えるだけ拾った
2022年3月4日〜5日、YAPC::Japan::Online 開催！
というわけで、裏トークA で Perl 入学式校長の id:xtetsuji さんとお話をしておりました。
本編のトークを聞いて即興で感想や疑問を言い合うという、「水曜どうでしょう」「紅白歌合戦」の副音声のような、そんな感じです。
聞いていただいた方、ありがとうございました。
食事
オンラインカンファレンスで食事・・・？となりましたが、すごかったですね。
1日目も2日目も。
初日は鶏の丸焼き。
インパクト大。
中にはご飯詰まってて味染みてて美味しかった・・・
準備完了！ #yapcjapan pic.twitter.com/matUGq38sv
— sironekotoro💙💛 (@sironekotoro) 2022年3月4日
二日目はピザハットさん（ハットは HUT、屋根）のお一人様の「マイボックス」。
#yapcjapan ビザ届いた！ pic.twitter.com/mY4UNxFl9C
— sironekotoro💙💛 (@sironekotoro) 2022年3月5日
どう考えても、食事だけで参加費以上の体験です。
本当にスポンサーの方々ありがとうございました。
トラックA
感想も入れつつ・・・とやっていたのですが、気づいたらトークのスライドを探す旅になっており、とりあえず今の時点（2022/03/06 16:11）で上がっていたもの、見つけられたスライドへのリンクを貼っておきます。
TypeScript へ型安全性を高めながらリプレースする
型安全性を高めたい！という理想を、既存の10年稼働しているコードを相手にどうやって？という内容でした。
できるところからコツコツと、というとても現実的な内容で良かったです。
「作り直した方が早い症候群」「デカくて複雑なコードを前にして呆然」みたいなところで効いてくる内容でした。
Perl でも Type::Tiny モジュールなどを導入することで、型の導入が可能です。積極的に使っていこう、と思いました。
あと、積んだままになっている TypeScript の本を思い出したのでやらなきゃな、って感じです。
my$talk=qr{((?:ir)?reg(?:ular )?exp(?:ressions?)?)}i;
www.slideshare.net
5年にわたる"Perl の" REST API を "Perl で" GraphQL API 化し作り直す
スクラムでつくる頼もしく生き生きとしたチーム
はてなさんはアジャイル開発を全社で進めているとのことで、そこでの知見についての話でした。
透明性を担保するには、職場の心理的安全性が必要だよなぁ、と。
あなたの知らない(かもしれない)コアモジュール
perlimportsから探るPPIの世界
Acme、其はPerlのユグドラシル
トラックB
PHP で NFC リーダーを実装する
ReDoS 検出の最先端 recheck の紹介
じわじわとPerlからGoに移行しようとしている俺達のマイクロサービシーズの紹介
Hono[炎] Ultrafast web framework for Cloudflare Workers.
フロー効率の向上から始める開発生産性の高め方 ~ モブワークを沿えて ~
エンジニアの個人ブランディングと技術組織
www.slideshare.net
7年間運用したソーシャルゲームをAmazon EC2構成からAmazon ECS構成へと乗り換えた話
LT
続・SSD を換装した MacBook Air (13-inch, Mid 2013) で panic(cpu 0 caller 0xffffff8002ac2838)
あの負け戦から半年ちょっと
2022年1月26日、MacOS Big Sur 11.6.3 登場
もしかしたら、SSD 換装に関わるトラブルも解決しているのでは・・・？
と思って再換装。
数回の意図しない再起動の後、なんとか Big Sur 11.6.3 をインストールすることができました。
それから3日ほど経ちましたが、安定しているようです。
もうしばらく、Parallels で Windows10 起動させっぱにしてみたり、スクリーンセーバー動かしっぱなしにして様子を見てみます。
・・・とはいえ、もう 2013 年モデルの出る幕はないのでは？とか、会社から支給されている MacBook Pro 2017 で十分ではあるのですが、愛着があるんですよね。
Perlで弥生販売21から出力されたcsvファイルを読み込んだらパースに失敗した
過去の自分に助けられたり物足りなかったり
毎回書いてる気がしますが、ブログに学んだことを書いておくと何が良いかというと、過去の自分に助けてもらえたりします。
ということで、今日も（自分の仕事を楽にするために）Perl 書いているのですが、ちょっとつまづいたので書いておきます。
きっと数ヶ月、数年先の自分が見ることになると思うので・・・
Perl で 弥生販売21 の csv ファイルを読み込んで表示する
まず、環境ですが macOS Big Sur 上で動く Perl です。
扱うのは Windows 上で動く会計ソフト「弥生販売」から出力されたファイルです。文字コードは Windows おなじみの cp932 、というところまでは分かっています。
過去の自分のブログ記事も見て、読み込むコードを書きます。
#!/usr/bin/env perl use strict; use warnings; use Encode qw(encode_utf8); my $file = '入金区分別入金明細表.csv'; open my $FH, '<:encoding(cp932)', $file or die; # 文字コードを指定してファイル読み込み for my $line (<$FH>) { chomp $line; print encode_utf8($line); } close $FH;
はい、さくっと表示できます。ちなみに、中身は当然ダミーのデータなので会社名や所在地に意味はありません。
1,1,0,20211228,123,10,0,0,0,0,234,,17,1,2,,201,振込 白猫銀行,0,,0,0,,0,0,1000,,0,0,0,,0,0,,,,,,,A株式会社,,,,,,,,,,,,,A株式会社,000-0000,東京都葛飾区堀切1-655-5,東ビル2F,00-0000-0000 1,1,0,20211228,124,10,0,0,0,0,456,,,1,2,,201,振込 白猫銀行,0,,0,0,,0,0,2000,,0,0,0,,0,0,,,,,,,B株式会社,,,,,,,,,,,,,B株式会社,000-0001,東京都西東京市北町2-115-3,西タワー,00-0000-0001
Perl で 弥生販売21 の csv ファイルをパースするとエラー
では、ここで各行を csv として解釈し、配列に入れるべくコードを変えていきます。
これも過去の自分の記事みてコピペです・・・が、どうもうまくいきません。
#!/usr/bin/env perl use strict; use warnings; use Encode qw(encode_utf8); use Text::CSV_XS; my $csv = Text::CSV_XS->new(); # csvを扱う便利オブジェクト my $file = '入金区分別入金明細表.csv'; open my $FH, '<:encoding(cp932)', $file or die; for my $line (<$FH>) { chomp $line; my $status = $csv->parse($line); # CSV文字列をパースしてフィールド群に切り分ける # $status は成否判定が入っている（今回は使わない） my @columns = $csv->fields(); # パースされたフィールド群を配列に入れる print "@columns" . "\n"; }
本来なら2行表示されるはずが、1行分しか表示されません。
Use of uninitialized value $columns[0] in join or string at /Users/sironekotoro/urikake2kaikei.pl line 18, <$FH> line 2. 1 1 0 20211228 124 10 0 0 0 0 456 1 2 201 振込 白猫銀行 0 0 0 0 0 2000 0 0 0 0 0 B株式会社 B株式会社 000-0001 東京都西東京市北町2-115-3 西タワー 00-0000-0001
調べてみる
テキストエディタでこの csv ファイルを見てみましが、おかしそうなところは「見えません」でした。
そう、このエラーの原因は見えないのです。
しかし、過去の自分がしっかりとヒントを書いていました。
# $status は成否判定が入っている（今回は使わない）
やるじゃん俺・・・
$csv->parse($line); は引数の $line が csv としてパースできれば 1 , 失敗すれば 0 を返します。
$status を表示してみます。
#!/usr/bin/env perl use strict; use warnings; use Encode qw(encode_utf8); use Text::CSV_XS; my $csv = Text::CSV_XS->new(); # csvを扱う便利オブジェクト my $file = '入金区分別入金明細表.csv'; open my $FH, '<:encoding(cp932)', $file or die; for my $line (<$FH>) { chomp $line; my $status = $csv->parse($line); # CSV文字列をパースしてフィールド群に切り分ける print $status . "\n"; # 成否判定のみ表示する } close $FH;
実行してみると、1行目のパースに失敗しているようです。
0 1
では、その原因は・・・？
ということで、Text::CSV_XS でエラーを切り分けてくれるオプションがありました。auto_diag です。
早速、オプションをつけてみます。
my $csv = Text::CSV_XS->new( { auto_diag => 1 } ); # csvを扱う便利オブジェクト
おー、なんかエラーが出ていますね。改行コード（CR）がクオートされていない内側にある？（英検三級並感）
# CSV_XS ERROR: 2032 - EIF - CR char inside unquoted, not part of EOL @ rec 0 pos 217 field 57 0 1
で、このエラーでググると、解決法を残してくれているブログが見つかったのでした。ありがたいです。
制御コードが悪さをしていたようですね。どうして入り込んだのかはわからないのですが・・・
制御コードを正規表現で置換して削除しつつ、さらにパースが失敗したときにはプログラムを終了させる die も仕掛けておきます。
#!/usr/bin/env perl use strict; use warnings; use Encode qw(encode_utf8); use Text::CSV_XS; my $csv = Text::CSV_XS->new( { auto_diag => 1 } ); # csvを扱う便利オブジェクト my $file = '入金区分別入金明細表.csv'; open my $FH, '<:encoding(cp932)', $file or die; for my $line (<$FH>) { chomp $line; # https://www.drk7.jp/MT/archives/001934.html を参考に制御文字を削除 $line =~ s/[\x01-\x1f]+$//gsm; my $status = $csv->parse($line); die "Parse Error!" if $status == 0; # パースに失敗してたらプログラムを終了 my @columns = $csv->fields(); print encode_utf8("@columns") . "\n"; } close $FH;
これでちゃんとパースできているようです。エラーもありません。
1 1 0 20211228 123 10 0 0 0 0 234 17 1 2 201 振込 白猫銀行 0 0 0 0 0 1000 0 0 0 0 0 A株式会社 A株式会社 000-0000 東京都葛飾区堀切1-655-5 東ビル2F 00-0000-0000 1 1 0 20211228 124 10 0 0 0 0 456 1 2 201 振込 白猫銀行 0 0 0 0 0 2000 0 0 0 0 0 B株式会社 B株式会社 000-0001 東京都西東京市北町2-115-3 西タワー 00-0000-0001
この後は、これを弥生会計に取り込めるように編集し、cp932 で保存し・・・という作業です。
この作業はなぜ必要？
うちの経理業務では会計ソフトとして「弥生会計」、売上管理に「弥生販売」を利用しています。
同じシリーズの製品なので、当然データの取り込みも可能です。
可能なのですが、「過去の仕訳・業務との整合性」「深淵な理由」などにより標準機能での取り込みを行っていません。
現在は弥生販売から一旦 csv に出力し、加工した後に弥生会計に取り込み、という手順を踏んでいます。
こういった作業は他にもあり、単純に面倒なのでプログラムでやらせるに限るよな！ってことで Perl で書いたりしています。
