Re: 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
[download]

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
[download]

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
[download]

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
[download]

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;
}
[download]

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

Comment on Re: Happy unbirthday redux! and other birthday stuff Select or Download Code


more useful options
	PerlMonks