Hello everyone! About five and a half years ago, I posted Happy unbirthday!. When I saw my fifteenth PerlMonks anniversary, I decided to write something new. However, I began to notice the new code I was writing had similar aspects to the old code I wrote for Unbirthdays, specifically the date verification subroutines I was was writing. So, I opened up Unbirthdays and took a second look. So here is the updated Unbirthdays and the new Birthday scripts.
Date::VerifyDate::Verify verifies in input and returns the appropriate value.
- four_digit_year verifies the user input a four digit year. Usage: four_digit_year($year)
- month_name verifies the mount input is correct (such as inputting 13 as a month or the too short Ju). It returns a fully spelled out month name. Usage: month_name($month)
- month_number verifies the same as month_name, but it returns a month number instead. Usage: month_number($month)
- day_number verifies the day is a number and that the day exists within the month of the year. It returns the day number. Usage: day_number($year, $month, $day)
I am thinking on localizing this to the various countries available on Date::Calc.
package Date::Verify; use strict; use warnings; use Exporter qw(import); our @EXPORT = qw(four_digit_year month_name month_number day_number); use Data::Validate qw(is_integer is_between); use Date::Calc qw(:all); sub four_digit_year { my $year = shift; if ($year !~ /\d{4}/) { die "Sorry, please use the four digit year. Stopped"; } return $year; } sub month_name { my ($month) = @_; if (is_integer($month)) { if (is_between($month, 1, 12)) { $month = Month_to_Text($month); } else { die "Sorry, the month number you entered is invalid. Stopped"; } } else { my $decoded_month = Decode_Month($month); if ( $decoded_month ) { $month = Month_to_Text($decoded_month); } else { die "Sorry, your month name is a little short. Stopped"; } } return $month; } sub month_number { my ($month) = @_; if (is_integer($month)) { if (is_between($month, 1, 12)) { $month = $month; } else { die "Sorry, the month number you entered is invalid. Stopped"; } } else { my $decoded_month = Decode_Month($month); if ( $decoded_month ) { $month = $decoded_month; } else { die "Sorry, your month name is a little short. Stopped"; } } return $month; } sub day_number { my ($year, $month, $day) = @_; my $days = Days_in_Month($year, month_number($month)); if ($day > $days) { die "Sorry, there are only $days days in $month $year. Stopped"; } return $day; } 1;
unbirthdays.pl
I have made several changes to unbirthdays.
- First, I got rid of the Q&A. That became annoying to me while testing the changes I made to the script. To that end, I moved the input to the command line as @ARGV.
- Second, the Q&A was written to recurse until the input was in the correct form, however, the script now dies if the input is not in the correct form.
- Third, I fixed several things from the former unbirthdays thread.
- I made greater use of the Date::Calc module.
- I fixed the ordinal output of the number of unbirthdays.
- I fixed the error on inputting October.
- I fixed the leap year problem.
- I fixed the negative days before next birthday problem.
- If a parent runs this script for their newborn child on the child's day of birth, it will inform the parent the child's first unbirthday is tomorrow.
- If the day this is run is the person's birthday, then the person is wished a happy birthday instead of a happy unbirthday.
Usage is: unbirthdays.pl name month day year. However, if unbirthdays.pl help is used, a helpful message appears.
#!/usr/bin/perl use strict; use warnings; use Data::Validate qw(is_integer is_between); use Date::Calc qw(:all); use File::Basename; use Lingua::EN::Inflect qw(ORD); use lib 'lib'; use Date::Verify qw(four_digit_year month_name month_number day_number +); # commify, round, and pretty_number all make my numbers more readable. # commify was found in the perldocs to put commas in numbers. sub commify { local $_ = shift; 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; return $_; } my ($name, $birth_month, $birth_day, $birth_year) = @ARGV; chomp(@ARGV); if (!@ARGV || lc $name eq 'help') { my $file = basename($0); print "Please enter a single name and birthday: $file name month day + year\n"; } else { $birth_year = four_digit_year($birth_year); $birth_month = month_number($birth_month); $birth_day = day_number($birth_year, $birth_month, $birth_day); my $birth_month_name = month_name($birth_month); my $year = (localtime)[5] + 1900; my $month = (localtime)[4] + 1; my $day = (localtime)[3]; # The following counts how many birthdays there has been. # It also figures out the next year for a birthday. # I'm still working on the kinks in the next birthday. my $birthdays; my $next_year; if ($birth_month > $month) { $birthdays = $year - $birth_year - 1; $next_year = $year; } elsif ($birth_month < $month) { $birthdays = $year - $birth_year - 1; $next_year = $year + 1; } else { if ($birth_day > $day) { $birthdays = $year - $birth_year - 1; $next_year = $year; } else { $birthdays = $year - $birth_year; $next_year = $year + 1; } } my @birth = ($birth_year, $birth_month, $birth_day); my @next_bday = ($next_year, $birth_month, $birth_day); my @today = ($year, $month, $day); my $days_alive = Delta_Days(@birth,@today); my $days_til_next_bday = Delta_Days(@today,@next_bday); my $unbirthdays = $days_alive - $birthdays; my $unbirthday_text; if ($month == $birth_month && $day == $birth_day) { my $birthday = ORD($year - $birth_year); $unbirthday_text = "Happy $birthday birthday"; } elsif ($unbirthdays > 0) { my $ord_unbirthdays = commify(ORD($unbirthdays)); $unbirthday_text = "Happy $ord_unbirthdays unbirthday"; } else { $unbirthday_text = "Tomorrow is your first unbirthday"; } print "$unbirthday_text, $name! You have $days_til_next_bday days un +til your next birthday on $birth_month_name $birth_day, $next_year.\n +"; }
birthday.pl
I was writing birthday.pl when I realized I was writing similar code as was in unbirthdays.pl. This script will tell the user their tropical zodiace sign, their birth stone and flowers (flowers for the US and UK are listed), and birth day stone (based on day of the week the user was born).
This is a silly little script, but it helped me fix the previous one.
Usage is: birthday.pl name month day year. However, if birthday.pl help is used, a helpful message appears.
#!/usr/bin/perl use strict; use warnings FATAL => qw( all ); use Data::Validate qw(is_integer is_between); use Date::Calc qw(:all); use File::Basename; use String::Util qw(trim); use lib 'lib'; use Date::Verify qw(four_digit_year month_name month_number day_number +); my $month_items; my $day_stones; my $zodiac; my $inc; while (<DATA>) { chomp($_); $inc++ if (!$inc || !$_); if ( $inc == 1 && $_) { my ($month, $stone, $us_flower, $bi_flower) = split(/\|/, $_); $month = trim($month); $month_items->{$month}{stone} = trim($stone); $month_items->{$month}{flower}{US} = trim($us_flower); $month_items->{$month}{flower}{UK} = trim($bi_flower); } if ( $inc == 2 && $_ ) { my ($day, $stone) = split(/\|/, $_); $day_stones->{trim($day)} = $stone; } if ( $inc == 3 && $_ ) { my ($sign, $start_month, $start_day, $end_month, $end_day, $stone) + = split(/\|/, $_); $sign = trim($sign); $zodiac->{$sign}{name} = $sign; $zodiac->{$sign}{start_month} = trim($start_month); $zodiac->{$sign}{start_day} = $start_day; $zodiac->{$sign}{end_month} = trim($end_month); $zodiac->{$sign}{end_day} = $end_day; $zodiac->{$sign}{stone} = $stone; } } # commify, round, and pretty_number all make my numbers more readable. # commify was found in the perldocs to put commas in numbers. sub commify { local $_ = shift; 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; return $_; } sub month_stone { my ($month) = @_; $month = month_name($month); return $month_items->{$month}{stone}; } sub month_flower { my ($month, $country) = @_; $month = month_name($month); return $month_items->{$month}{flower}{$country}; } sub day_stone { my ($year, $month, $day) = @_; $month = month_number($month); my $dow = Day_of_Week($year, $month, $day); my $day_word = Day_of_Week_to_Text($dow); return $day_stones->{$day_word}; } sub sign { my ($month, $day) = @_; $month = month_name($month); my $sign_name; for my $base_sign (keys %$zodiac) { my $sign = $zodiac->{$base_sign}; if (($month eq $sign->{start_month} && $day >= $sign->{start_day}) + || ($month eq $sign->{end_month} && $day <= $sign->{end_day})) { $sign_name = $sign->{name}; } } return $sign_name; } sub sign_stone { my ($sign) = @_; return $zodiac->{$sign}{stone}; } my ($name, $birth_month, $birth_day, $birth_year) = @ARGV; chomp(@ARGV); if (!@ARGV) { my $file = basename($0); print "Please enter a single name and birthday ($file name month day + year).\n"; } else { $birth_year = four_digit_year($birth_year); $birth_month = month_name($birth_month); $birth_day = day_number($birth_year, $birth_month, $birth_day); my $birthday = "$birth_month $birth_day, $birth_year"; my $sign_name = sign($birth_month, $birth_day); $birthday .= " ($sign_name)" if $sign_name; my $month_stone = month_stone($birth_month); my $month_flower_US = month_flower($birth_month, 'US'); my $month_flower_UK = month_flower($birth_month, 'UK'); my $day_stone = day_stone($birth_year, $birth_month, $birth_day); my $sign_stone = sign_stone($sign_name); print "Birthday: $birthday\n"; print "Birth stone: $month_stone\n"; print "Birth flower (US): $month_flower_US\n"; print "Birth flower (UK): $month_flower_UK\n"; print "Birthday stone: $day_stone\n"; print "Sign stone: $sign_stone\n" if $sign_stone; } __DATA__ January |garnet |carnation or snowdrop |carnation February |amethyst |primrose |violet or iris March |aquamarine|daffodil |daffodil April |diamond |sweat pea |sweat pea or dais +y May |emerald |hawthorne or lily of the valley|lily of the valle +y June |pearl |rose or honeysuckle |rose July |ruby |water lily or delphinium |larkspur August |peridot |poppy or gladiolus |gladiolus September|sapphire |morning glory or aster |aster or forget-m +e-not October |opal |calendula or marigold |marigold November |topaz |chrysanthemum or peony |chrysanthemum December |turquoise |holly or Narcissus |pionsetta Sunday |topaz or diamond Monday |pearl or crystal Tuesday |ruby or emerald Wednesday|amethyst or lodestone Thursday |sapphire or carnelian Friday |emerald or cat's eye Saturday |turquiose or diamond Capricorn |December |22|January |20|ruby Aquarius |January |21|February |19|garnet Pisces |February |20|March |20|amethyst Aries |March |21|April |20|bloodstone Taurus |April |21|May |21|sapphire Gemini |May |22|June |21|agate Cancer |June |22|July |22|emerald Leo |July |23|August |22|onyx Virgo |August |23|September|23|carnelian Libra |September|24|October |23|chrysolite Scorpio |October |24|November |22|beryl Sagittarius|November |23|December |21|topaz
I know these scripts probably still need work. I just hope you find them fun, or at least interesting.
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Happy unbirthday redux! and other birthday stuff
by Lady_Aleena (Priest) on May 18, 2017 at 09:39 UTC | |
by stevieb (Canon) on May 18, 2017 at 15:06 UTC |