DiscoDatePerlModule

From the DRT [Discodate.pm] Discodate.pm is a Perl Module that provides more complex Discordian Date computations than the other existing perl Discordian date modules we've tried. This was actually developed (and is used) for all of the date computations used in this website (particularly on the news page).

The documentation is skimpy, but it's pretty straightforward so you should be able to figure it out. We're happy to answer any questions you may have, too. To see the documentation, download the module, then issue this command: perldoc -F Discodate.pm

package Discodate; require Exporter;

our @ISA      = qw(Exporter); our @EXPORT   = qw(GetGfValues GfToDisco GetDiscoValues GetDiscoText DiscoToGf GetGfText                     DeltaDiscoDate IncDiscoDate DecDiscoDate DiscoDateToDays GetStartOfDiscoWeek										 GetStartOfNextDiscoWeek);    # Symbols to be exported by default our @EXPORT_OK = qw(interpretGfDate getCurGfDate convertToDisco interpretDiscoDate getDWeekday                   getDWeekdayAbbrev getDSeason getDSeasonAbbrev getDApostleDay getDHolyday 										getDDay convertToGf getGMonth);  # Symbols to be exported on request our $VERSION  = 1.00;         # Version number

use Date::Calc qw( Add_Delta_Days Date_to_Days);

$century = 1900;
 * 1) Set the century.  If you don't know what the current century is,
 * 2) ask your system administrator.

@days_in_the_months = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
 * 1) Say, how 'bout them month things?

=head1 NAME

Discodate - Handles Discordian date manipulations

=head1 SYNOPSIS

use Discodate; $today = GfToDisco( "today" );  # Today in Discordian @date = GetDiscoText( $today ); print "Today is $date[2], $date[1] $date[3], $date[0]";
 * 1) Get today's date in text form
 * 1) print "weekday, season date, year"

=head1 DESCRIPTION

Handles all kinds of Dicordian calendar calculations, in one tidy little package. The focus is mostly on Disco dates, not normal dates, however this module requires the Calc modules anyhow, so you can use it for your normal greyfaced drudgery.

Date Format

These routines use the same basic date format, whether we're talking about Greyface or Discordian dates. The format is an 8 digit number:

YYYYSSDD

Y = Year, S = Season (or Month), D = Day

Aso, nearly any routine that takes a date can also take any of the self-explanatory constants: "yesterday", "today", "now", and "tomorrow".

The following functions are available as the default export:

=over 4

=item $date = B($date)

Pass this a greyface date. It will return the Discordian equivalent. To get today's date in Discordian, you would say: GfToDisco( "now" ); =cut

sub GfToDisco { return( convertToDisco( interpretGfDate( @_[0] ) ) ); }

=item $date = B($date)

Pass this a Discordian date. It will return the greyface equivalent. To get today's date in Greyface, you would say: DiscoToGf( "now" ); =cut

sub DiscoToGf { return convertToGf( interpretDiscoDate( @_[ 0 ] ) ); }

=item $date = B($date)

Pass this a Discordian date. It will return an array of text strings describing the date.

The array returned has the strings in the order: Year, Season, Weekday, Day, AD, SD.

I is the Discordian year (always numeric)

I is one of "Chaos", "Discord", "Confusion", "Bureaucracy", "The Aftermath"

I is one of "Saint Tib's Day", "Sweetmorn", "Boomtime", "Pungenday", "Prickle-Prickle", "Setting Orange"

I is numeric, except when it's St. Tibb's -- then this is "between 59 and 60"

I Is a string describing the Apostle Holyday, if appropriate

I Is a string describing the Season Holyday, if appropriate =cut

sub GetDiscoText { local @temp = GetDiscoValues( interpretDiscoDate( @_[0] ) ); return ( $temp[ 0 ], getDSeason( $temp[ 1 ] ), getDWeekday( $temp[ 2 ] ), getDDay( $temp[ 3 ] ), getDApostleDay( $temp[ 4 ] ), getDHolyday( $temp[ 5 ] ) ); }

=item $date = B($date)

Decipher the Greyface date, and return an array of strings describing it.

The array returned has the strings in the order: Year, Month, Day

=cut

sub GetGfText { local @temp = GetGfValues( interpretGfDate( @_[ 0 ] ) ); return( $temp[ 0 ], &getGMonth( $temp[ 1 ] ), $temp[ 2 ] ); }

=item $date = B($date)

Decipher the Discordian date, and return an array of numbers describing it.

The array returned has the values in the order: Year, Season, Weekday, Day, AD, SD

I is the Apostle Holyday, if appropriate

I is Season Holyday, if appropriate

=cut

sub GetDiscoValues { local ($indate) = interpretDiscoDate( @_[ 0 ] ); local($dweekday, $dday, $dseason, $dyear) = (-5, -5, -5, -5); local ($dapostleday, $dholyday ) = (-5, -5);

$dyear = substr( $indate, 0, 4 ); $dseason = substr( $indate, 4, 2 ); $dday = substr( $indate, 6, 2 );

# We have to determine the weekday for ourselves. # if( $dday == 0 ) {   # It's St. Tib's day! $dweekday = 0; } else {   local ($dday_of_year) = int( ( ( $dseason - 1 ) * 73 ) + $dday ); $dweekday = $dday_of_year % 5; $dweekday = 5 if( $dweekday == 0 ); }

$dapostleday = $dseason if( $dday == 5 ); $dholyday = $dseason if( $dday == 50 );

return( $dyear, $dseason, $dweekday, $dday, $dapostleday, $dholyday ); }

=item $date = B($date)

Decipher the Greyface date, and return an array of numbers describing it.

The array returned has the values in the order: Year, Month, Day

=cut

sub GetGfValues { local $indate = interpretGfDate( @_[0] ); local $gday, $gmonth, $gyear;

$gyear = substr( $indate, 0, 4 ); $gmonth = substr( $indate, 4, 2 ); $gday = substr( $indate, 6, 2 );

return( $gyear, $gmonth, $gday ); }

=item $date = B($date. delta)

Adds multiple days to a Discordian date, and returns the new date. Add a negative number of days to go earlier in time.

=cut

sub DeltaDiscoDate { local ($date, $offset ) = @_; local $indate = convertToGf( interpretDiscoDate( $date ) ); local ( $nyear, $nmonth, $nday ) = GetGfValues( $indate ); ($nyear,$nmonth,$nday) = Add_Delta_Days($nyear,$nmonth,$nday, $offset); $nmonth =~ s/^([0-9])$/0$1/; $nday =~ s/^([0-9])$/0$1/; return( convertToDisco( "$nyear$nmonth$nday" ) ); }

=item $date = B($date)

Adds 1 day to a Discordian date, and returns the new date.

This is the same as using:

$date = DeltaDiscoDate( $date, 1 );

=cut

sub IncDiscoDate { return( DeltaDiscoDate( @_[0], 1 ) ); }

=item $date = B<DecDiscoDate>($date)

Subtracts 1 day to a Discordian date, and returns the new date.

This is the same as using:

$date = DeltaDiscoDate( $date, -1 );

=cut

sub DecDiscoDate { return( DeltaDiscoDate( @_[0], -1 ) ); }

=item $date = B<DiscoDateToDays>($date)

This performs the same operation as Date::Calc::Date_to_Days, except on a Discordian date. In other words, it returns the absolute number of the day of the given date, counting from January 1, 1 AD (Gregorian).

=cut

sub DiscoDateToDays { local $indate = convertToGf( interpretDiscoDate( @_[ 0 ] ) ); local ( $nyear, $nmonth, $nday ) = GetGfValues( $indate ); return( Date_to_Days($nyear,$nmonth,$nday) ); }

=item $date = B<GetStartOfDiscoWeek>($date)

Given a Discordian Date, this returns the Discordian date which marks the start of the week containing the date indicated.

=cut

sub GetStartOfDiscoWeek { local ($indate) = interpretDiscoDate( @_[ 0 ] ); local @temp = GetDiscoValues( @_[ 0 ] ); local $d = $temp[2];

return "$temp[0]0156" if( $d == 0 ); # Handle St. Tibb's special return( DeltaDiscoDate( $indate, 1 - $d ) ); }

=item $date = B<GetStartOfNextDiscoWeek>($date)

Given a Discordian Date, this returns the date of the first day of the week following that date.

=cut

sub GetStartOfNextDiscoWeek { local ($indate) = interpretDiscoDate( @_[ 0 ] ); local @temp = GetDiscoValues( @_[ 0 ] );

return "$temp[0]0161" if( $temp[2] == 0 ); # Handle St. Tibb's special return( DeltaDiscoDate( $indate, 6 - $temp[ 2 ] ) ); }



=back

There are a set of lowlevel helper functions that can be explicitely exported as well. You shouldn't ever need them, but if you do, look inside Discodate.pm to figure them out.

=cut

sub interpretGfDate { local ($indate) = @_; local $offset = 0;

if( ( $indate eq "today" ) || ( $indate eq "now" ) ) {   return getCurGfDate; }	elsif( $indate eq "yesterday" ) {	 $offset = -1; }	elsif( $indate eq "tomorrow" ) {	 $offset = 1; }	else {	 return( $indate ); } local ( $nyear, $nmonth, $nday ) = &GetGfValues( getCurGfDate );    # This causes a harmless recursion through interpeGfDate ($nyear,$nmonth,$nday) = Add_Delta_Days($nyear,$nmonth,$nday, $offset); $nmonth =~ s/^([0-9])$/0$1/; $nday =~ s/^([0-9])$/0$1/; return( "$nyear$nmonth$nday" ); }

sub interpretDiscoDate { local ($indate) = @_; local $offset = 0;

if( ( $indate eq "today" ) || ( $indate eq "now" ) ) {   return convertToDisco( getCurGfDate ); }	elsif( $indate eq "yesterday" ) {	 $offset = -1; }	elsif( $indate eq "tomorrow" ) {	 $offset = 1; }	else {	 return( $indate ); } local ( $nyear, $nmonth, $nday ) = &GetGfValues( getCurGfDate );    # This causes a harmless recursion through interpeGfDate ($nyear,$nmonth,$nday) = Add_Delta_Days($nyear,$nmonth,$nday, $offset); $nmonth =~ s/^([0-9])$/0$1/; $nday =~ s/^([0-9])$/0$1/; return( convertToDisco( "$nyear$nmonth$nday" ) ); }

sub getCurGfDate { local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);

# Use the groovy perl time interface. ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;

# Fix the screwed up results from the groovy perl time interface. $mon++; $year += $century;

$mon =~ s/^([0-9])$/0$1/; $mday =~ s/^([0-9])$/0$1/;

return "$year$mon$mday"; }

sub convertToDisco { local ($indate) = @_; local $gday, $gmonth, $gyear; local($dweekday, $dday, $dseason, $dyear) = (-5, -5, -5, -5); local($fnord);

$gyear = substr( $indate, 0, 4 ); $gmonth = substr( $indate, 4, 2 ); $gday = substr( $indate, 6, 2 );

# Figure out the correct year. Easy peasy. $dyear = $gyear + 1166;

# Now what day of the year is this? local($day_of_year) = $gday; for( 1 .. ($gmonth - 1) ) {   $day_of_year += @days_in_the_months[$_ - 1]; }

# What season is it? Seasons are seventy-three days long. There # are _five_ seasons in a year. Seven minus three is four, which is # two squared. Take one of those twos, and add it to the three: # you get _five_. Take the other two, subtract it from the seven: # you get _five_. $dseason = int(($day_of_year-1) / 73) + 1;

if (($gmonth == 2) && ($gday == 29)) {   # Happy St. Tib's day! Time for Jello (tm). $dweekday = 0; $dday = 0; } else {   # St. Tib will have to wait. $dweekday = (($day_of_year - 1) % 5) + 1; $dday = (($day_of_year - 1) % 73) + 1; }

$dseason =~ s/^([0-9])$/0$1/; $dday =~ s/^([0-9])$/0$1/; return "$dyear$dseason$dday"; }

sub convertToGf { local ($indate) = @_; local $gday, $gmonth, $gyear; local $dday, $dseason, $dyear;

$dyear = substr( $indate, 0, 4 ); $dseason = substr( $indate, 4, 2 ); $dday = substr( $indate, 6, 2 );

# Figure out the correct year. Easy peasy. $gyear = $dyear - 1166;

if( $dday == 0 ) {   # St. Tib's Day! $gmonth = 2; $gday = 29; } else {   # Now what day of the year is this? local ($day_of_year) = int( ( ( $dseason - 1 ) * 73 ) + $dday );

# what month is it? #   $temp = $day_of_year; $gday = "0";

for( 0 .. 11 ) {     if( $temp <= @days_in_the_months[$_] ) {       $gday = $temp; $gmonth = $_ + 1; last; }     else {       $temp -= @days_in_the_months[$_]; }   }  }

$gmonth =~ s/^([0-9])$/0$1/; $gday =~ s/^([0-9])$/0$1/; return "$gyear$gmonth$gday"; }

sub getDWeekday { return ( "Saint Tib's Day", "Sweetmorn", "Boomtime", "Pungenday", "Prickle-Prickle", "Setting Orange", )[@_[0]]; } sub getDWeekdayAbbrev { return ( "STD", "SM", "BT", "PD", "PP", "SO", )[@_[0]]; } sub getDSeason { return ( "Chaos", "Discord", "Confusion", "Bureaucracy", "The Aftermath", )[@_[0] - 1]; } sub getDSeasonAbbrev { return ( "Chs", "Dsc", "Cfn", "Bcy", "Afm", )[@_[0] - 1]; }

sub getDApostleDay { if( @_[0] == -5 ) {   return ""; } else {   return( "Mungday", "Mojoday", "Syaday", "Zaraday", "Maladay", )[@_[0] - 1]; } }

sub getDHolyday { if( @_[0] == -5 ) {   return ""; } else {   return( "Chaoflux", "Discoflux", "Confuflux", "Bureflux", "Afflux", )[@_[0] - 1]; } }

sub getDDay { local $dday;

if (@_[0] == 0) {   $dday = "between 59 and 60"; } else {   $dday = @_[0]; }

return $dday; }

sub getGMonth { return ( "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December", )[@_[0] - 1]; }

=head1 LICENSE and Credits

This is released under the Gnu Public License (http://www.gnu.org/licenses/gpl.txt) by the Barry Bittwister Cabal (http://www.singlenesia.com)

All of the interesting and important bits were stolen from ddate.perl (ftp://yoyo.cc.monash.edu.au/listserv/flat-earth/norton/ddate.perl) by Reverend I. C. Puckett, DurhamDiscordianGleeClub

=cut