誕生日から星座を調べる正規表現を作る


[誕生日から星座を調べる正規表現 - Qiita](http://qiita.com/B73W56H84/items/1a4c83425125c43bde14) に書いた正規表現を生成したスクリプト。

```pl:regexp_assemble_seiza.pl
use v5.18;
use Regexp::Assemble;
use DateTime;
use DateTime::Event::Recurrence;

# 'mm/dd'形式の誕生日から、星座を求める正規表現を作ろう。
&main; exit;

sub main {
  my @Aries       = seiza( [qw( 2016  3 21 )], [qw( 2016  4 19 )] ) ;
  my @Taurus      = seiza( [qw( 2016  4 20 )], [qw( 2016  5 20 )] ) ;
  my @Gemini      = seiza( [qw( 2016  5 21 )], [qw( 2016  6 21 )] ) ;
  my @Cancer      = seiza( [qw( 2016  6 22 )], [qw( 2016  7 22 )] ) ;
  my @Leo         = seiza( [qw( 2016  7 23 )], [qw( 2016  8 22 )] ) ;
  my @Virgo       = seiza( [qw( 2016  8 23 )], [qw( 2016  9 22 )] ) ;
  my @Libra       = seiza( [qw( 2016  9 23 )], [qw( 2016 10 23 )] ) ;
  my @Scorpio     = seiza( [qw( 2016 10 24 )], [qw( 2016 11 21 )] ) ;
  my @Sagittarius = seiza( [qw( 2016 11 22 )], [qw( 2016 12 21 )] ) ;
  my @Capricorn   = seiza( [qw( 2016 12 22 )], [qw( 2017  1 19 )] ) ;
  my @Aquarius    = seiza( [qw( 2017  1 20 )], [qw( 2017  2 18 )] ) ;
  my @Pisces      = seiza( [qw( 2017  2 19 )], [qw( 2017  3 20 )] ) ;

  say regexp_assemble( @Aries );
  say regexp_assemble( @Taurus );
  say regexp_assemble( @Gemini );
  say regexp_assemble( @Cancer );
  say regexp_assemble( @Leo );
  say regexp_assemble( @Virgo );
  say regexp_assemble( @Libra );
  say regexp_assemble( @Scorpio );
  say regexp_assemble( @Sagittarius );
  say regexp_assemble( @Capricorn );
  say regexp_assemble( @Aquarius );
  say regexp_assemble( @Pisces );

  # '01/01' 〜 '12/31' にマッチする正規表現(含'02/29')
  say regexp_assemble(
    @Aries, @Taurus,  @Gemini,      @Cancer,    @Leo,      @Virgo,
    @Libra, @Scorpio, @Sagittarius, @Capricorn, @Aquarius, @Pisces,
  );
}

sub seiza ( $$ ) {
  my ( $f, $t ) = @_;

  return
    # 2016-03-21T00:00:00 形式を 03/21 に変換
    # ※ スラッシュ無し( 0321 )にするなら s@-@@ ↓
    map{ s/T.*// && s/^\d\d\d\d-// && s@-@/@ && $_ }
    DateTime::Event::Recurrence->daily->as_list(
      'start' => DateTime->new(
        'year'   => $f->[0],
        'month'  => $f->[1],
        'day'    => $f->[2],
      ),
      'end' => DateTime->new(
        'year'   => $t->[0],
        'month'  => $t->[1],
        'day'    => $t->[2],
      ),
    );
}

sub regexp_assemble ( @ ) {
  my $builder = Regexp::Assemble->new;

  for my $day ( @_ ) {
    $builder->add( '\A' . ${day} . '\z' );
  }

  return $builder->as_string;
}
```

```bash:OUTPUT
$ perl regexp_assemble_seiza.pl
\A0(?:3\/(?:2[123456789]|3[01])|4\/(?:0[123456789]|1\d))\z
\A0(?:5\/(?:0[123456789]|1\d|20)|4\/(?:2\d|30))\z
\A0(?:6\/(?:0[123456789]|2[01]|1\d)|5\/(?:2[123456789]|3[01]))\z
\A0(?:7\/(?:0[123456789]|2[012]|1\d)|6\/(?:2[23456789]|30))\z
\A0(?:8\/(?:0[123456789]|2[012]|1\d)|7\/(?:2[3456789]|3[01]))\z
\A0(?:9\/(?:0[123456789]|2[012]|1\d)|8\/(?:2[3456789]|3[01]))\z
\A(?:10\/(?:0[123456789]|2[0123]|1\d)|09\/(?:2[3456789]|30))\z
\A1(?:1\/(?:0[123456789]|2[01]|1\d)|0\/(?:2[456789]|3[01]))\z
\A1(?:2\/(?:0[123456789]|2[01]|1\d)|1\/(?:2[23456789]|30))\z
\A(?:12\/(?:2[23456789]|3[01])|01\/(?:0[123456789]|1\d))\z
\A0(?:2\/(?:0[123456789]|1[012345678])|1\/(?:3[01]|2\d))\z
\A0(?:3\/(?:0[123456789]|1\d|20)|2\/(?:2[012345678]|19))\z
\A(?:0(?:[13578]\/(?:0[123456789]|[12]\d|3[01])|2\/(?:0[123456789]|2[012345678]|1\d)|[469]\/(?:0[123456789]|[12]\d|30))|1(?:[02]\/(?:0[123456789]|[12]\d|3[01])|1\/(?:0[123456789]|[12]\d|30)))\z
```

おわりです。

## 参考と注釈

* [DateTime](https://metacpan.org/pod/DateTime)
* [DateTime::Event::Recurrence](https://metacpan.org/pod/DateTime::Event::Recurrence)
* [Regexp::Assemble](https://metacpan.org/pod/Regexp::Assemble)

* [モダンPerlの世界へようこそ 第15回　DateTime：APIの標準化をめざして - gihyo.jp](http://gihyo.jp/dev/serial/01/modern-perl/0015)
* [perl - Regexp::Assembleのススメ - 404 Blog Not Found](http://blog.livedoor.jp/dankogai/archives/50812865.html)

* [Perl CPANモジュールガイド](https://www.wgn.co.jp/store/dat/3227/)