Perl楽しいから好き

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

PerlでHTMLファイルのmetaタグを読んで文字コードを判定する処理を書いてみた

300個以上の静的htmlファイル内のリンクを一括で置き換える事案に遭遇。単純に置き換えすると文字化けする。なぜなら、shift-jisとutf-8が混在しているから。ファイルの編集者が別なので、文字コードを統一することはできない。ということで、Perlの出番です!

HTMLのheader内にcharsetの定義はされているので、そこを読み込んで文字コードを判定する処理を書いてみました。

File::Slurp::read_file() でファイル読み込みするのがマイブームです。

#!/usr/bin/env perl

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

use File::Slurp qw/read_file/;

# .html と .htm が混在してるので、両方拾う
my @html_files = glob "*.html *.htm";

foreach (@html_files) {

    my $text = read_file($_);
    my $charset = "unknown";
    if ($text =~ /charset="UTF-8"/i){
        $charset = "UTF8";
    } elsif ($text =~ /charset=shift_jis"/i){
        $charset = "Shift-JIS";
    }
    say $_, " => ", $charset;
}

実行してみる

f:id:perl48:20180909162552p:plain

↑ こんな感じのフォルダで実行してみます。

f:id:perl48:20180909162630p:plain

↑ 期待通り、文字コードを判定して表示できてますね。


前処理として文字コード判定してから、「読み込み→デコード→置き換え→エンコード→書き出し」することで文字化けすることなくタスクを完了しました。


退屈なことはPerlにやらせよう!

Perlで2つの配列を比較し、重複する要素の数をカウントする処理を書いてみた

「6月に来店したお客様のうち、7月に何名の方がリピートしてくださったか?」といった数字を拾いたい事象が発生。6月の来店済み顧客IDの配列と7月の来店済み顧客IDの配列を比較して重複分を拾えばいいじゃない!ということで、書きました。foreachを2重にするのは、「なんか違う」と思って調べたら、こんな感じに仕上がりました。

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 1;

# 2つの配列のうち重複する要素の数を取得
# @param array_ref $array_a_ref 比較したい配列1
# @param array_ref $array_b_ref 比較したい配列2
# @return int $result_count 重複する要素数
sub get_duplicate_count {
    my ($array_a_ref, $array_b_ref) = @_;
    my %count;
    my @result;
    # 2つの配列の要素を、要素をキーにしたハッシュに格納
    $count{$_}++ for (@$array_a_ref, @$array_b_ref);
    # 要素数が2以上のもの(重複するやつ)のみ抽出
    @result = grep {$count{$_} >= 2} keys %count;
    my $result_count = @result;
    return $result_count;
}

my @arr_a = qw(1 2 3 4 5 6 7 8 9 10);
my @arr_b = qw(2 4 6 8 10);

is(get_duplicate_count(\@arr_a, \@arr_b), 5, 'test count duplicate');

先日、Javaを書いてて「配列の要素の重複を消したい」ってなりました。で、Listで作ったコレクションをSetインターフェースに変換するだけで重複が消えたときは、「魔法かよ」って思った。プログラミング言語によって色々とやり方のバリエーションがあるんだなぁ、と実感。

静的型付け言語と関数型言語を、掘り下げてみたいという欲求が上がった。

Perlでランダムで0から9の数字を出して、すべての数字が揃ったら終わるという処理を書いてみた。

プログラミングの地力を上げたいなぁと思い、数学パズルっぽいのをコードで解いています。棋力を上げるために詰将棋を解くようなノリです。ある問題を解くために「0から9の数字が全て出てきたら終了」という処理が欲しかったので書いてみました。

use strict;
use warnings;
use feature qw/say/;
use utf8;
use Data::Dumper;

# 0から9の配列を作って、出た数字を抜いていき、空になったら終わる作戦
my @array = qw(0 1 2 3 4 5 6 7 8 9);

my @temp_arr = @array;

my $count = 0;
while (@temp_arr) {
    my $random_one = int(rand 10);

    # 出た数字を確認
    say $random_one;

    # 出た数字を抜いていく
    @temp_arr = grep {$_ != $random_one} @temp_arr;

    # 配列の要素が減っていく様子を確認
    say Dumper @temp_arr;
    $count++;
}

# 何回ループしたかを確認
say "$count times Loop.";
say "Finish!";

Perlの文法だけじゃなくって、データ構造どうすれば解けるのか?ってところに思いを馳せれるようになってきてて、イイ感じ。

Perlで300ページ以上の静的HTMLファイルの「http://」を「https://」に一気に置き換える。バックアップファイルを保存しながら、ね。

2018年7月某日、グーグルがSSL/TLS未対応サイト絶対許さんマンになってから、「うちのサイトもなんとかしてほしい」という問い合わせが増えてきました。「保護されていない通信」とかデカデカと表示されたら、流石に焦りますよね。

オープンソースのおかげで、無料だったり、年間1000円くらいの安価なサーバー証明書も充実してきたので、割と気軽にSSL化できちゃいます。いい時代です。そんな中、静的HTMLファイル内のリンクを大量に書き換えなきゃな案件が出てきました。WordPressとかだったら「Search Regex」とかのプラグインでサクッと置き換えちゃえばOKですが、静的HTMLだとそうはいきません。こんなときは・・・

そうです、Perlの出番です!


ということで、とりあえず欲しい結果が得られるスクリプトをサクッと書いて対応しました。

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use feature qw/say/;
use Encode qw/encode decode/;
use File::Copy qw/copy/;

# カレントディレクトリの「 *.html 」を取得
my @files = glob('*.html');

# 取得したファイルを標準出力で確認
say for @files;

foreach (@files) {
    # 拡張子に「 .bak 」を足してバックアップ保存
    copy($_, $_ . '.bak') or die "Can't copy: $!";

    open my $fh, '<', $_
        or die "Can't open $_: $!";

    my @html = <$fh>;

    open my $fh_out, '>', $_
        or die "Can't open $_: $!";

    foreach(@html){
        $_ = decode('utf8', $_);
        $_ =~ s#http://example.com/#https://example.com/#g;
        print $fh_out encode('utf8', $_);
    }
}


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から入ってるみたいですね。意外と古くからあってビックリ。