sironekotoroの日記

Perl で楽をしたい

Perl から MySQL 8.x に接続した時の警告を消す

PlanetScale というサーバレスDBを使ってみました。

以下のQiita見てサインアップしました。

多少画面遷移は変わっていますが、なんとかなるレベルです。スクショ貼ってくれるのは本当にありがたい・・・

あ、無料プランで登録したのですがクレカの登録は必要でした。

qiita.com

で、その後に手元のMacで環境整備。

  • homebrew で mysql をインストール
$ mysql -V
mysql  Ver 8.1.0 for macos13.3 on x86_64 (Homebrew)

接続先のホストやデータベース名、ユーザー名とパスワードを環境変数にセットして、いざアクセス。

あっさりログイン。

$ mysql -h $DATABASE_HOST -D $DATABASE_NAME -u $DATABASE_USERNAME -p$DATABASE_PASSWORD --ssl-mode=VERIFY_IDENTITY --ssl-ca=/etc/ssl/cert.pem
mysql: [Warning] Using a password on the command line interface can be insecure.
Reading table information for completion of table and column names
You can turn off this feature to get a quicker startup with -A

Welcome to the MySQL monitor.  Commands end with ; or \g.
Your MySQL connection id is 1608708638
Server version: 8.0.23-PlanetScale 

Copyright (c) 2000, 2023, Oracle and/or its affiliates.

Oracle is a registered trademark of Oracle Corporation and/or its
affiliates. Other names may be trademarks of their respective
owners.

Type 'help;' or '\h' for help. Type '\c' to clear the current input statement.

mysql> 

mysql> select version();
+---------------+
| version()     |
+---------------+
| 8.0.23-Vitess |
+---------------+
1 row in set (0.01 sec)

拍子抜け。そのまま、SQLでテスト用のデータベースを作成。

INSERT INTO `users` (id, email, first_name, last_name)
VALUES  (1, 'hp@example.com', 'Harry', 'Potter');

SELECT * FROM users;

DESCRIBE users;

確認

mysql> SELECT * FROM users;
+----+----------------+------------+-----------+
| id | email          | first_name | last_name |
+----+----------------+------------+-----------+
|  1 | hp@example.com | Harry      | Potter    |
+----+----------------+------------+-----------+
1 row in set (0.04 sec)

普通のMySQLですなぁ。

一旦 exit; で抜けて、Perlからアクセスできるか確認していきます。

Perlからアクセス

  • cpanm で DBI, DBD::mysql をインストール
$ cpanm DBI
DBI is up to date. (1.643)

$ cpanm DBD::mysql
DBD::mysql is up to date. (4.050)
use v5.036;
use DBI;

my $dbh = DBI->connect(
    "DBI:mysql:$ENV{DATABASE_NAME}:$ENV{DATABASE_HOST}",
    $ENV{DATABASE_USERNAME},
    $ENV{DATABASE_PASSWORD},
    {
        RaiseError => 1,
        mysql_ssl  => 1,

        mysql_enable_utf8mb4 => 1,
    }
);

my $sth = $dbh->prepare("SELECT * FROM users");
$sth->execute();
while ( my $ref = $sth->fetchrow_hashref() ) {
    print
"Found a row: id = $ref->{'id'}, email = $ref->{'email'}, first_name = $ref->{'first_name'}, last_name = $ref->{'last_name'}\n";
}
$sth->finish();

とここで問題。

ちゃんと Found a row: id = 1, email = hp@test.com, first_name = Harry, last_name = Potter と意図した応答があったのですが、その前にWARNINGがついてきます。

WARNING: MYSQL_OPT_RECONNECT is deprecated and will be removed in a future version

このWARNINGを消すのに色々調べて回ったのですが、まずはStackoverflow

stackoverflow.com

翻訳使いながらみていきますが、どうも手立てはない模様。

この WARNING をGoogle 検索にいれて片っ端から見ていきます。

MySQL 公式もひっかかったのですが、この警告は特定条件の時に出る模様。

dev.mysql.com

他にも、裏で Perl 使ってそうなミドルウェアで同様の警告ログが出ているみたい。

そんなこんなでたどり着いたのがこちら。

github.com

スレッドをずっと辿っていくと、fork した修正版を作ってくれた方がいました。

github.com

ありがたい!早速インストールします。

$ cpanm https://github.com/dveeden/DBD-mysql.git

おかげで無事警告は消えました。

作者の方はテストしたらCPANにリリースするとのことでした( https://github.com/perl5-dbi/DBD-mysql/issues/354#issuecomment-1696402746)。

待ち遠しいですね。

YAPC::Kyoto 2023 に参加してきました

yapcjapan.org

3年ぶりにリアル開催のカンファレンスに参加してきました。

3年、長いですね。

この間、Perl入学式 in 東京 のスタッフとして、id:xtetsuji や godan さんと講義をオンライン配信したり、小規模な対面形式の講義を行ってきました。

お二方は今回のYAPC::Kyoto 2023 でもコアスタッフとして大活躍でした。本当にありがとうございます。

聞いてたトーク

入場前

9時に集合!ってことだっったので9時前に空いてると思ったら9時から開場だった。

気が急いてしまってる。

2023年春のPerl

Perl 5.36 で取り入れられた大きな変化とかはリリースされなかった Perl 7 を想定してのものだったのかなぁという感じ。

あと、class 構文楽しみですね。

地方のエンジニアが作る日本のITコミュニティの未来

日常業務のカイゼンで図る開発チームへの貢献

入門 障害対応 「サービス運用はTry::Catchの繰り返しだよ、ワトソン君」

障害対応訓練の playbook を作ってやっておくってのは良い試みだなぁと思いました。

あの日ハッカーに憧れた自分が、「ハッカーの呪縛」から解き放たれるまで

speakerdeck.com

ベストトーク賞も納得。素晴らしいトークでした。

公開収録ランチセッション

お弁当、京風味って感じで美味しかったです!

ソフトウェアエンジニアリングサバイバルガイド: 廃墟を直す、廃墟を出る、廃墟を壊す、あるいは廃墟に暮らす、廃墟に死す

docs.google.com

デプロイ今昔物語 〜CGIからサーバーレスまで〜

speakerdeck.com

法と技術の交差点

どこでも動くWebフレームワークをつくる

my new error...

result型、知らなかった。

(ここだけじゃなかったが)dan さんの「技術的負債」という言葉にかける強い思いが印象的だった。確かに、その負債を生んだのは誰か(他人?自分?)というのは自覚しておくべきよねという。

ライトニングトーク

サブネットマスクの計算とか懐かしかったです(もうできない)

キーノート

後半はツイートするのも忘れて聞き入ってました。

人に歴史あり、会社に歴史あり。

そして何より人の繋がり。

YAPC::Asia のコアメンバーのちょっとした行動が YAPC::Japan に繋がってるという展開。

熱かったですね。

NHKの「映像の世紀 バタフライエフェクト」感がありました。

その他

ノベルティの肩掛けバッグ

https://twitter.com/sironekotoro/status/1637413040789540865?s=20

まじこのノベルティ袋は素晴らしく、紐をつける判断したスタッフの方本当に最高です。

ありがとうございます。とても持ち運びやすかったです。

ChatGPT

ChatGPT、旬でした。

次回?は広島??

これまで、YAPC::Japan は地域コミュニティがあるところで開催してきましたが、次回の広島は地域コミュニティのないところでの開催となること。

おぉ。

今後、YAPC::Tohoku とか YAPC::Shikoku とかもありうるのだろうか。

楽しみだなぁ。

YAPC::Japan は日本各地で開催されるので、YAPC 駆動でさまざまなところに行けるのが旅行好きとしては嬉しいんですよね。

今回の京都もたくさんの名所やお店を回ることができて、それも合わせて最高の連休を過ごすことができました。

YAPCに合わせて有給をぶっ込み、観光して回るのおすすめです。

年末年始に母のスマホ移行に付き合う

母のスマホ購入

元々、母からスマホを利用したいということを聞いていました。

職場(保育園の看護師)や民生委員の活動、友達との集いで LINE の利用が多いとのこと。

LINE を使うためにスマホに変えたいということでした。

母は iPad を利用してニュースやクックパッドをみており、2013年頃からのユーザーです。

タッチインターフェースには慣れていると判断し、同じ操作感の iPhone を購入となりました。

また、実家近くに住む妹が iPhone ユーザーであり、甥っ子姪っ子も iPad ユーザーであるので、聞ける人が周りにいるというのも決め手でした。

3D LiDER のような機能は不要ということで、iPhone SE(第3世代)への機種変を予定しました。

Docomo ショップ

年末の帰省に合わせ Docomo ショップに機種変の予約を入れます。

しかし、母の Docomo ID がわからないため、自分の Docomo ID を使って機種変の予約をします。

予約フォームに備考欄といった自由入力欄はありません。

母に付き添って Docomo ショップへ向かい、来店早々「すみません、実は私ではなく親の機種変で・・・」という説明からすることになります。

お目当ての iPhone SE(第3世代) はブラックしか在庫がありませんでした。

母はホワイト希望だったのですが、入荷はひと月先とのこと。

ということで、在庫のあるブラックを購入します。

事前に希望の機種がある場合は、早めに予約しておくのが良いようです。

機種変についてはタブレットで説明動画を見せられて、いくつか質問をして終わりました。

Apple ID の認証情報は iPad に設定していたもと同じものを母に代わって入力します。

この辺りはスムーズだったと思いますが、それでも1時間はかかりました。

心配していた連絡先ですが、ガラケーの電話帳から連絡先を移行する機械があり、全く手間なく移行を終えることができました。

ここは Docomo ショップを使った甲斐があったというものでした。

チュートリアル

iPad でタッチインターフェースに慣れているとはいえ、電話やメールの機能は使っていない母。

以下を一緒に行います。

  • 電話の掛け方、受け方

  • メールの送信の仕方、メールの読み方、返信の仕方

  • 写真の撮り方、撮った写真の確認の仕方

これでガラケーで出来たことは iPhone でもできるようになった感じです。

そういえば、iPhone の初期の壁紙が 3Dの視差効果付き、かつ現在時刻の一部が隠れるようなものでした。

これを見た母は初期不良かと思ったそうです。

備品購入

引き続き、以下の備品を購入しました。

ケースとガラスフィルムはつけて当然というか。

ワイヤレス充電は、その方が楽であろうということで。

モバイルバッテリーと Lightning コードはガラケーに比べて電池の持ちが良くないスマホのために。

そして最後の本。

一通りの基本アプリの操作が載っている上に、 LINE についても一章を割いて解説してくれています。

実は自分は LINE を使っていなかったので、とても助かりました。

LINE にサインアップすると・・・

・・・LINEって、サービス初期からこうだったよなぁ・・・(だから使っていなかった)

ja.wikipedia.org

インストールしたアプリと各種認証情報

LINEの他にインストールして設定したのは以下のアプリです。

クックパッドやニュースのアプリは画面が大きい iPad に入れており、 iPhone には不要と判断したので、最低限のもののみです。

  • 接種証明書アプリ

  • マイナポータル

  • マイナポイント

また、Apple ID などの認証情報は紙に書いて渡しています。

パスワード管理アプリというのもあるのですが、まずは使う敷居を低くするところから。

なお、ウォレットや Apple Pay の設定はしていません。

その後

母はその後、 Docomo ショップのスマホ教室にいって色々と学んでいるとのこと。

これも Docomo ショップを使っておいてよかったなぁという点です。

月々の料金を考えると ahamo とかいろいろ考えました。

しかし、何かあった時の対応が自助努力になること(その代わり安い)を考えると、少々高くても実店舗のある Docomo ショップに頼れるのは助かります。

ということで、年末年始の帰省で母のスマホ移行に付き合った話でした。

2022年もお疲れ様でした

2022年を振り返って

お仕事が忙しかったりなんなりで、2ヶ月も空いてしまいました。

Perl入学式

in 東京の講師と、テキストの改修を担当しておりました。

今年は春、秋と開催し、オフラインでの講義に切り替えました。

やはり近くに講義を受けている方がいて、ダイレクトに質問を受けられるのはすばらしい!と言う感想です。

来年もまた、オフラインでの開催をやっていきたいと考えています。

「良いコード/悪いコードで学ぶ設計入門」

一通り読み通すことができました。

何も考えなかったり、雑に書くと詰まってしまうところを、この技法で読みやすくメンテナンスしやすくしよう・・・という本でした。

そしてそれ以上に、他の言語の本を Perl に読み替えて学習しきったという体験がとても良かったです。

気になる本があっても、Perl じゃないというだけで敬遠してたのですが、そういう壁を乗り越えるきっかけになりました。

・・・その勢いてたくさん本を買い、積んでしまっていますが。

積んでいる本のトップはこちらになります。

お仕事

今までやってきたお仕事が減るかも、と思ったら別の仕事が増えたり、といった2023年になりそうです。

とにかく、楽をできるように上手く技術使っていきたいです。

2023年もよろしく

というわけで、来年も頑張っていきます。

「良いコード/悪いコードで学ぶ設計入門」第13章 モデリング 〜 第14章 リファクタリング

13章もパラパラっとページをめくってみた感じ、文章がメインぽいですね。

13.1 邪悪な構造に陥りがちな User クラス

面白い。いかにもありそうな気がする。

  • User というログインユーザーを示すクラスを作る
  • そこにIDや名前などのプロパティを追加していく
  • User を管理するための UserManager というクラスも作る
  • さらに法人ユーザーも同じ User クラスを使い(ん?)
  • 法人番号などのプロパティを追加していく(個人ユーザー使わないよね、そのプロパティ)
  • 法人ユーザー を管理するための CorporationManager というクラスも作る

そして、UserMaganeger, CorporationManager 双方が User クラスを見た時・・・

  • CorporationManager が個人 User の法人番号が空白としてエラー(個人ユーザーだし当然)
  • UserManager が人名に利用できない (株) などの文字を利用しているとしてエラー

これらを回避するために、分岐が増え・・・メンテナンスが難しくなり・・・おぉ、目に見えるようだ。

13.2 モデリングの考え方とあるべき構造

  • モデルはシステム構造の説明のために用いる
  • システムとは何か?
  • システムは目的達成のための手段
  • 特定の目的達成のために、最低限考慮が必要な要素を備えたものがモデル

ここで、例として通販サイトにおける商品モデルを取り上げるが、商品を構成するプロパティを全部突っ込んである巨大な商品モデルになっている。

これを、「注文時の商品モデル」「配送時の商品モデル」のように、目的ごとに定義した商品モデルにする。

13.3 よくないモデルの問題点と解決方法

上記の User モデルは、複数の目的のために無理やり利用されており、モデリングしているようでモデリングしていないといえる

うむ。

「User が持ちうるもの」という意味では一貫しているといえるけど、特定の目的のためという意味では不要なプロパティも多いよなぁ。

ここから先は文章が続き、本の要約にしかならないので、しばし飛ばします。

飛ばしつつ、気になったところを書き抜きます。

  • 特定の目的に特化して設計することで、変更に強い高品質な構造になる
  • モデルに目的外の要素が入り込んでいる場合、さらに見直す

思えば、自分も巨大モデルを作りたがる傾向がある気がします。

それで楽をしてきたと思うのですが、果たして本当に楽だっただろうか・・・?

うーん。

13.4 機能を左右するモデリング

  • 裏に隠れた真の目的を見破る
    • これは起こりうるトラブルを解決するための情報が揃えられるか?的な観点で説明してる
  • 機能性をイノベートする「深いモデル」
    • 目的・手段に応じた抽象化をする
    • 本質的課題を解決し、機能性の確信に貢献するモデル

14.1 リファクタリングの流れ

  • 外から見た挙動を変えずに、構造を整理すること
  • おっと、久々に骨のありそうなコードだ。書いてみよう。
  • なお、久々すぎてJavaのコードの読み方をすっかり忘れてしまっていた
  • リスト14.1相当のつもりで書き始めたけど、Mouse (使ってのオブジェクト指向)の書き方に従ってたらリスト14.5相当くらいのコードになってた。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;

package Customer {
    use Mouse;

    has name => (
        is       => 'ro',
        isa      => 'Str',
        required => 1,
    );

    has id => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
    );

    has possession_point => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
        default  => 1000,
    );

    sub is_enabled {
        return !!1;
    }

}

package Comic {
    use Mouse;

    has id => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
    );

    has current_purchase_point => (
        is      => 'ro',
        isa     => 'Int',
        default => 100,
    );

    sub is_enabled {
        return !!1;
    }

}

package PurchasePointPayment {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;
    use Time::Piece;

    # 購入者
    has customer => (
        is       => 'ro',
        isa      => 'Customer',
        required => 1,
        trigger  => sub {
            croak "有効な購入者ではありません。" unless $_[1]->is_enabled;
        }
    );

    # 購入するWebコミック
    has comic => (
        is       => 'ro',
        isa      => 'Comic',
        required => 1,
        trigger  => sub {
            croak "現在取扱できないコミックです。" unless $_[1]->is_enabled;
        }
    );

    # 購入日時
    has payment_date_time => (
        is       => 'ro',
        isa      => 'Time::Piece',
        required => 0,
        default  => sub {
            croak "所持ポイントが不足しています。"
              unless $_[0]->comic->current_purchase_point <=
              $_[0]->customer->possession_point;

            return localtime();
        }
    );

    __PACKAGE__->meta->make_immutable();
}

package main;

my $purchase_pointp_ayment = PurchasePointPayment->new(

    customer => Customer->new( name => 'sironekotoro', id => 1 ),
    comic    => Comic->new( id => 10 ),
);

  • ここからは以下の改修ポイントを実装していく。
  • unless $_[1]->is_enabled; でも良い気がするが、if $_[1]->is_disabled; にしておく
  • 購入日のプロパティでの残高チェックのサブルーチンを、customer に移す

で、改修したのがこちら。

しれっと use v5.36;, use signatures 使ってます。

ここクリックして展開

#!/usr/bin/env perl use strict; use warnings; use v5.36; use feature qw/say signatures/; package Customer { use Mouse; has name => ( is => 'ro', isa => 'Str', required => 1, ); has id => ( is => 'ro', isa => 'Int', required => 1, ); has possession_point => ( is => 'ro', isa => 'Int', required => 1, default => 1000, ); sub is_disabled { return !!0; } sub is_short_of_point ( $self, $comic ) { return !!1 if $self->possession_point <= $comic->current_purchase_point; } } package Comic { use Mouse; has id => ( is => 'ro', isa => 'Int', required => 1, ); has current_purchase_point => ( is => 'ro', isa => 'Int', default => 100, ); sub is_disabled { return !!0; } } package PurchasePointPayment { use Carp qw/croak/; use Mouse; use namespace::autoclean; use Time::Piece; # 購入者 has customer => ( is => 'ro', isa => 'Customer', required => 1, trigger => sub { my $customer = $_[1]; croak "有効な購入者ではありません。" if $customer->is_disabled; } ); # 購入するWebコミック has comic => ( is => 'ro', isa => 'Comic', required => 1, trigger => sub { my $comic = $_[1]; croak "現在取扱できないコミックです。" if $comic->is_disabled; } ); # 購入日時 has payment_date_time => ( is => 'ro', isa => 'Time::Piece', required => 0, default => sub { my $self = $_[0]; croak "所持ポイントが不足しています。" if $self->customer->is_short_of_point( $self->comic ); return localtime(); } ); __PACKAGE__->meta->make_immutable(); } package main; my $purchase_pointp_payment = PurchasePointPayment->new( customer => Customer->new( name => 'sironekotoro', id => 1 ), comic => Comic->new( id => 10 ), );

14.2 ユニットテストリファクタリングのミスを防ぐ

  • 悪魔を呼び寄せるような邪悪なコードには、テストコードが書かれていないことが多いです

ということで、リファクタリングをする前のコード書いていきます。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use v5.36;
use feature qw/say signatures/;

package Product {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    has price => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
    );
    __PACKAGE__->meta->make_immutable();
}

# 配送管理クラス
package DeliveryManager {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    has products => (
        is       => 'ro',
        isa      => 'ArrayRef',
        required => 1,

        # trigger  => sub { croak '', unless ( $_[0] ) },
    );

    sub delivery_charge ($self) {
        my $charge      = 0;
        my $total_price = 0;

        for my $product ( @{ $self->products } ) {
            $total_price += $product->price;
        }

        if ( $total_price < 2000 ) {
            $charge = 500;
        }
        else {
            $charge = 0;
        }
        return $charge;

    }
    __PACKAGE__->meta->make_immutable();
}

package main;

my $deliverely_manager = DeliveryManager->new(
    products => [ Product->new( price => 100 ), Product->new( price => 200 ), ]
);

say $deliverely_manager->delivery_charge();

まず、Manager って名前が悪いよね。何でもメソッドを放り込まれる悪魔の名前だったような。

それはさておき、(この本の)リファクタリングの仕方を追っていきます。

まず、あるべき形を決めて、そこに旧来の DeliveryManager クラスから移植していきます。

  • 購入する商品一覧である、買い物かごクラス
# 買い物かご
package ShoppingCart {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    has products => (
        is       => 'ro',
        isa      => 'ArrayRef[Product]',
        required => 0,
        default  => sub { [] },
    );

    sub add ( $self, $product ) {
        my @adding = @{ $self->products };
        push @adding, $product;
        return __PACKAGE__->new( products => \@adding );
    }

    __PACKAGE__->meta->make_immutable();
}
  • 商品クラス
package Product {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    has id => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
    );

    has name => (
        is       => 'ro',
        isa      => 'Str',
        required => 1,
    );

    has price => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
    );
    __PACKAGE__->meta->make_immutable();
}
  • 配送料を計算するクラス
package DeliveryCharge {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    has amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
        default  => -1
    );
    __PACKAGE__->meta->make_immutable();
}

このあとにテストを書きます。

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

use Test::Simple tests => 2;
use lib qw(. ../);
use Product;
use ShoppingCart;
use DeliveryCharge;

{
    # 商品の合計額が2000円未満の場合、配送料は500円
    my $empty_cart = ShoppingCart->new();

    my $one_product_added =
      $empty_cart->add( Product->new( id => 1, name => '商品A', price => 500 ) );
    my $two_product_added =
      $one_product_added->add( Product->new( id => 2, name => '商品B', price => 1499 ) );

    my $charge = DeliveryCharge->new( shopping_cart => $two_product_added );

    ok( $charge->amount == 500, "商品の合計金額が2000円未満の場合、配送料は500円" );
}

{
    # 商品の合計額が2000円以上の場合、配送料は無料
    my $empty_cart = ShoppingCart->new();

    my $one_product_added =
      $empty_cart->add( Product->new( id => 1, name => '商品A', price => 500 ) );
    my $two_product_added =
      $one_product_added->add( Product->new( id => 2, name => '商品B', price => 1500 ) );

    my $charge = DeliveryCharge->new( shopping_cart => $two_product_added );

    ok( $charge->amount == 0, "商品の合計金額が2000円以上の場合、配送料は0円" );
}

この時点でのファイル構成はこんな感じ。

Perl では t というディレクトリの中に拡張子 t でテストファイルを作ります。

$ tree
.
├── DeliveryCharge.pm
├── Product.pm
├── ShoppingCart.pm
├── list_14_11.pl
└── t
    └── deliver_charge_test.t

で、t ディレクトリと同じ階層(t ディレクトリの中ではない)で prove コマンドを打つとテストを実行してくれます。

もちろん、t ディレクトリの中で perl deliver_charge_test.t でもok

$ prove
t/deliver_charge_test.t .. 1/2
#   Failed test '商品の合計金額が2000円未満の場合、配送料は500円'
#   at t/deliver_charge_test.t line 22.

#   Failed test '商品の合計金額が2000円以上の場合、配送料は0円'
#   at t/deliver_charge_test.t line 36.
# Looks like you failed 2 tests of 2.
t/deliver_charge_test.t .. Dubious, test returned 2 (wstat 512, 0x200)
Failed 2/2 subtests

Test Summary Report
-------------------
t/deliver_charge_test.t (Wstat: 512 (exited 2) Tests: 2 Failed: 2)
  Failed tests:  1-2
  Non-zero exit status: 2
Files=1, Tests=2,  0 wallclock secs ( 0.03 usr  0.01 sys +  0.06 cusr  0.01 csys =  0.11 CPU)
Result: FAIL

はい、エラーが出ました。

今回は、というかテストファーストで進める場合は「あるべき構造」のガワを作り「あるべき応答」でテストをしたので、中身を作っていない以上エラーが出て当然です。

ここからリファクタリングをしていきます。

リスト14.13

まずはエラーを出さないように、最低限の実装です。

ここクリックして展開

package DeliveryCharge {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;
    use List::Util;

    has shopping_cart => (
        is       => 'ro',
        isa      => 'ShoppingCart',
        required => 1,
    );

    has amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 0,
        builder  => "_build_amount",
    );

    sub _build_amount {
        my $self = shift;

        my $amount      = 0;
        my $total_price =
          $self->shopping_cart->products->[0]->price +
          $self->shopping_cart->products->[1]->price;

        if ( $total_price < 2000 ) {
            $amount = 500;
        }
        else {
            $amount = 0;
        }

        return $amount;
    }

    __PACKAGE__->meta->make_immutable();
}
1;

リスト14.14

このままだと、テストは通るけど、商品が2つまでしか入らないショッピングカートになってしまうので、ちゃんと書きます。

ここクリックして展開

package DeliveryCharge {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;
    use List::Util;

    has shopping_cart => (
        is       => 'ro',
        isa      => 'ShoppingCart',
        required => 1,
    );

    has amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 0,
        builder  => "_build_amount",
    );

    sub _build_amount {
        my $self = shift;

        my $amount      = 0;
        my $total_price = 0;

        for my $product ( @{ $self->shopping_cart->products } ) {
            $total_price += $product->price;
        }

        if ( $total_price < 2000 ) {
            $amount = 500;
        }
        else {
            $amount = 0;
        }

        return $amount;
    }

    __PACKAGE__->meta->make_immutable();
}
1;

今は配送料を扱う DeliveryCharge クラス内で、商品の合計を出して配送料を決めている。

本来、商品の合計を出すのは ShoppingCart クラスのはず。

ということで、リファクタリングしたのがこちらです!

ここクリックして展開

package ShoppingCart {
    use v5.36;
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    has products => (
        is       => 'ro',
        isa      => 'ArrayRef[Product]',
        required => 0,
        default  => sub { [] },
    );

    sub add ( $self, $product ) {
        my @adding = @{ $self->products };
        push @adding, $product;
        return __PACKAGE__->new( products => \@adding );
    }

    sub total_price {
        my $self   = shift;
        my $amount = 0;

        for my $product ( @{ $self->products } ) {
            $amount += $product->price;
        }

        return $amount;
    }

    __PACKAGE__->meta->make_immutable();
}

1;
package DeliveryCharge {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;
    use List::Util;
    use lib qw/./;
    use ShoppingCart;

    use constant {
        CHARGE_FREE_THRESHOLD => 2000,
        PAY_CHARGE            => 500,
        CHARGE_FREE           => 0,
    };

    has shopping_cart => (
        is       => 'ro',
        isa      => 'ShoppingCart',
        required => 1,
    );

    has amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 0,
        builder  => "_builder_amount",
    );

    sub _builder_amount {
        my $self = shift;
        my $amount =
          $self->shopping_cart->total_price() < CHARGE_FREE_THRESHOLD
          ? PAY_CHARGE
          : CHARGE_FREE;
    }

    __PACKAGE__->meta->make_immutable();

}
1;

いやー、正直ここの部分(リスト14.14〜リスト14.19)は本に買いてあるコードを追っても全然わからず混乱。

結局、最後のリファクタリングが終わった後のコードを見て、何をするべきなのかを理解したという感じです。

このあとはリファクタリングする時に気をつける点として「機能追加とリファクタリングを同時に行わない」とか、あやふやな仕様を理解するための分析手法として「仕様化テスト」「思考リファクタリング」といった手法が紹介されています。

「良いコード/悪いコードで学ぶ設計入門」第11章 コメント 〜 12章 メソッド

久々に

経理の仕事において、四半期決算ってのは本当に大変なお仕事で、ほぼ1ヶ月持っていかれます。

翌月はそのリカバリでボーッとしているという感じでした。

(これはどうにかして負荷を軽減したいところ・・・)

その余波で「良いコード/悪いコードで学ぶ設計入門」を読み進めるのもすっかり止まってしまい、また書き方もだいぶ忘れてしまった・・・んですが、こういう時にちゃんと学習記録を書き残してあると安心ですね。

11章はコメントってことで、コード少なめ文章多めという感じです。

コードも Perl で書き直すほどのものではないという感じなので、サクサク読んでいきます。

11章 コメント

11.1 退化コメント

  • 情報が古くなり、実装を正しく説明しなくなったコメントを退化コメントという
  • コメントは(コードの)劣化コピーにすぎないので、意図が通じるクラス名の命名などが必要
  • ロジックの挙動をなぞるだけのコメントは退化しやすい

11.2 コメントで命名をごまかす

  • すごい文字数のメソッドが出てくる
    • 書き写したくない
  • メソッドの可読性を上げるとで、説明のコメントが不要になる

11.3 意図や仕様変更時の注意点を読み手に伝えること

  • 意図や指標変更時の注意点をコメントしよう

11.4 コメントルールのまとめ

11.5 ドキュメントコメント

  • ドキュメントコメント?って思ったけど、Perl だったら POD 、JavaScript だったら JSDoc みたいなものを言うらしい。知らんかった

12章 メソッド

12.1 必ず自身のクラスのインスタンス変数を使うこと

  • 例外もあるが、原則は「自身のクラスのインスタンス変数を使う」

  • 完全コンストラクタパターンを用いて、コンストラクタにガード節を用意する

  • 他のクラスのインスタンス変数を変更するメソッドを作らない
    • 変更したいんんスタンス変数を持つクラスにメソッドを実装する

12.2 不変をベースに予期せぬ動作を防ぐ関数にすること

  • オブジェクトのプロパティ書き換えるときも新しいプロパティ作ってそれを返す、みたいな感じかな

12.3 尋ねるな、命じろ

  • あるクラスがよそのクラスの状態を判断したり、状態に応じてよその値を変更したりするのは低凝集構造
  • getter / setter が多用されているコードはその状況になりやすい
  • メソッドの呼び出し側で複雑な処理をするのはでなく、呼び出される側で制御をするよう設計する

12.4 コマンド・クエリ分離

  • 初めて聞く
  • メソッドはコマンド(変更)、またはクエリ(問い合わせ)のどちらか一方だけを行うよう設計する
  • コマンドとクエリを同時に行うメソッド種別をモディファイアという
    • 知らんかった
    • モディファイアはなるべく避ける
  • そろそろコード書きたくなってきたので書いてみる
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;

use Function::Parameters;

fun gain_and_get_point($point){
    my $point += 10;
    return $point;
}

# モディファイア
my $origina_point = 0;
my $modifier = gain_and_get_point($origina_point);
say $modifier;  # 10

# コマンド・クエリ分離
fun gain_point($point){
    $point += 10
}

fun gat_point($point){
    return $point;
}

my $gain_pint = gain_point($origina_point);
say gat_point($gain_pint);  # 10

12.5 引数

  • 引数は不変にすること
  • フラグ引数は使わない
    • 切り替え機構はストラテジパターンを利用する
  • null を渡さない
    • 例)未装備状態を null ではなく、 Eqipment.EMPTY で表現する
  • 出力引数を使わない
  • 引数は限りなく少なくする

12.6 戻り値

  • 型を使って戻り値の意図を表明すること
    • プリミティブ型を使わず、独自の型を使って戻り値の意図を明確に表明する
  • 引数に null を渡さないように、null を返さない
  • エラーは戻り値で返さず、例外にする

と、12章はここまで。次の13章も文章が多い感。

macOS Monterey で IO::Socket::SSL, Net::SSLeay のインストールに失敗する

何度目かの環境再構築中

色々あって、業務で利用している Macbook Pro 2017 をリカバリすることにしました。

ディスクユーティリティで SSD を一旦まっさらに。

そこに macOS Monterey をネットワーク経由でクリーンインストール

ちょうど経理の月初作業も終わり、お盆休みもあったので落ち着いて環境構築を進めることができました。

自作モジュールのインストールでエラー

この自作モジュールは業務を楽にするために自分で作ったもので、以下のような動きをします。

  1. Google Sheet を csv にしてダウンロード
  2. ダウンロードした csv から数値を抜き出す
  3. 抜き出した数字に応じて画像生成

この "Google Sheet を csv にしてダウンロード" の時に(透過的に)利用するモジュールが IO::Socket::SSL です。 文字通り、SSL通信に関係するモジュールです。

これのインストールに失敗しました。

$ cpanm IO::Socket::SSL
--> Working on IO::Socket::SSL
Fetching http://www.cpan.org/authors/id/S/SU/SULLR/IO-Socket-SSL-2.074.tar.gz ... OK
==> Found dependencies: Net::SSLeay
--> Working on Net::SSLeay
Fetching http://www.cpan.org/authors/id/C/CH/CHRISN/Net-SSLeay-1.92.tar.gz ... OK
Configuring Net-SSLeay-1.92 ... N/A
! Configure failed for Net-SSLeay-1.92. See /Users/sironekotoro/.cpanm/work/1660879857.14507/build.log for details.
! Installing the dependencies failed: Module 'Net::SSLeay' is not installed
! Bailing out the installation for IO-Socket-SSL-2.074.

IO::Socket::SSL が依存している Net::SSLeay のインストールに失敗してるようです。 ログはここに出力されているので確認。

! Configure failed for Net-SSLeay-1.92. See /Users/sironekotoro/.cpanm/work/1660879857.14507/build.log for details.

失敗時のログはこんな感じ。

cpanm (App::cpanminus) 1.7046 on perl 5.036000 built for darwin-2level
Work directory is /Users/sironekotoro/.cpanm/work/1660879879.14561
You have make /usr/bin/make
You have /usr/local/bin/wget
You have /usr/bin/tar: bsdtar 3.5.1 - libarchive 3.5.1 zlib/1.2.11 liblzma/5.0.5 bz2lib/1.0.8 
You have /usr/bin/unzip
Searching Net::SSLeay () on cpanmetadb ...
--> Working on Net::SSLeay
Fetching http://www.cpan.org/authors/id/C/CH/CHRISN/Net-SSLeay-1.92.tar.gz
-> OK
Unpacking Net-SSLeay-1.92.tar.gz
Entering Net-SSLeay-1.92
Checking configure dependencies from META.json
Checking if you have ExtUtils::MakeMaker 6.58 ... Yes (7.64)
Checking if you have English 0 ... Yes (1.11)
Checking if you have constant 0 ... Yes (1.33)
Checking if you have File::Spec::Functions 0 ... Yes (3.84)
Checking if you have Text::Wrap 0 ... Yes (2021.0814)
Configuring Net-SSLeay-1.92
Running Makefile.PL
Do you want to run external tests?
These tests *will* *fail* if you do not have network connectivity. [n] n
*** Be sure to use the same compiler and options to compile your OpenSSL, perl,
    and Net::SSLeay. Mixing and matching compilers is not supported.

******************************************************************************
* COULD NOT FIND LIBSSL HEADERS                                              *
*                                                                            *
* The libssl header files are required to build Net-SSLeay, but they are     *
* missing from /usr. They would typically reside in /usr/include/openssl.    *
******************************************************************************
-> N/A
-> FAIL Configure failed for Net-SSLeay-1.92. See /Users/sironekotoro/.cpanm/work/1660879879.14561/build.log for details.

まぁ、原因はわかっていて。

macOS Monterey が採用している SSL のライブラリは LibraSSL というものです。

$ openssl version
LibreSSL 2.8.3

対して、IO::Socket::SSL が要求しているのは OpenSSL というライブラリです。

エラーログのここですね。

******************************************************************************
* COULD NOT FIND LIBSSL HEADERS                                              *
*                                                                            *
* The libssl header files are required to build Net-SSLeay, but they are     *
* missing from /usr. They would typically reside in /usr/include/openssl.    *

ということで、macでお馴染みのパッケージマネージャ Homebrew で openSSL をインストールします。

$ brew install openssl

openSSL のインストール後、無事 IO::Socket::SSL のインストールが完了。

めでたしめでたし。

なぜこれを書いたのか

何度目かのインストールで毎回やってるなぁ・・・と思ったのと、割と MacPerl やってて引っかかりやすいところかなぁ、と思ったので。