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::Verify
Date::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.
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
In closing
I know these scripts probably still need work. I just hope you find them fun, or at least interesting.
No matter how hysterical I get, my problems are not time sensitive. So, relax, have a cookie, and a very nice day!
Lady Aleena