正規表現で複数行テキストをまるごと片付ける方法

UNIXのテキストファイルは1行1データなので、Perl もテキストファイルを1行ずつ読むことが多いです。

1行1データではないテキストファイルを解析する際、それまでにどのような行データを読み込んだかで現在行の解釈が変わることがあります。そのような場合、変数などで現在の状態を保持した上で1行ずつ読みながら行の解釈を行っていく方法がメジャーでしょう。

ただ、このような行の解釈を行うコードは意外に煩雑になることもあります。

その代わり、正規表現でテキストファイルを全行まるごと読み込んで、それに対して正規表現を適用することで一気に処理を行うことができることもあります。

テキストファイルを全行まるごと読み込む方法

Perl では、以下のようにすると、読み込みファイルハンドル $fh から全行まるごと読み込むことができます。

my $content = do { local $/; <$fh> };

my $line = <$fh> などとするとファイルハンドル $fh から1行読み込むことができるのですが、このとき1行の区切りが何あるかは $/ 特殊変数で管理されています。デフォルトでは "\n" であるところ、これを未定義とすることで <$fh> 記法で全行（Perl からしたら $/ = undef 状態では1行なのですが）一気に読み込むことができます。

$/ 変更の影響が他方に波及しないため、 do { ... } でスコープを作って local で局所化するのがイディオムとなっています。

Markdown に書かれたデータからデータを引き上げる

この記事もアドベントカレンダーの記事である通り、この記事を書いている2021年12月はアドベントカレンダーシーズンです。

某所のクローズドなアドベントカレンダーは以下のような Markdown で担当者管理がされていました。

（前略）

## 12月1日 
### タイトル
シェルスクリプトで時短テクニック

### 担当者名
@Alice

### URL
https://adventcalendar.example.com/2021/12/01

## 12月2日 
### タイトル

電子工作入門

### 担当者名

@Bob

### URL

https://adventcalendar.example.com/2021/12/02

（後略）

これを見て、ちょっと視認性が悪いので1ヶ月カレンダー表記にしたいなぁとPerlプログラムを書いてみることにしました。

規則性を観察する

解析するために、まず規則性を探してみましょう。

• ## で日付が書かれているところにその日付のカレンダーのデータが書かれている
• ### には「タイトル」と「担当者名」と「URL」があり、その内容としてデータが書かれている
• この ## xx月xx日 の中には #### は無い

1行ずつ読み込むとしたら、以下のような方針になるでしょうか。

• ## xx月xx日 に出会ったら、今読んでいる月日がそれであると記録しておく
  • ## xx月xx日 に出会う前は、今は月日のデータを読んでないとする
  • ## xx月xx日 以外の ## に出会ったら、今読んでいる月日情報をクリアにする
• 今読んでいる月日情報を記録している場合、### の「タイトル」「担当者名」「URL」に出会ったら日付に紐付けて記録する
  • データ構造としては $events{$date}{$key} = $value のような多重ハッシュ構造が良い
  • 月日情報を確保している場合は、出会った ### の指示に従い複数行を読み込んでいく

愚直に書く

愚直に書くとすると、冒頭はこんな感じになるでしょうか。

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

my ($date, $key, %article);
while(<>) {
    chomp;
    if ( /^## (\d\d?月\d\d?日)/ ) {
        $date = $1;
        $article{$date} = {}; # autovivification に頼るのも良し
        next;
    }
    if ( /^## / ) {
        $date = undef;
        next;
    }
    if ( /^### (タイトル|担当者名|URL)/ ) {
        $key = $1;
        $article{$date}->{$key} = "";
        next;
    }
    if ( $date && $key ) {
        $article{$date}->{$key} .= $_ . "\n";
        next;
    }
}

# ここから %article を読み込んで色々やる

こちらは即興で書いたので、実際に %article を整形するコードもなく、そもそも動作確認も甘いです。

現在読んでいる月日を $date 、これから来るだろうデータのラベルを $key という変数に入れて、その後 $article{$date}->{$key} に文字列データとして確保するというロジックです。

これ、正規表現で一気に読み込めないでしょうか。

正規表現でまとめて確保してみる

このデータを my $markdown = do { local $/; <> } でまるごと読み込んだとして、どこに興味があるかというと ## xx月xx日 から次の ## か # かファイル末尾の直前まででしょう。

これをまとめて正規表現で取ってくるなら以下の方法があります。

• 行頭 ## xx月xx日 からひたすら (.*?) で飲み込みつつ、「直前」を表現するために肯定先読み (?:(?=## )|(?=# )|\z) を正規表現マッチの最後において、 先ほどのキャプチャで捉えた $1 を確保する
• /^## /m で split してしまい、その各リスト要素の先頭が xx月xx日 なもののみ処理していく

前者の方が先読みが出てきたりして複雑ですが、後者の場合は ## xx月xx日 と ### にのみ興味があるのに、突然 # が出てきたときに、最後の ### がその次に現れた # を飲み込んでしまう可能性があります。後で面倒を想定してそれを選り分ける方法もありますし、 /^(?:#|##) /m で split してしまう方法もあるでしょう。

split は素朴ですが、後で「こんなケースがあったか〜」といった場合に小回りが効かないこともあり、今回は前者の先読みを使って $1 として月日のデータを丸ごとキャプチャする方法を取りました。

日部分と中身の2個をキャプチャするようにすると（リストコンテキストでの）返り値は2個のリストとなりますが、 /g 修飾子を付けるとグローバルマッチになって、n個のマッチが発生する場合は 2n個のリストが返り値となります。そして Perl では偶数個のリストを代入すると自動的にハッシュになるということで、以下のようにして日部分をキーとしたハッシュを作成することができます。

my %section_of = $markdown =~ m{^## 12月(\d+)日\s+(.*?)\n(?:(?=## )|\z)}gms;

上記の通り、特定の月日の Markdown 文面を取り出せた場合、その文面には ### しかない（今回のパターンでは #### がないことは事前に確認済み）ので、より簡単になります。この段階で1行ずつ読み込みに逆戻りすることは本末転倒（であれば最初から1行ずつ読み込みで処理する）なので、ここも正規表現で確保することにしましょう。これも「直前まで」の肯定先読みを生かして処理する方法と、素朴な split の方法がありますが、ここも肯定先読みで行きましょう。

先ほどと同じテクニックで、以下のようにして3個のラベル「タイトル」「担当者名」「URL」をキーとしたハッシュを作成することができます。

my %value_of = $section =~ m{^### ([^\n]+)\n(.*?)\n(?:(?=### )|$)}gms;

/g 修飾子の他に /m 修飾子と /s 修飾子を使っていますが、これは両方とも今回必要なものです。

修飾子	意味を変えるメタ文字	意味
g		グローバルマッチ
m	^ と $	行頭・行末の意味を \n の直後や直前にもマッチするようにする
s	.	[^\n] の意味だった . をあらゆる1文字にマッチするようにする

こちらは Perlの正規表現の一行モード(/s)と複数行モード(/m)の覚え方 がわかりやすいです。

最終的に読み込んだテキストには前後に空白類文字がくっついているのでそれを取り除く trim 関数も作ってみましょう。

sub trim($string) {
    return $string =~ s/^\s+//r =~ s/\s$//r;
}

Perl 5.14 以降の非破壊置換の /r 修飾子で連鎖的に置換を行っています。
また、Perl 5.20 以降の Subroutine Signatures （多くのプログラミング言語で言うところの、関数の仮引数表記）を使っています。

ざっくり書いてみる

上記を踏まえて、正規表現をいくつかぶつけてデータを取り出すコードを書いてみました。ついでにカレンダーを書くロジックも入れています。

#!/usr/bin/env perl
use v5.20;
use warnings;
use feature qw(say signatures);
no warnings qw(experimental::signatures);
use Time::Piece;
use List::Util qw(pairmap);
use Data::Dumper;

my %section_of_day = decode_content();
my %event_of_day   = pairmap { $a => +{ parse_section($b) , day => $a } } %section_of_day;
my %content_of_day = pairmap { $a => get_content($b) } %event_of_day;
# print Dumper(\%section_of_day);
# print Dumper(\%event_of_day);
# print Dumper(\%content_of_day);
my @calendar = get_calendar_2021_12(
    map { $content_of_day{$_} } sort { $a <=> $b } keys %content_of_day 
);
# print Dumper(\@calendar);
render_calendar(@calendar);

sub decode_content() {
    my $markdown = do { local $/; <> }; # STDIN 丸のみ
    # キーバリューフラットリストなので、Perl でハッシュに代入するとそのままハッシュになる
    return $markdown =~ m{^## 12月(\d+)日\s+(.*?)\n(?:(?=## )|\z)}gms;
}
sub parse_section($section) {
    return $section =~ m{^### ([^\n]+)\n(.*?)\n(?:(?=### )|$)}gms;
}
sub trim($string) {
    return $string =~ s/^\s+//r =~ s/\s$//r;
}
sub get_content($event) {
    my ($day, $title, $writer, $url) = map { trim($event->{$_}) } qw(day タイトル 担当者名 URL);
    if ( $title && $writer ) {
        if ( $url ) {
            return sprintf "%s<br>%s<br>[%s](%s)", $day, $writer, $title, $url;
        } else {
            return sprintf "%s<br>%s<br>%s", $day, $writer, $title;
        }
    } elsif ( $writer ) {
        return sprintf "%s<br>%s<br>-", $day, $writer;
    } else {
        return "$day";
    }
}
sub get_calendar_2021_12(@days_contents) {
    my $first_day = Time::Piece->strptime("2021/12/01", "%Y/%m/%d");
    my $first_day_of_week = $first_day->day_of_week; # Sunday=0, ..., Saturday=6
    # 最初に日曜日なら0個、月曜日なら1個、……土曜日なら6個、頭に未定義値を入れておくと後のロジックが簡潔になる
    unshift @days_contents, (undef) x $first_day_of_week;
    my @calendar;
    while (my @week_row = splice @days_contents, 0, 7 ) {
        if ( @week_row != 7 ) {
            push @week_row, (undef) x (7 - @week_row);
        }
        push @calendar, \@week_row;
    }
    return @calendar;
}
sub render_calendar(@calnedar_matrix) {
    printf "| %s |\n", join " | ",
        fontcolor("red", "日"), qw(月 火 水 木 金), fontcolor("blue", "土");
    printf "| %s |\n", join " | ", (":----:") x 7;
    for my $week (@calnedar_matrix) {
        printf "| %s |\n", join " | ", map { !defined $_ ? "-" : $_ } @$week;
    }
}
sub fontcolor($color, $string) {
    return qq(<font color="$color">$string</font>);
}

雑に書いたままなので、Data::Dumper などの記述も残したままですが、だいたいこんな感じでできます。

手続き型でざっと書きつつ、一応処理ごとにサブルーチンにしています。扱うデータ構造を意識はしているので、ここからデータ構造をオブジェクト化するのも容易でしょう。

この正規表現による複数行1データの処理方法は、色々と応用が可能だと思います。参考になりましたら幸いです。