imported>mutante m (despam) |
imported>DrOwl mNo edit summary |
||
Line 6: | Line 6: | ||
*<pre> |
*<pre> |
||
package Discodate; |
|||
require Exporter; |
require Exporter; |
||
Line 555: | Line 556: | ||
=cut |
=cut |
||
</pre> |
Revision as of 10:55, 20 January 2005
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);
- Set the century. If you don't know what the current century is,
- ask your system administrator.
$century = 1900;
- Say, how 'bout them month things?
@days_in_the_months = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
=head1 NAME
Discodate - Handles Discordian date manipulations
=head1 SYNOPSIS
use Discodate; $today = GfToDisco( "today" ); # Today in Discordian # Get today's date in text form @date = GetDiscoText( $today ); # print "weekday, season date, year" print "Today is $date[2], $date[1] $date[3], $date[0]";
=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<GfToDisco>($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<DiscoToGf>($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<GetDiscoText>($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<Year> is the Discordian year (always numeric)
I<Season> is one of "Chaos", "Discord", "Confusion", "Bureaucracy", "The Aftermath"
I<Weekday> is one of "Saint Tib's Day", "Sweetmorn", "Boomtime", "Pungenday", "Prickle-Prickle", "Setting Orange"
I<Day> is numeric, except when it's St. Tibb's -- then this is "between 59 and 60"
I<AD> Is a string describing the Apostle Holyday, if appropriate
I<SD> 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<GetGfText>($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<GetDiscoValues>($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<AD> is the Apostle Holyday, if appropriate
I<SD> 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<GetGfValues>($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<DeltaDiscoDate>($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<IncDiscoDate>($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