http://www.perlmonks.org?node_id=1190518


in reply to Happy unbirthday redux! and other birthday stuff

I have decided to burst the subroutines from birthday into separate modules. It may be overkill, but I was inspired.

Date::Birth::Stone

package Date::Birth::Stone; use strict; use warnings FATAL => qw( all ); use Exporter qw(import); our @EXPORT = qw(birth_stone); use String::Util qw(trim); my $stones; while (<DATA>) { chomp($_); my ($month, $stone) = split(/\|/, $_); $month = trim($month); $stones->{$month} = trim($stone); } sub birth_stone { my ($month) = @_; return $stones->{$month}; } =head1 NAME B<Date::Birth::Stone> returns the birth stone associated with months. =head1 SYNOPSIS my $birth_stone = birth_stone('July'); # ruby =head1 DESCRIPTION C<birth_stone> is exported by default and returns the birth stone asso +ciated with the month entered. =head1 AUTHOR Lady Aleena =cut 1; __DATA__ January |garnet February |amethyst March |aquamarine April |diamond May |emerald June |pearl July |ruby August |peridot September|sapphire October |opal November |topaz December |turquoise

Date::Birth::Flower

package Date::Birth::Flower; use strict; use warnings FATAL => qw( all ); use Exporter qw(import); our @EXPORT = qw(birth_flower); use String::Util qw(trim); my $flowers; while (<DATA>) { chomp($_); my ($month, $us_flower, $bi_flower) = split(/\|/, $_); $month = trim($month); $flowers->{$month}{US} = trim($us_flower); $flowers->{$month}{UK} = trim($bi_flower); } sub birth_flower { my ($month, $country) = @_; return $flowers->{$month}{$country}; } =head1 NAME B<Date::Birth::Flower> returns the birth flower associated with months +. =head1 SYNOPSIS my $birth_flower = birth_flower('July', 'US'); # water lily or delphinium =head1 DESCRIPTION C<birth_flower> is exported by default and returns the birth flower as +sociated with the month and country entered. There are currently only + two countries with birth flowers, the US and the UK, as far as I kno +w. =head1 AUTHOR Lady Aleena =cut 1; __DATA__ January |carnation or snowdrop |carnation February |primrose |violet or iris March |daffodil |daffodil April |sweat pea |sweat pea or daisy May |hawthorne or lily of the valley|lily of the valley June |rose or honeysuckle |rose July |water lily or delphinium |larkspur August |poppy or gladiolus |gladiolus September|morning glory or aster |aster or forget-me-not October |calendula or marigold |marigold November |chrysanthemum or peony |chrysanthemum December |holly or Narcissus |pionsetta

Date::Birth::DayStone;

package Date::Birth::DayStone; use strict; use warnings FATAL => qw( all ); use Exporter qw(import); our @EXPORT = qw(day_stone); use Date::Calc qw(:all); use String::Util qw(trim); use Date::Verify qw(month_number); my $day_stones; while (<DATA>) { chomp($_); my ($day, $stone) = split(/\|/, $_); $day_stones->{trim($day)} = $stone; } 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}; } =head1 NAME B<Date::Birth::DayStone> returns the birthday stone for the day of the + week you were born. =head1 SYNOPSIS my $day_stone = day_stone(1970, 'July', 3); # emerald or cat's eye =head1 DESCRIPTION C<day_stone> is exported by default and returns the birthday stone ass +ociated with the day of the week you were born. Enter the 4-digit yea +r, the month, and day you were born. =head1 AUTHOR Lady Aleena =cut 1; __DATA__ 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

Zodiac::Stone

package Zodiac::Stone; use strict; use warnings FATAL => qw( all ); use Exporter qw(import); our @EXPORT = qw(sign zodiac_stone); use String::Util qw(trim); use Date::Verify qw(four_digit_year month_name month_number day_number +); my $zodiac; while (<DATA>) { chomp($_); 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; } sub sign { my ($month, $day) = @_; 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 zodiac_stone { my ($sign) = @_; return $zodiac->{$sign}{stone}; } =head1 NAME B<Zodiac::Stone> returns the stone associated with zodiac signs. =head1 SYNOPSIS my $zodiac_stone = zodiac_stone('Cancer'); # emerald =head1 DESCRIPTION C<zodiac_stone> is exported by default and returns the stone associate +d with the sign entered. If you do not know your zodiac sign, you can use C<sign> to determine +your sign using your birth month and day. =head1 AUTHOR Lady Aleena =cut 1; __DATA__ 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

And all of the above changes birthday.pl to the following:

#!/usr/bin/perl use strict; use warnings FATAL => qw( all ); use Date::Calc qw(:all); use File::Basename; use lib '../files/lib'; use Date::Verify qw(four_digit_year month_name month_number day_number +); use Date::Birth::Stone; use Date::Birth::Flower; use Date::Birth::DayStone; use Zodiac::Stone; 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 (or quote the full name) and birth +day: $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 = birth_stone($birth_month); my $month_flower_US = birth_flower($birth_month, 'US'); my $month_flower_UK = birth_flower($birth_month, 'UK'); my $day_stone = day_stone($birth_year, $birth_month, $birth_day); my $sign_stone = zodiac_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; }

This was a fun exercise.

No matter how hysterical I get, my problems are not time sensitive. So, relax, have a cookie, and a very nice day!
Lady Aleena

Replies are listed 'Best First'.
Re^2: Happy unbirthday redux! and other birthday stuff
by stevieb (Canon) on May 18, 2017 at 15:06 UTC

    Nice effort.

    I would highly recommend using @EXPORT_OK as opposed to @EXPORT. The latter forces the sub names into the caller's namespace. Even though you only have a single sub in most cases, it's still nicer to not pollute a namespace automatically:

    our @EXPORT_OK = qw( sub_one sub_two sub_three ); our %EXPORT_TAGS; $EXPORT_TAGS{all} = [@EXPORT_OK];

    Now, you can do:

    use My::Module qw(sub_one sub_three);

    ...or even:

    use My::Module qw(:all);

    ...which will import all @EXPORT_OK listed subs.