Perl楽しいから好き

Perlをはじめとしたプログラミング周りのあれこれについて。モダーンなPerlを楽しんでいます。

Perlで、とある配列を指定した要素数ごとに別の配列リファレンスに分割する処理をList::MoreUtilsモジュールで書き直してみた

『初めてのPerl 第7版』を練習問題もこなしつつ、自分史上最高なんじゃないかというくらい丁寧に読み進めています。この本、過去の版のものを何度か読んでたんですが、ビット演算子とかプロセス管理とか新しい学びがいっぱい。ホントに適当に読んでたんだなーと反省してます。

で、16章の5項に先日書いたコレ
 ↓

perl48.hatenablog.com


をもっとシンプルに実現できそうなモジュールが紹介されてました。


紹介されてたのは、List::MoreUtilsモジュールのnatatimeというサブルーチンです。早速前回書いたコードを書き換えてみます。

まずはテストから。前回と異なるのは、natatime 使うと分割した時に端数(13個の要素の配列を3つずつに分割したときの残り1個)もちゃんと拾ってくれるところです。ということでテストの期待する結果($expected)部分を書き直しました。

#!/usr/bin/env perl
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib";
use Test::More tests => 2;

BEGIN {use_ok('MyArrayUtility')}

# MyArrayUtility::divide_arrayのテスト
my @arr = (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13);
my $arr_ref = \@arr;
my $item_number_in_list = 4;
my $divided_arr_ref = MyArrayUtility::divide_array($arr_ref, $item_number_in_list);
my $expected = [
    [ 1, 2, 3, 4 ],
    [ 5, 6, 7, 8 ],
    [ 9, 10, 11, 12 ],
    [ 13 ],
];
is_deeply($divided_arr_ref, $expected, 'divide_array');

実処理部分はこんな感じ。
 ↓

package MyArrayUtility;

use strict;
use warnings;
use utf8;
use List::MoreUtils qw/natatime/;

# 配列を指定した要素数ごとに別の配列に分割する処理
sub divide_array {
    my ($arr_ref, $item_number_in_list) = @_;
    my $iterator = natatime $item_number_in_list, @$arr_ref;

    # 結果を格納する配列リファレンス
    my $divided_arr_ref = [];

    while (my @divided = $iterator->()) {
        push(@{$divided_arr_ref}, \@divided);
    }

    return $divided_arr_ref;
}


1;


前よりもスッキリしてイイ感じ。
テスト書いておくと、リファクタリングが楽でイイですねー。

Perlの正規表現を使って、HTMLの中にあるJavascript部分を取り除いてみた。

HTMLの中のコンテンツ部分だけ抽出したい、という欲望がムクムクと湧いてきたのでPerl正規表現で書いてみました。これまでも、HTMLタグを取り除く処理は書いたことあるんですが、「欲張りでない量指定子」(Non-Greedy Matches)が理解できてなかったので、Javascriptの中身が残ってしまうといった失敗をしていました。『初めてのPerl』(リャマ本)7章~9章を読み直して、だいぶ理解できた気がする。

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use feature qw/say/;
use Encode qw/encode/;

my $html;

while(<DATA>){
    chomp;
    $html .= $_;
}

# javascript部分を除去
$html =~ s#<script.*?>.*?</script>##gis;

# Windowsコマンドプロンプトに出力するのでCP932にエンコード
say encode('cp932', $html);

__DATA__
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="X-UA-Compatible" content="IE=edge">
<title>Perlの正規表現、ステキやん。</title>
<meta charset="utf-8">
<meta name="description" content="Perlの正規表現は強力です。文字列処理がはかどりまくり。">
<meta name="author" content="kamiokan">
<meta name="viewport" content="width=device-width, initial-scale=1">
<link rel="stylesheet" href="">
<!--[if lt IE 9]>
<script src="//cdn.jsdelivr.net/html5shiv/3.7.2/html5shiv.min.js"></script>
<script src="//cdnjs.cloudflare.com/ajax/libs/respond.js/1.4.2/respond.min.js"></script>
<![endif]-->
<link rel="shortcut icon" href="">
</head>
<body>
コンテンツ部分。

Perlの正規表現は強力です:)
<script src="./hoge.js" type="text/javascript"></script>

<script>
 Javascript...
</script>

<!--
<script>
 Javascript...
</script>
-->

<script type="text/javascript">
 Javascript...
</script>

</body>
</html>

↑よく目にするHTML内のJavascriptの記述を数パターン用意してあります。ごく稀にですが、Javascript部分のタグを「SCRIPT」という風に大文字で書く猛者がいるので、/i修飾子を付けてあります。

<!DOCTYPE html><html><head><meta http-equiv="X-UA-Compatible" content="IE=edge"><title>Perlの正規表現、ステキやん。</title><meta charset="utf-8"><meta name="descri
ption" content="Perlの正規表現は強力です。文字列処理がはかどりまくり。"><meta name="author" content="kamiokan"><meta name="viewport" content="width=device-width, i
nitial-scale=1"><link rel="stylesheet" href=""><!--[if lt IE 9]><![endif]--><link rel="shortcut icon" href=""></head><body>コンテンツ部分。Perlの正規表現は強力です
:)<!----></body></html>

↑結果はこんな感じです。Javascript部分が綺麗に取り除けました。

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use feature qw/say/;
use Encode qw/encode/;

my $html;

while(<DATA>){
    chomp;
    $html .= $_;
}

# コメント部分も除去
$html =~ s#<!--.*?-->##gs;

# javascript部分を除去
$html =~ s#<script.*?>.*?</script>##gis;

# htmlタグも除去
$html =~ s#</?.*?>##gs;

# Windowsコマンドプロンプトに出力するのでCP932にエンコード
say encode('cp932', $html);

__DATA__
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="X-UA-Compatible" content="IE=edge">
<title>Perlの正規表現、ステキやん。</title>
<meta charset="utf-8">
<meta name="description" content="Perlの正規表現は強力です。文字列処理がはかどりまくり。">
<meta name="author" content="kamiokan">
<meta name="viewport" content="width=device-width, initial-scale=1">
<link rel="stylesheet" href="">
<!--[if lt IE 9]>
<script src="//cdn.jsdelivr.net/html5shiv/3.7.2/html5shiv.min.js"></script>
<script src="//cdnjs.cloudflare.com/ajax/libs/respond.js/1.4.2/respond.min.js"></script>
<![endif]-->
<link rel="shortcut icon" href="">
</head>
<body>
コンテンツ部分。

Perlの正規表現は強力です:)
<script src="./hoge.js" type="text/javascript"></script>

<script>
 Javascript...
</script>

<!--
<script>
 Javascript...
</script>
-->

<script type="text/javascript">
 Javascript...
</script>

</body>
</html>

↑せっかくなので、HTMLタグとかも除去します。

Perlの正規表現、ステキやん。コンテンツ部分。Perlの正規表現は強力です:)

↑結果はコチラ。コンテンツだけキレイに抜き取ることができました。


Perlは本当に手軽で便利だから好きです。

Perlで、とある年月を引数に与えるとその月の年月日をYYYYMMDD形式の配列リファレンスで返してくれるサブルーチンをテストから書いてみた

やりたいこと

'201808' 

↑みたいな引数を渡したら、

[
    qw(
        20180801 20180802 20180803 20180804 20180805 20180806 20180807 20180808 20180809 20180810
        20180811 20180812 20180813 20180814 20180815 20180816 20180817 20180818 20180819 20180820
        20180821 20180822 20180823 20180824 20180825 20180826 20180827 20180828 20180829 20180830
        20180831
    )
]

↑みたいな配列リファレンスを返してくれるサブルーチンが欲しい!運用中のWEBアプリの集計作業のためにどうしても欲しい!ということでTime::Pieceモジュールとかで、サクッとできるメソッドがあるかな~と探してみましたが無いっぽいので書くことに。

テスト部分

まずは、テストから。テストを書くことで安心感が得られます。さらに、今回はテストを書いたことで、東京オリンピック開催の2020年がうるう年だということに気づきました。いいことずくめ。

#!/usr/bin/env perl
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib";
use Test::More tests => 5;

BEGIN {use_ok('MyDateTimeUtility')}

# 31日ある月のテスト
my @expected_31 = qw(
    20180801 20180802 20180803 20180804 20180805 20180806 20180807 20180808 20180809 20180810
    20180811 20180812 20180813 20180814 20180815 20180816 20180817 20180818 20180819 20180820
    20180821 20180822 20180823 20180824 20180825 20180826 20180827 20180828 20180829 20180830
    20180831
);
is_deeply(MyDateTimeUtility::get_yyyymmdd_in_month(yyyymm => '201808'), \@expected_31, 'test 31 days');

# 30日ある月のテスト
my @expected_30 = qw(
    20180901 20180902 20180903 20180904 20180905 20180906 20180907 20180908 20180909 20180910
    20180911 20180912 20180913 20180914 20180915 20180916 20180917 20180918 20180919 20180920
    20180921 20180922 20180923 20180924 20180925 20180926 20180927 20180928 20180929 20180930
);
is_deeply(MyDateTimeUtility::get_yyyymmdd_in_month(yyyymm => '201809'), \@expected_30, 'test 30 days');

# 28日ある月のテスト
my @expected_28 = qw(
    20180201 20180202 20180203 20180204 20180205 20180206 20180207 20180208 20180209 20180210
    20180211 20180212 20180213 20180214 20180215 20180216 20180217 20180218 20180219 20180220
    20180221 20180222 20180223 20180224 20180225 20180226 20180227 20180228
);
is_deeply(MyDateTimeUtility::get_yyyymmdd_in_month(yyyymm => '201802'), \@expected_28, 'test 28 days');

# 29日ある月(うるう年)のテスト
my @expected_29 = qw(
    20200201 20200202 20200203 20200204 20200205 20200206 20200207 20200208 20200209 20200210
    20200211 20200212 20200213 20200214 20200215 20200216 20200217 20200218 20200219 20200220
    20200221 20200222 20200223 20200224 20200225 20200226 20200227 20200228 20200229
);
is_deeply(MyDateTimeUtility::get_yyyymmdd_in_month(yyyymm => '202002'), \@expected_29, 'test 29 days');

実処理部分

month_last_day メソッドのおかげで、月末日取得がとっても楽チン。

package MyDateTimeUtility;

use strict;
use warnings;
use Time::Piece;

sub get_yyyymmdd_in_month {
    my %argv = @_;
    my $yyyymm = $argv{yyyymm};
    my $t = Time::Piece->strptime($yyyymm, '%Y%m');
    my $last_day = $t->month_last_day;

    # 結果を格納する配列リファレンス
    my $yyyymmdd_ref = [];

    my $i = 0;
    while ($i < $last_day) {
        my $date = $i + 1;

        # 1桁の日付の場合、1=>01みたいに2桁に揃える
        $date = sprintf "%02d", $date;
        push @$yyyymmdd_ref, $yyyymm . $date;

        $i++;
    }

    return $yyyymmdd_ref;
}

1;

ディレクトリ構成

C:.
+---lib
|       MyDateTimeUtility.pm
|
\---t
        get_yyyymmdd_in_month.t

Time::Piece は、いつから標準モジュールなのか?

メッチャ便利なTime::Pieceモジュール。Perlで書くときの日時関係はこれメインで使わせてもらってます。で、いつから標準モジュールになってるのかな~?と気になったので調べてみました。こんなときはワンライナー

C: >  perl -MModule::CoreList -E "say Module::CoreList->first_release_by_date('Time::Piece');"

気になる結果は・・・

5.009005

バージョン5.9から入ってるみたいですね。意外と古くからあってビックリ。

Perlで、とある配列を指定した要素数ごとに別の配列リファレンスに分割する処理

my @arr = (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13);

↑ こういう感じの配列を、

my $expected = [
    [ 1, 2, 3, 4 ],
    [ 5, 6, 7, 8 ],
    [ 9, 10, 11, 12 ]
];

↑ こういう感じに分割したい欲望に駆られました。この場合は、13個の要素を持つ配列を4つの要素ずつの配列リファレンスに分割(端数は切り捨て)

で、テストから書きました。

#!/usr/bin/env perl
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib";
use Test::More tests => 2;

BEGIN {use_ok('MyArrayUtility')}

# MyArrayUtility::divide_arrayのテスト
my @arr = (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13);
my $arr_ref = \@arr;
my $item_number_in_list = 4;
my $divided_arr_ref = MyArrayUtility::divide_array($arr_ref, $item_number_in_list);
my $expected = [
    [ 1, 2, 3, 4 ],
    [ 5, 6, 7, 8 ],
    [ 9, 10, 11, 12 ]
];
is_deeply($divided_arr_ref, $expected, 'divide_array');


実処理部分はこんな感じで。

package MyArrayUtility;

use strict;
use warnings;
use utf8;

# 配列を指定した要素数ごとに別の配列に分割する処理
sub divide_array {
    my ($arr_ref, $item_number_in_list) = @_;
    my $count = @$arr_ref;

    # スライスしてできる配列の数(端数は切り捨て)
    my $array_num = int($count / $item_number_in_list);

    # 結果を格納する配列リファレンス
    my $divided_arr_ref = [];

    my $i = 0;
    my $j = 0;
    while ($i < $array_num) {
        while ($j < $item_number_in_list) {
            push(@{$divided_arr_ref->[$i]}, shift(@$arr_ref));
            $j++;
        }
        $i++;
        $j = 0;
    }

    return $divided_arr_ref;
}


1;

ディレクトリ構成はこんな感じで慣習通りに。

C:.
+---lib
|       MyArrayUtility.pm
|
\---t
        my_array_utility.t

なんか、もう少しスマートに書ける気がするけど、とりあえず要件は満たしているのでOKかな。

リファレンスがやっとわかり始めてきました。

Perl6の猫オペレーター、カワ(・∀・)イイ!!

#!/usr/bin/perl6

say @(0 ^..^ 9); # → (1 2 3 4 5 6 7 8)

↑ 猫がいる!

Perl初心者な私でも、CPANテスターとしてオープンソースに貢献できた!

きっかけ

今まで気になりつつも、やったことなかったんですが、

moznionさんの2013年のスライド↓

YAPC::Asia 2013 - CPAN Testers Reports の情報を上手に使う

https://www.slideshare.net/moznion/yapc2013-26371522

www.slideshare.net


↑ の88枚目を見て、簡単そうなのでCPANモジュールのテストやってみました。


普段からApp::cpanminusでモジュールのインストールしてるなら超簡単にできます。

手順は簡単4ステップ。

ちなみにWindows10でやってみました。

手順

(1)まずは、App::cpanminus::reporterというモジュールをインストール。
C:\Users\kamioka>cpanm App::cpanminus::reporter
(2)報告者の情報をセットアップします。といっても名前とメールアドレスを指定する程度です。
C:\Users\kamioka>cpanm-reporter --setup
(3)Mojoliciousをテストします。
C:\Users\kamioka>cpanm --test-only Mojolicious

私の環境には既にMojoliciousがインストール済なので、オプションの「--test-only」を付けました。テストと合わせてモジュールのインストールも行う場合は「--test-only」無しでOKです。

(4)インストール結果を送ります。自分のパソコンの実行環境と合わせてインストールがうまくいったかどうかがCPANテスターズに送信されます。
C:\Users\kamioka>cpanm-reporter

CPANテスターになった日

送信してから数時間すると、

f:id:perl48:20180719010431j:plain

http://matrix.cpantesters.org/?dist=Mojolicious;os=mswin32;reports=1http://matrix.cpantesters.org/?dist=Mojolicious;os=mswin32;reports=1



↑こんな感じでテスト結果が反映されます。自分の名前が載ると、貢献できたなって気がします。


そして、Linux環境に比べてWindows環境のテスターが少ない感じ。

なので、WindowsPerlを使ってるならモジュールインストールがてらCPANテストもすると貢献度が高い気分に浸れます。



これで、私もCPANテスターの仲間入りっ!


ノースキルな私でもモブキャラ的な立ち位置から、Perl界隈に貢献できちゃいました。




この仕組み、いいねっ!

Perlでuse utf8したまま明示的に半角スペースを全角スペースに置き換える

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use 5.010;
use Encode qw(encode);

# 半角スペースを明示的に全角スペースにする
my $str = "ニューヨーク シティボーイ";
say encode('utf8', $str); # ニューヨーク シティボーイ
$str =~ s/\s/\x{3000}/g;
say encode('utf8', $str); # ニューヨーク シティボーイ

データベースに登録された氏名の苗字と名前の間が全角スペースのものがある。で、検索フォームから苗字と名前の間を半角スペースで入力した時にマッチさせたい、という要望に応えるために書きました。

use utf8プラグマを書くと \s が半角スペースにも全角スペースにもマッチする、というのは単純にスペース除去するときは便利。なんだけど、半角スペース←→全角スペースを置き換えたいとき、ちょっとつまづいちゃいました。

my $full_space = "\x{3000}";

↑このコードポイント表現で全角スペースを示せるので、それを使いました。

2018/7/21 追記

jitojitoさん、コメントありがとうございます。確かに半角スペースのみを厳密に指定するなら、そっちもコードポイントで記述するのがいいですね。

Perlでuse utf8したまま明示的に半角スペースを全角スペースに置き換える - Perl楽しいから好き

\s はタブ文字なども含まれますので、半角空白のみなら /\x{0020}/\x{3000}/ とするほうが良いかもしれません。

2018/07/21 10:07

ということで書き直してみました。
 ↓

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use 5.010;
use Encode qw(encode);

# 半角スペースを明示的に全角スペースにする
my $str = "ニューヨーク シティボーイ";
say encode('utf8', $str); # ニューヨーク シティボーイ
$str =~ s/\x{0020}/\x{3000}/g;
say encode('utf8', $str); # ニューヨーク シティボーイ


イイ感じになりました。ありがとうございます!