exercism-perl5

Repository for my Perl 5 Exercism exercises
git clone git://git.samirparikh.com/exercism-perl5
Log | Files | Refs | README

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;