sironekotoroの日記

Perl と Mac の初心者の備忘録

ある月の最後の平日を求める

ってことでこんにちは。休日になると仕事のスクリプト作成が捗りますね。

なぜか仕事のある平日はそうでもないのですが・・・

その月の最後の平日を求めたい理由

経理の世界では・・・と主語を大きく言いたいところですが、経理は各会社それぞれの色が強く出るところなので「今の業務では」と言っておきます。

まぁ、矛盾のない貸借対照表損益計算書が出てくれば、その過程は問われないというというのはあります。もちろん説明責任はあります。

今の業務では、ある月に発生した未払金(翌月払い等)は経理上、末日付で未払金計上します。クレカとか、AWSの利用料とか。

6月のAWS使用料金が20,000円だった場合の仕訳例です。未払金は翌月以降に支払うお金なので、末日が平日であろうが休日であろうがかまいません。

日付 借方 貸方 摘要
2020/06/30 支払手数料 20,000 未払金 20,000 AWS 6月分使用料

これを7月末に支払いすると、このような仕訳になります。この支払日は銀行営業日、つまり平日である必要があります。

銀行の通帳に記録される増減と仕訳上の記録を合わせておく必要があるためです。合わせないと照合作業が面倒すぎて死ねますね。

日付 借方 貸方 摘要
2020/07/31 未払金 20,000 普通預金 20,000 AWS 6月分使用料

この「その月の最後の平日」、支払の仕訳の「2020/07/31」を楽に求めたい!

特に経理ソフト上でコツコツ入力せず、csv作ってまとめて一発登録!みたいなのやっている自分だと特に!!

その月の最後の平日を求める

実際には Google Apps Script 、つまりJavaScript で書いてたんですが Perl のコードで書いてみます。

まず、日時を扱う Time::Piece で日時のオブジェクトを作成します。

オブジェクトは、「データと、そのデータを扱う関数が一緒になったもの」という説明をしておきます。

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

use Time::Piece;

# 2020年7月でTime::Pieceオブジェクトを作る
my $t = Time::Piece->strptime("2020-07", '%Y-%m');

# 7月の最終日を求める
my $day = $t->month_last_day();
print "last day of month: ", $day . "\n";# 31

# 2020年7月最終日のTime::Pieceオブジェクトを作る
my $last_date = Time::Piece->strptime("2020-07-$day", '%Y-%m-%d');

# 最終日の曜日を求める
# 0: 日曜 〜 6: 土曜
print "day of week: ", $last_date->day_of_week . "\n";# 5

2020年7月31日は金曜日なので $last_date->day_of_week の結果は 5 が返ります。

ふむふむ、つまり、最終日が日曜日( $last_date->day_of_week0)か土曜日( $last_date->day_of_week6)だったら前日を設定し、もう一回判定して・・・とやればいいな?と目星をつけます。

前日を設定するのは、 Time::Seconds モジュールの ONE_DAY 使いますかね。楽だし。

$yesterday = $today - ONE_DAY; こんな感じ。

なお、日本の休日&会社の休日は考慮しません。面倒なので・・・

で、最初に作ったのがこれです。while ループのところに安全策で count によるループ抜けを仕掛けておきます。

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

use Time::Piece;
use Time::Seconds qw/ONE_DAY/;

# 2020年7月でTime::Pieceオブジェクトを作る
my $t = Time::Piece->strptime("2020-07", '%Y-%m');

# 7月の最終日を求める
my $day = $t->month_last_day();
print "last day of month: ". $day . "\n";# 31

# 2020年7月最終日のTime::Pieceオブジェクトを作る
my $last_date = Time::Piece->strptime("2020-07-$day", '%Y-%m-%d');

# 最終日の曜日を求める
# 0: 日曜 〜 6: 土曜
print "day of week: ". $last_date->day_of_week . "\n";# 5

my $count = 0;
while ($last_date->day_of_week == 0 || $last_date->day_of_week == 6){

    $last_date = $last_date - ONE_DAY;  # Time::Pieceオブジェクトを1日前にする

    if ($count > 7){
        last;
    }
    $count++;
}

print 'last normal day: '. $last_date->ymd . "\n";  # last normal day: 2020-07-31

7月は一見うまくいったように見えます・・・というか、7月末日は平日なので while ループ通りません。

2020年10月の末日は31日で土曜日です。30日が帰ってくれば大丈夫です。これでやってみましょう。

ついでに、年と月も変数にしておきます。

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

use Time::Piece;
use Time::Seconds qw/ONE_DAY/;

my $year = 2020;
my $month = 10;

my $t = Time::Piece->strptime("$year-$month", '%Y-%m');

# 最終日を求める
my $day = $t->month_last_day();
print "last day of month: ", $day . "\n";# 31

# 最終日のTime::Pieceオブジェクトを作る
my $last_date = Time::Piece->strptime("$year-$month-$day", '%Y-%m-%d');

# 最終日の曜日を求める
# 0: 日曜 〜 6: 土曜
print "day of week: ", $last_date->day_of_week . "\n";# 5

my $count = 0;
while ($last_date->day_of_week == 0 || $last_date->day_of_week == 6){

    $last_date = $last_date - ONE_DAY;  # Time::Pieceオブジェクトを1日前にする

    if ($count > 7){
        last;
    }
    $count++;
}

print 'last normal day: '. $last_date->ymd . "\n";  # last normal day: 2020-10-30

大丈夫っすね。

これでいいかなー、というところですが、日曜日のパターンもやっておきましょう。

2021年1月は末日が31日で日曜日です。1月29日が帰ってくれば正解です。さて・・・?

あまり代わり映えしないので折りたたみ

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

use Time::Piece;
use Time::Seconds qw/ONE_DAY/;

my $year = 2021;
my $month = 1;

my $t = Time::Piece->strptime("$year-$month", '%Y-%m');

# 最終日を求める
my $day = $t->month_last_day();
print "last day of month: ", $day . "\n";# 31

# 最終日のTime::Pieceオブジェクトを作る
my $last_date = Time::Piece->strptime("$year-$month-$day", '%Y-%m-%d');

# 最終日の曜日を求める
# 0: 日曜 〜 6: 土曜
print "day of week: ", $last_date->day_of_week . "\n";# 5

my $count = 0;
while ($last_date->day_of_week == 0 || $last_date->day_of_week == 6){

    $last_date = $last_date - ONE_DAY;  # Time::Pieceオブジェクトを1日前にする

    if ($count > 7){
        last;
    }
    $count++;
}

print 'last normal day: '. $last_date->ymd . "\n";  # last normal day: 2021-12-31

大丈夫そうです。

それでも祝日とか会社の休みとかを考慮したい!

Perl のモジュールでも同様の動機で作られたモジュールがあります。そういうの使うのもいいと思います。

せっかくなので、先のコードを変えてみましょう。

対象は2020年の年末としますかねー。

12月の末日は31日ですが、会社は28日から休みって事にしておきますか。ホワイト会社だ!

この場合の最後の平日は12月25日になります。最高ですね。あ、でも経理の月末の仕事溜まって大変になりそうでダメだ(経理脳)

従来のコードは while ループに入る条件が、土曜日か日曜日というものだったので、これを変更するところから。

while を無限ループにして、条件によってループを抜ける、と変更します。大連休も考慮して、安全策のループ抜けは30日にしておきます。

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

use Time::Piece;
use Time::Seconds qw/ONE_DAY/;

my $year  = 2020;
my $month = 12;

my $t = Time::Piece->strptime( "$year-$month", '%Y-%m' );

# 最終日を求める
my $day = $t->month_last_day();
print "last day of month: ", $day . "\n";    # 31

# 最終日のTime::Pieceオブジェクトを作る
my $last_date = Time::Piece->strptime( "$year-$month-$day", '%Y-%m-%d' );

# 最終日の曜日を求める
# 0: 日曜 〜 6: 土曜
print "day of week: ", $last_date->day_of_week . "\n";    # 5

my $count = 0;
while (1) {

    if ( $last_date->day_of_week == 0 || $last_date->day_of_week == 6 ) {

        $last_date = $last_date
            - ONE_DAY;    # Time::Pieceオブジェクトを1日前にする
    }

    if ( $count > 30 ) {
        last;
    }
    $count++;
}

print 'last normal day: '
    . $last_date->ymd
    . "\n";               # last normal day: 2021-01-29

表示結果だけ見るとうまくいってるように見えますが、安全策のループがなかったら無限ループしています。

というわけで、ちゃんとループの終了判定入れて、スクリプト内に書いた祝日の日付があったら平日とみなさずに飛ばすようにしてみました。

もし、もっと手を掛けたくない!ってなったら、Google Calenderに「日本の祝日」「会社の祝日」のデータを登録して、それを引っ張ってくるとかやるかもしれません・・・が今日はやりません。

気休めのつもりが2時間くらいかかってしまってるので・・・

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

use Time::Piece;
use Time::Seconds qw/ONE_DAY/;

my $year  = 2020;
my $month = 12;

# 休日を設定
my $holiday = [ '2020-12-28', '2020-12-29', '2020-12-30', '2020-12-31' ];

my $t = Time::Piece->strptime( "$year-$month", '%Y-%m' );

# 最終日を求める
my $day = $t->month_last_day();
print "last day of month: ", $day . "\n";    # 31

# 最終日のTime::Pieceオブジェクトを作る
my $last_date = Time::Piece->strptime( "$year-$month-$day", '%Y-%m-%d' );

# 最終日の曜日を求める
# 0: 日曜 〜 6: 土曜
print "day of week: ", $last_date->day_of_week . "\n";    # 5

my $count = 0;
while (1) {

    # 設定した休日と同じymdだったらnext
    if ( grep { $_ eq $last_date->ymd } @{$holiday} ) {
        $last_date = $last_date
            - ONE_DAY;    # Time::Pieceオブジェクトを1日前にする
        next;
    }
    elsif ( $last_date->day_of_week == 0 || $last_date->day_of_week == 6 ) {

        $last_date = $last_date
            - ONE_DAY;    # Time::Pieceオブジェクトを1日前にする
        next;
    }
    else {
        last;
    }

    if ( $count > 30 ) {
        last;
    }
    $count++;
}

print 'last normal day: '
    . $last_date->ymd
    . "\n";    # last normal day: 2020-12-25

定型のフォルダ構造を作る

先週はブログも書かずに何をしてたんだっけか

あぁ、部屋片付けてたのか。

あれから1週間たった今も片付いてない。なんぼかは減ったけど、ベッドの上で処分品のダンボールと一緒に寝てます。

定型のフォルダ構造を作る

最近は経理業務の割合が70%ほどになりました。

経理というのは月次、四半期、年次、と繰り返しの多いお仕事です。

その中でも定型の業務ってのがいくつかあります。

毎月コツコツ、温かみのある手運用でやるのもいいのですが、楽をして早く帰ったりtwitter見てたいですよね?

ってことで、経理業務で毎月毎に作成するフォルダ構造を作るPerlスクリプトです。

こういうフォルダ構造を作ります。

$ tree -N
.
├── 売上
├── 海外
├── 立替金
├── 支払いCSV
├── 支払データ
├── 仕訳データ作成
│   ├── 支払
│   ├── 未払
│   └── 弥生販売から弥生会計
├── 給与・社会保険
│   ├── 概算
│   ├── 確定
│   └── 人件費
└── 経費請求書スキャンデータ

作る前にちょっと考える

  • 他の人(Windowsユーザ)が使えるように、クロスプラットフォームgolang で作った方が良いのでは? -> まず自分が作ってみて、自分が楽をするところから

  • Windowsユーザが使いまわせるように、バッチファイル(.bat)でいいのでは? -> まず!自分が!!楽をする!!!

  • bashzsh)でかけるのでは? -> うちはPerlが書きたい

  • フォルダ構造をどう指定する? -> 面倒なので、スクリプトに直接書いちゃう

  • 引数で指定したフォルダを作れたら良いのでは? -> 指定先が Windows共有(samba) なので、文字コードが面倒そう。とりあえず、macOSの環境で作って持っていくことにしよう

〜が面倒!しか書いてない。

出来上がったもの

最初は File::Spec とかいつも使ってるのでやろうと思ったのですが、せっかくなので使ったことのない Path::Tiny 使ってみました。

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

use utf8
    ; # スクリプト内にマルチバイト文字列(全角)書く時必須
binmode STDOUT, ':utf8'
    ; # macだけでの運用を想定してるので、出力時の文字コードをutf8で決めうち

use Path::Tiny
    ; # パスの作成をよしなにやってくれるモジュール(要cpanmでインストール)

my $target_root_path = path('.')
    ;    # スクリプトと同じところにところに作成する

my $parent_dir;    # 親ディレクトリ名の保存用変数

# スクリプト下部のDATAフィールドから持ってくる
for my $line (<DATA>) {

    chomp $line;    # 改行はしっかり削除

    # 行が文字から始まっていれば親ディレクトリ
    if ( $line =~ /\A\w/ ) {
        $parent_dir = path($line);  # パスを作って
        $parent_dir->mkpath;        # パスに相当するディレクトリを作成
    }

    # 文字から始まっていなければ子ディレクトリ
    else {
        $line =~ s/\s+//;   # 行頭のスペース削除
        my $path = path( $parent_dir, $line );
        $path->mkpath;
    }
}

__DATA__
支払いCSV
海外
給与・社会保険
    概算
    確定
    人件費
経費請求書スキャンデータ
仕訳データ作成
    支払
    未払
    弥生販売から弥生会計
支払データ
売上
立替金

フォルダ構成が三階層以上になった時はどうするんや、ってなりますが、そん時はそん時ってことで(再帰とか使う事になるんかな)

その他

macOS には tree コマンドがない

macOSのパッケージマネージャ、homebrew で インストールします

$ brew install tree

tree コマンドで文字化けする

$ tree
.
├── mkdir_per_month.pl
└── �\203\233�\202��\203\233�\202�

-N つけましょう

$ tree -N
.
├── mkdir_per_month.pl
└── ホゲホゲ

Path::Tiny でお世話になったページ

Perl から Selenium を使う

色々あって

Twitter がデザイン変更して、スクレイピングが失敗するようになり、またDOM解析して修正かー・・・とか思ったら、SPA 化かなんかで全然 DOM の把握ができず、スクレイピングどころではないってなって、あー!!

ってことで、以前から気になっていた Selenium を使ってみます。

大体、Twitter が提供している API でちゃんと全部情報が取れないのが悪い。センシティブと判定された tweet とか取れないんだよなー

Perl 側の準備

ためらうことなく cpanm

$ cpanm Selenium::Remote::Driver

Perl のモジュールインストールが終わったか確認

$ perl -e -MSelenium::Remote::Driver

これは、ワンライナーという Perl の書き方。モジュールを呼び出しただけのコード。ここでエラーが出なければok

引数の説明はこんな感じ。

  • -e 引数をPerlのコードとして解釈して実行する
  • -M モジュールを呼び出す

上記のワンライナーをコードに起こすとこう。この1行。

use Selenium::Remote::Driver;

ここで use できないとエラーが出る。エラーが出ない、ってことはとりあえずインストールはできている。

ワンライナーは短くかけるので、ギュッとまとめるとこう。

$ perl -eMSelenium::Remote::Driver

この perl -eMモジュール名 ってワンライナーでインストールの成否を見たりするのはワンライナーの定番。

Mac 側の準備

Perl (とか他のプログラム言語)側からブラウザを操作するためのドライバをインストールする。

$ brew install geckodriver
$ brew cask install chromedriver

brew の formula がインストールされたか確認

まずは Chrome のドライバを実行

$ chromedriver
Starting ChromeDriver 83.0.4103.39 (ccbf011cb2d2b19b506d844400483861342c20cd-refs/branch-heads/4103@{#416}) on port 9515
Only local connections are allowed.
Please see https://chromedriver.chromium.org/security-considerations for suggestions on keeping ChromeDriver safe.
ChromeDriver was started successfully.

こちらは大丈夫そう。CTRL-C で閉じる。

次は Firefox 用のドライバ。Gecko ってのは Firefox のHTML描画エンジンなのだけど、最近はあまり名前聞かなかったんで懐かしくなった。

$ geckodriver

応答ないので CTRL-C で閉じる・・・大丈夫かなぁ。

Google のトップページを表示してタイトル取得して終了するだけ

初めてなので、基礎からやっていく。まずは Google のトップページを出して、タイトルを取得するだけ。

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

# Selenium::Web::Driver と一緒にインストールされる Chrome 用のドライバを呼び出す
use Selenium::Chrome;

# ドライバのインスタンスを起動する。初期化みたいなもの。
my $driver = Selenium::Chrome->new;

# Google のトップページに移動する。Get は Perl入学式 第5回でやったアレです。メソッドってやつです。
$driver->get('https://www.google.com');

# 移動した後のページのタイトルを表示する
print $driver->get_title() . "\n";  # Google

# ドライバを終了する
$driver->shutdown_binary();

Chrome が立ち上がって、Googleのトップページを表示して自動的に終了する。コンソールにはページのタイトルが表示されている。

f:id:sironekotoro:20200606133157p:plain

次は Firefox。説明は省略。

use Selenium::Firefox;
my $driver = Selenium::Firefox->new;
$driver->get('https://www.google.com');
print $driver->get_title() . "\n";   # Google
$driver->shutdown_binary();

ドライバが何も表示しなかったんで不安だったけど、ちゃんと動いた。よかった。

なお、Firefox の場合は終了時にポートの情報などが表示される。

Killing Driver PID 46947 listening on port 49580...

f:id:sironekotoro:20200606133531p:plain

Yahoo.co.jp からニュースを持ってくる

sironekotoro.hateblo.jp

これの Selenium 版をやってみます

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

use Selenium::Chrome;

# utf8 で出力する
binmode STDOUT, ":utf8";

my $driver = Selenium::Chrome->new;

# Yahooのトップページに移動する
$driver->get('https://www.yahoo.co.jp/');

# ニュース一覧のDOMを特定する
my $news
    = $driver->find_element_by_xpath(
    '/html/body/div/div/main/div[2]/div[1]/article/div/section/div/div[1]/ul'
    );

# ニュース一覧のDOMから、個別のニュースの要素を取得する
my $articles = $news->children( './li//h1/span', 'xpath' );

# 1記事ずつタイトルを取得する
for my $article ( @{$articles} ) {
    print $article->get_text() . "\n";
}


# ニュース一覧のDOMから、個別のニュースのURLを取得する
my $aTags = $news->children( './li//a[@href]', 'xpath' );

# 1記事ずつタイトルを取得する
for my $aTag ( @{$aTags} ) {
    print $aTag->get_attribute('href') . "\n";
}


sleep 3;

# WebDriver を終了する
$driver->shutdown_binary();
給付金委託 元電通社員に委任
激しい雨 東京や埼玉竜巻注意
習主席の国賓来日 年内見送り
緊急宣言 再指定に消極的な訳
加首相 デモ参加し片膝をつく
夜は高架下 困窮の留学生帰国
ヤクルト スアレスの陰性発表
鬼滅に続く?若手集うジャンプ
https://news.yahoo.co.jp/pickup/6361779
https://news.yahoo.co.jp/pickup/6361787
https://news.yahoo.co.jp/pickup/6361782
https://news.yahoo.co.jp/pickup/6361778
https://news.yahoo.co.jp/pickup/6361780
https://news.yahoo.co.jp/pickup/6361781
https://news.yahoo.co.jp/pickup/6361783
https://news.yahoo.co.jp/pickup/6361762

うまく取れたんだけど、結構時間がかかる・・・20 〜 30 秒くらい。

あと、タイトルとURLはもう少しスマートな取り方があると思う・・・

Twitter にログインしてみる

さて、本命。

$username_or_email$password を変更して実行

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

use Selenium::Chrome;

my $username_or_email = 'hogehoge';
my $password          = 'fugafuga';

my $driver = Selenium::Chrome->new;

# Twitter のログイン画面に移動する
$driver->get('https://www.twitter.com/login');

# name 属性でユーザー名の入力欄の要素を特定する
my $username = $driver->find_element_by_name('session[username_or_email]');
# 特定した入力欄にユーザー名を入力する
$username->send_keys($username_or_email);

sleep 1;  # 1秒待つ

# パスワードも、ユーザー名と同様に処理
my $psw = $driver->find_element_by_name('session[password]');
$psw->send_keys($password);

sleep 1;  # 1秒待つ

# ログインボタン には name 属性がないので、div タグと role 属性で要素を特定する
my $button = $driver->find_element('//div[@role="button"]');

# ボタンをクリックする
$button->click();

sleep 5;  # 5秒待つ


# WebDriver を終了する。ブラウザも閉じられる。
$driver->shutdown_binary();

うちの環境ではうまくいきました。

これで、あとはソースを解析することができればー、なのですが本日はここまで。

補足

Twitter側にはこのような通知が出ます。

f:id:sironekotoro:20200607112315p:plain

あまりやりすぎると「不正アクセスされてる!」って判断されちゃうかな。

参考にしたサイト

www.selenium.dev

qiita.com

aiacademy.jp

www.seleniumqref.com

Perl の情報は少ないんですが、他の言語のリファレンスが大変参考になりました。

Mojolicious::Lite でヘルパー関数を使う & サブルーチンリファレンス

近況

こんな感じの会社生活やってます。

なんで経理のお手伝いやってるかっていうと、経理の人員が足りないってところ簿記2級所持の自分がいたから、という巡り合わせです。

会計ソフトに記帳していくだけなら経理未経験でも行けるだろうと。

(とはいえ、取得から7年くらいは経ってるのでかなり忘れてる)

3月の最終週からバックオフィスのメンバーに助けてもらいつつお仕事しております。

なお、明日月曜日からは6月の月初なので経理が大変な週です。皆さんの職場の経理マンをそっと見守りつつ、労わりましょう。

テンプレートで使える便利関数

で、3割のサーバの中で何かするってやつなのですが、テンプレートの出力を変更したり、ということをよくやっています。

そのテンプレートにはマクロ機能というのがあり、これが便利だったんですね。View専用の関数とでもいうか。

似たような機能が Mojolicious::Lite にないかなぁ、と思ったら helper という機能名で実装されていました。

helper 、聞いたことはあったのですが、その時は理解できませんでした。今なら行けそう。

Mojolicious::Lite でヘルパー関数を使う

業務に近い例を考えていたのですが、汎用性ないなぁってことで、いつもの fizzbuzz にしてみました。

#!/usr/bin/env perl
use Mojolicious::Lite;

get '/' => sub {
    my $c = shift;
    $c->stash( num => [ 1 .. 100 ] );
    $c->render( template => 'index' );
};

# ヘルパー関数の宣言
helper fizzbuzz => sub {
    my ( $self, $num ) = @_;

    if ( $num % 15 == 0 ) {
        return 'fizzbuzz';
    }
    elsif ( $num % 3 == 0 ) {
        return 'fizz';
    }
    elsif ( $num % 5 == 0 ) {
        return 'buzz';
    }
    else {
        return $num;
    }
};

app->start;
__DATA__

@@ index.html.ep
% layout 'default';
% title 'Welcome';
<h1>Welcome to the Mojolicious real-time web framework!</h1>

<% for my $n ( @{$num}) { %>
    <%= fizzbuzz($n) %><br>
<% } %>

@@ layouts/default.html.ep
<!DOCTYPE html>
<html>
  <head><title><%= title %></title></head>
  <body><%= content %></body>
</html>

以上です。

Perl入学式の講義ではテンプレートの中でIFの条件分岐を書いていましたが、ヘルパー関数にまとめることでスッキリしました。

サブルーチンリファレンス

ヘルパー関数の宣言は以下のコードです。

helper fizzbuzz => sub {
    my ( $self, $num ) = @_;
# ... 中略
}

これはサブルーチンリファレンスを使っています。

例えば、サブルーチンの例としてこんなサブルーチン作ってみます。

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

sub greet {
    my $name = shift;
    return "Hello, $name !\n";
}

print greet('sironekotoro');    # Hello, sironekotoro !

サブルーチンをリファレンスにすることで、スカラー変数に入れてしまうことができます。

以下はデリファレンスして引数を設定した例ですが、これはちょっと書いていて辛いですね・・・

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

sub greet {
    my $name = shift;
    return "Hello, $name !\n";
}

my $greet_ver = \&greet
    ; # サブルーチンをリファレンスにしてスカラー変数に格納
print &{$greet_ver}('sironekotoro');    # デリファレンスしてる

もちろん、配列リファレンスやハッシュリファレンスと同様、無名サブルーチンリファレンス を作ることができます。これはよくコードリファレンスまたはコードレフ(coderef)と呼ばれてます。

すっきり書けますね。

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

my $greet = sub {
    my $name = shift;
    return "Hello, $name !\n";
};

print $greet->('sironekotoro');

アロー記法で引数を設定できるとか、配列リファレンスやハッシュリファレンスと同じですね。

比較しながら考えたり書いてみると分かりやすいと思います。

この最後の書き方はほぼ、Mojolicious::Lite の helper 関数の書き方や、 view での呼び出し方に近いです。

ということで view がごちゃごちゃしてきた時にはぜひ helper 関数にチャレンジしてみてください!

Mojolicious::Lite でファイルをアップロード

いつもの Mojolicious::Lite です。

プロトタイピング

今回は、自分が欲しいなーと思っているもの、作りたいなーと漠然と思っているものを雑に作ってみます。

雑なので大穴がそこかしこに。

  • 同名のファイルは問答無用で上書き
  • アプリを再起動すると、アップロードしたファイルの履歴が飛ぶが、ファイルは残り続ける

ううーん、大穴。

ただ、「欲しいもの」をはっきりさせるとき、手間がかかりそうなのはどこか、何が足りないのか、別のモジュールに切り出せないのか、Perl だけじゃ無理で Javascript 使わないとダメなのはどこか?とか、そういう感覚を得たいんですね。

欲しいものがはっきりすると、実はすでに独立したアプリになってたりする・・・なんてこともあります。

作らずに済むのは良いですが、せっかくなので、それを模倣してみたりとか。楽しいですよね。

こんな感じのディレクトリ構成です。 public/ の中のファイル はテストで上げてみたもの。アップロードしたファイルはこの public フォルダの中に入ります。

$ tree
.
├── myapp.pl
└── public
    ├── temp_cp932.pl
    ├── 初級テキスト・問題集 解答・解説.pdf
    └── Mac_MaxCapacity.txt
#!/usr/bin/env perl
use Mojolicious::Lite;

# ファイルの保存先フォルダがなかったら作成する
# Mojolicious::Liteの公開フォルダはデフォルトでは
# スクリプトのあるフォルダの中にある public
my $save_folder = 'public';
unless ( -d $save_folder ) {
    mkdir $save_folder;
}

# アップロードしたファイルの情報を格納する配列リファレンス
my $upload_files = [];

get '/' => sub {
    my $c = shift;
    $c->stash( upload_files => $upload_files );

    $c->render( template => 'index' );
};

post '/' => sub {
    my $c = shift;

    # form内のファイルのところから情報を持ってくる
    my $file = $c->param('file_field');

    # ファイル移動先のパスを作る
    my $path = join( "/", $save_folder, $file->filename );

    # ファイルを移動する
    $file->move_to($path);

    my $localtime = localtime;

    # ファイル名などを保存する
    push @{$upload_files},
        {
        filename  => $file->filename,
        size      => $file->size,
        localtime => $localtime,
        };

    # 表示はgetにお任せ
    $c->redirect_to('/');
};

app->start;
__DATA__

@@ index.html.ep
% layout 'default';
% title 'Welcome';
<h1>Welcome to the Mojolicious real-time web framework!</h1>

<form action="/" method="POST" enctype="multipart/form-data">
    <ul>
        <li>ファイル:<input type="file" name="file_field" required></input>
    </ul>
    <input type="submit"></input>
</form>

<table border="1">
  <tr>
    <th>DL</th>
    <th>filename</th>
    <th>size</th>
    <th>localtime</th>
  </tr>
  <% for my $file ( @{$upload_files} ){ %>
    <tr>
      <td><a href="<%= $file->{filename} %>">ダウンロード</a> </td>
      <td><%= $file->{filename} %></td>
      <td><%= $file->{size} %></td>
      <td><%= $file->{localtime} %></td>
    </tr>
  <% } %>

</table>

@@ layouts/default.html.ep
<!DOCTYPE html>
<html>
  <head><title><%= title %></title></head>
  <body><%= content %></body>
</html>

追記

まぁ、TODO 書くだけならね(できるとは言っていない

f:id:sironekotoro:20200524173910p:plain

追記2

やりたいことが整理された結果、Google Drive 中心にいろいろやれば Mojolicious 使わなくて良さそう感が出てきた

Docker上でPerlを動かして、ホストにあるファイルを実行する

Perl インストールしないで Perl 実行するにはどうするんがいいのかなー?的に思って作った環境。

Perl 公式の Docker イメージ使ってみたけど、結構サイズが大きかった。

初回だけDockerイメージのダウンロードに時間がかかります。

hub.docker.com

$ docker images perl
REPOSITORY          TAG                 IMAGE ID            CREATED             SIZE
perl                5.30.2              a8b6deb2e511        12 days ago         857MB
perl                latest              a8b6deb2e511        12 days ago         857MB

中に入って確認するとdebianみたいっすね。

root@6210f71a6f0d:~# cat /etc/debian_version
10.3

ファイルの配置はこんな感じで。

$ tree
.
├── docker-compose.yml
└── hello.pl

0 directories, 2 files

hello.pl

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

print "Hello, World\n";

docker-compose.yml

version: '3'
services:
  perl:
    image: "perl:5.30.2"
    volumes:
     - ".:/usr/src/myapp"
    working_dir: "/usr/src/myapp"
    entrypoint:
     - "/usr/local/bin/perl"

こうやって実行。docker-compose.yml と、動かしたいスクリプトは同じところ置く。

$ docker-compose run perl hello.pl
Hello, World

Dockerfileでやってみたけど、いざコマンドラインから実行するときに引数が長くなってしまうのが嫌で(個人の感想です)、docker-compose.yml にまとめましたとさ。

ちなみに、と言うか、数ヶ月後の自分が勘違いしそうなので書いておくと、

$ docker-compose run perl hello.pl

ここの perl ってのは、Dockerコンテナ内の /usr/bin/local/perl ではなくて、docker-compose.yml 内にある services 名としての perl なので気をつける。

紛らわしい名前付はよくないですねー

Perlでディレクトリの中のファイルにアクセスする

早速やっていきます。

いつも通り、コードと対象のディレクトリは同じところに置きます。ディレクトリとファイルの位置はこんな感じ。

.
├── read_dir.pl         これから書くスクリプト
└── test_dir             ディレクトリ
    ├── test_file1.txt   ディレクトリの中のファイル その1
    └── test_file2.txt    ディレクトリの中のファイル その2
  • test_file1.txt の中身は hoge と1行だけ
  • test_file2.txt の中身は fuga と1行だけ

Perlディレクトリの中のファイルにアクセスする方法として、ディレクトリハンドルを使う方法と、ファイルグロブを使う方法を書いていきます。

その1 ディレクトリハンドル

ファイルの中身を読んだり書き込んだりには ファイルハンドル を用いました。ディレクトリを扱うには ディレクトリハンドル を使います。

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

my $directory_name = 'test_dir';    # ディレクトリ名

# ディレクトリハンドルの略称で $DH とした。
# ディレクトリ開けなかったらエラーを出して死ぬ(die)
opendir my $DH, $directory_name or die; 

for my $content ( readdir $DH ) {
    print $content . "\n";
}
closedir $DH;

コードの解説していきます。

opendir my $DH, $directory_path or die; 
# 中略
closedir $DH;

ファイルを開くときは open を用いましたが、ディレクトリのときには opendir を使います。ディレクトリの処理が終わった後にはclosedir で閉じます。

ディレクトリハンドル $DH が無事作成されると、この $DH の中にディレクトリの中の情報が入ります。

ついでに説明ですが、末尾に or die をつけていることで、ディレクトリが開けなかったらスクリプトが終了するようにしています。

これはよくある書き方、定型、お約束みたいなものですね。

for my $content ( readdir $DH ) {

次に、 readdir ですが、これは $DH の中身を1つ取り出す関数です。これが for 文の中にあるので、 $DH の中身を一通り吐き出して終了、というわけです。

実行結果は以下の通りです。

.
..
test_file2.txt
test_file1.txt

ファイル以外にも表示されているものがあります。 ... です。

これはPerlが動いている環境( macOS や msys2 , Linux )において特別な意味を持つものです。

ターミナルで

$ ls .

$ ls .. 

と入力してみると分かりやすいと思います。

ディレクトリのファイル一覧をとるときにはこの ... を除外する書き方をすることも多いです。

... の時は for のループを飛ばす、という処理です。こんな感じ。

for my $content ( readdir $DH ) {
    if ($content eq '.' or $content eq '..' ){
        next
    }
    print $content . "\n";
}

もう少しスマートに、後置if文と正規表現を使うとこんな感じ。正規表現覚えてますか〜?

for my $content ( readdir $DH ) {
    next if $content =~ /^\.{1,2}$/;
    print $content . "\n";
}
closedir $DH;

これで ... の場合には next で次のループに行くので表示される事がなくなります。

その2 ファイルグロブ

ディレクトリにアクセスするもう一つの方法が、 ファイルグロブ を使う方法です。

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

my $files_path = 'test_dir/*';  # ファイルのパスをワイルドカードで指定している

my @contents       = glob($files_path);  # glob ファイルグロブを使っている 

for my $content (@contents) {
    print $content . "\n";
}

実行結果

test_dir/test_file1.txt
test_dir/test_file2.txt

さっきのディレクトリハンドルを用いる方法とちょっと書き方や結果が異なります。

ただ、ディレクトリハンドルよりも直感的に書けたりするのでこちらが使われている場合も多い・・・気もします(個人の感想です)。

glob ですが、これは引数のパスに該当するファイル名のリストを取得します。このとき、ワイルドカードや拡張子の指定をついでに行う事ができます。

ディレクトリハンドルはディレクトリ名を指定しましたが、glob の場合はそのディレクトリの中身を指すパス になります。

ワイルドカードを使って、特定の拡張子のファイルのみを指定する事が可能です。

例えばこんな感じ。

my $files_path = 'test_dir/*.csv';

もちろん、ディレクトリハンドルでも同様のことは可能ですが、条件が単純な時はファイルロブを使った方が楽でしょう。

また、実行結果でもわかるようにパスの組み立ても可能です。これも条件が単純なときには便利です。

ディレクトリの中のファイルの中身を表示してみる

ディレクトリの中のファイルの中身を見たい時のスクリプトを例に、ディレクトリハンドル を用いたものと、ファイルグロブを使ったもの、と2つ書いてみました。

ディレクトリハンドルの中にあるのはファイル名のみなので、ファイルの中身にアクセスするときには ディレクトリ名/ファイル名 というようにパスを作ってあげる必要があります。

ディレクトリハンドル編

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

my $directory_name = 'test_dir';

opendir my $DH, $directory_name or die;

for my $content ( readdir $DH ) {
    next if $content =~ /^\.{1,2}$/;

    # ファイルのパスを作成する
    my $content_path = $directory_name . '/' . $content;

    # ファイルのパスからファイルハンドルを作成して中身を表示する
    open my $FH, '<', $content_path;
    for my $line (<$FH>) {
        print $line , "\n";
    }
    close $FH;

}
closedir $DH;

実行結果

fuga
hoge

ファイルグロブ編

ディレクトリハンドルより短くかけます。

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

my $directory_path = 'test_dir/*';

my @contents = glob($directory_path);

for my $content (@contents) {

    open my $FH, '<', $content;
    for my $line (<$FH>) {
        print $line . "\n";
    }
    close $FH;

}

実行結果

fuga
hoge

ということで、これで Perl でファイルやディレクトリを扱う最低限のスクリプトの紹介はおしまいです。

Perl には File::Find とか Path::Tiny とか File::SpecCwd などのファイル・ディレクトリを扱う便利モジュールも数多くあります。

何かしようとして、うまくいかないとか、こういうことをがしたい!という方は Perl入学式の slack などで質問くださいませ。

docs.google.com

長いおまけ: PerlWindows上のファイル名を変更する

中には、Windows で msys2 などの環境を使わずに Perl を利用する人もいるかもしれません。

6年くらい前のうちみたいに・・・

そのとき、Perl から Windows 上の日本語ファイル名を扱えずに困り果てる・・・という事がありました。

試しに、ファイル名に特定の文字列をつけるスクリプトを解説付きで書いてみました。

Windows10 + ActivePerl 5.28 で動かしてます。

変数の中の文字列が cp932 なのか Perlで扱う utf8 なのかを変数名の先頭ににつけてみました。

・・・が、残念なことに分かりやすさに直結しなかったなぁという。

苦労したんだけどー

ディレクトリ構造です。

├── rename_file_win.pl         これから書くスクリプト
└── 日本語ディレクトリ             ディレクトリ
    ├── 日本語ファイル1.txt   ディレクトリの中のファイル その1
    └── 日本語ファイル2.txt    ディレクトリの中のファイル その2

Windows 上で日本語のファイル名を扱うときの注意点は、文字コードです。

これが基本です。

use strict;
use warnings;
use Encode qw/decode encode/;
use utf8;

my $utf8_dir_name = '日本語ディレクトリ'; # これはutf8のソースコード上に書かれた文字

# ディレクトリ名が書かれているのは utf8 上のソースコード
# この utf8 で記されたディレクトリ名を Windows(cp932) が解釈できるよう変換する

# スクリプトから見て「内->外」なのでエンコードする
my $cp932_dir_name = encode('cp932', $utf8_dir_name); 

opendir my $DH, $cp932_dir_name or die;    # Windows上のディレクトリを開く

    for my $cp932_content (readdir $DH){
        # カレントディレクトリと上位ディレクトリは飛ばす
        next if $cp932_content =~ /^\.{1,2}$/;

        # $cp932_content は readdir が持ってきた Windows(cp932) のディレクトリ内のファイル名。
        # これを Perl が解釈できるように変換する
        # スクリプトから見て「外->内」なのでデコードする
        my $utf8_content = decode('cp932', $cp932_content);

        # ファイル名の先頭に文字列を追加してみる
        # 追加する文字列。utf8 上のソースコードに書かれているのでこの文字列は utf8
        my $utf8_add_string = '(変更済み)';

        # 新しいファイル名の変数を用意
        my $utf8_new_filename = $utf8_add_string . $utf8_content;

        # ファイル名を変更するために、元のファイル名と新しいファイル名それぞれに親ディレクトリをつけたパスを用意する
        # File::Spec を用いることで、OSごとのディレクトリとファイルの区切り文字をよしなに変換してくれる
        # ここで変換するのはあくまで区切り文字のみ。文字コードの変換ではない。
        use File::Spec;
        my $utf8_old_file_path = File::Spec->catfile($utf8_dir_name, $utf8_content);
        my $utf8_new_file_path = File::Spec->catfile($utf8_dir_name, $utf8_new_filename);

        # Windows上で rename するので Windows(cp932) に変換する。
        # スクリプトから見て「内->外」なのでエンコードする
        my $cp932_old_file_path = encode('cp932', $utf8_old_file_path);
        my $cp932_new_file_path = encode('cp932', $utf8_new_file_path);

        # rename 関数を使ってファイル名を変更する
        rename $cp932_old_file_path, $cp932_new_file_path or die;

        # 変換状況を表示する
        print "$cp932_old_file_path => $cp932_new_file_path\n";

    }

closedir $DH;