DiscoDatePerlModule

From S23Wiki
Jump to: navigation, search

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

From the DRT [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]; }

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

---

also see: DateTime-Calendar-Discordian-0.0.1 on cpan.org