Meetup.pm (2351B) - raw
1 package Meetup; 2 use strict; 3 use warnings; 4 use Exporter qw<import>; 5 our @EXPORT_OK = qw<meetup>; 6 7 use Date::Calc qw( Nth_Weekday_of_Month_Year Days_in_Month ); 8 9 sub meetup { 10 my ($desc) = @_; 11 my %input; 12 my %day_number; 13 my %month_number; 14 my %week_number; 15 @input{ qw( week day_of_week of month year ) } = split / /, $desc; 16 @day_number{ qw( 17 Monday Tuesday Wednesday Thursday Friday Saturday Sunday 18 ) } = ( 1 .. 7 ); 19 @month_number{ qw( 20 January February March April May June 21 July August September October November December 22 ) } = ( 1 .. 12 ); 23 @week_number{ qw( 24 First Second Third Fourth Fifth Last Teenth 25 ) } = ( 1 .. 7 ); 26 my $month_num = $month_number{ $input{ month } }; 27 my $day_num = $day_number{ $input{ day_of_week } }; 28 my $week_num = $week_number{ $input{ week } }; 29 30 # if we are asked to find the last day in the month 31 if ( $input{ week } eq 'Last' ) { 32 my $days_in_month = Days_in_Month( $input{ year }, $month_num ); 33 my ($year, $month, $day) = 34 Nth_Weekday_of_Month_Year( 35 $input{ year }, 36 $month_num, 37 $day_num, 38 3 # find the day of month of the third occurrence of the day 39 ); 40 # $day now holds the day of the month of the third occurence of the day 41 # Check what would be the date 2 weeks from that day. 42 # If the date exceeds the number of days in the month, then the last 43 # occurrence of that day occurs in week 4. Otherwise, it occurs in 44 # week 5. 45 $week_num = $day + 14 > $days_in_month ? 4 : 5; 46 } 47 48 # find the "teenth" day 49 if ( $input{ week } eq 'Teenth' ) { 50 foreach my $possible_week ( 2 .. 4) { 51 my ($year, $month, $day) = 52 Nth_Weekday_of_Month_Year( 53 $input{ year }, 54 $month_num, 55 $day_num, 56 $possible_week 57 ); 58 if ( $day > 12 and $day < 20 ) { 59 $week_num = $possible_week; 60 last; 61 } 62 } 63 } 64 65 my ($year, $month, $day) = 66 Nth_Weekday_of_Month_Year( 67 $input{ year }, 68 $month_num, 69 $day_num, 70 $week_num 71 ) if $week_num < 6; 72 my $result = sprintf( "%04d-%02d-%02d", $year, $month, $day ); 73 return $result; 74 } 75 76 1;