誕生日から星座を調べる正規表現 - Qiita に書いた正規表現を生成したスクリプト。
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;
}
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
おわりです。