#!/usr/bin/perl
# Here are some date functions that I use.  They are each explained in the 
# comments for each subroutine.
# Feel free to copy, modify, distribute as you need/want.
# If there are any errors/corrections/suggestions, feel free to email 
# me at dilligaf@dilligaf.d2g.com
#
#  See examples of how they work at:  http://dilligaf.d2g.com/cgi-bin/datestuff.cgi
#
# Copyright 2001  Jeff Crum
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#

use strict;

sub dayofweek
  {
  # Liefert den Wochentag für ein Datum
  # Eingabeparameter: Tag, Monat and Jahr.
  #             z.B.: &dayofweek(18, 9, 2004);
  #  Rueckgabewert: 0=Sonntag, 1=Montag, ...
  my ($day, $month, $year) = @_;
  my ($a, $y, $m, $dow);
  my @daysinmonth = (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  # Schaltjahr?
  $daysinmonth[2]++ if ((($year%4 eq 0) && ($year%100 ne 0)) || ($year%400 eq 0));

  if (($month < 1 || $month > 12) || ($day < 1 || $day > $daysinmonth[$month]))
    {
    return(-1);
    }
  else
    {
    $a = int((14 - $month)/12);
    $y = $year - $a;
    $m = $month + (12 * $a) - 2;
    $dow = ($day + $y + int($y/4) - int($y/100) + int($y/400) + int((31 * $m)/12)) % 7;
    return($dow);
    }
  }

sub dayofmonth
  {
  # Datum des 1./2./3./4./letzten angegebenen Wochentag im Monat
  # z.B. den 2. Montag des Monats
  # Eingabeparameter: welcher (1, 2, 3, 4, L)
  #                   Wochentag (so, mo, di, mi, do, fr, sa),
  #                   Monat,
  #                   Jahr.
  #                   z.B. &dayofmonth(1, mo, 9, 2001);
  #                   Erster Montag im September 2001
  #
  #   Rueckgabewert:  Tag, Monat, Jahr
  my ($which, $dow_name, $month, $year) = @_;
  my $day;
  $which =~ tr/A-Z/a-z/;
  $dow_name =~ tr/A-Z/a-z/;
  my %daysofweek = ("so" => 0, "mo" => 1, "di" => 2, "mi" => 3, "do" => 4, "fr" => 5, "sa" => 6);
  my $dow = $daysofweek{$dow_name};
  return("Invalid Month - $month") if ($month < 1 || $month > 12);
  return("Invalid Day of Week - $dow_name") if ($dow eq "");
  if ($which eq "L" || $which eq "l")
    {
    ($day, $month, $year) = &lastnameddayofmonth($dow, $month, $year);
    return ($month, $day, $year);
    }
  else
    {
    ($day, $month, $year) = &firstnameddayofmonth($dow, $month, $year);
    return ($day, $month, $year) if ($which eq "1");
    if ($which eq "2")
      {
      $day += 7;
      return ($day, $month, $year);
      }
    elsif ($which eq "3")
      {
      $day += 14;
      return ($day, $month, $year);
      }
    elsif ($which eq "4")
      {
      $day += 21;
      return ($day, $month, $year);}
    }
  }

sub firstnameddayofmonth
  {
  # Datum des ersten spezifizierten Wochentags des Monats
  # Eingabeparameter: Wochentag numerisch (0 = so, 1 = mo, 2 = di, usw.),
  #                   Monat,
  #                   Jahr.
  #                   z.B. &firstnameddayofmonth(1, 9, 2001);
  #                   erster Montag im September
  #
  #   Rueckgabewert:  Tag, Monat, Jahr
  my ($dow, $month, $year) = @_;
  my $day = 1;
  my $dayofweek = &dayofweek($day, $month, $year);

  return("Invalid Day of Week - $dow") if ($dow < 0 || $dow > 6);
  return("Invalid Month - $month") if ($month < 1 || $month > 12);
  while ($dayofweek != $dow)
    {
    ($dayofweek, $day, $month, $year) = &inc_day($dayofweek, $day, $month, $year);
    }
  return ($day, $month, $year);
  }

sub lastnameddayofmonth
  {
  # Datum des letzten spezifizierten Wochentags des Monats
  # Eingabeparameter: Wochentag numerisch (0 = so, 1 = mo, 2 = di, usw.),
  #                   Monat,
  #                   Jahr.
  #                   z.B. &lastnameddayofmonth(1, 9, 2001);
  #                   letzter Montag im September
  #
  #   Rueckgabewert:  Tag, Monat, Jahr
  my ($dow, $month, $year) = @_;
  my $day = 1;
  $month++;
  my $dayofweek = &dayofweek($day, $month, $year);
  return("Invalid Day of Week - $dow") if ($dow < 0 || $dow > 6);
  return("Invalid Month - $month") if ($month < 1 || $month > 12);
  while ($dayofweek != $dow)
    {
    ($dayofweek, $day, $month, $year) = &dec_day($dayofweek, $day, $month, $year);
    }
  return ($day, $month, $year);
  }

sub inc_day
  {
  # Addiert 1 zum Tag
  # Eingabeparameter: Wochentag numerisch (0 = so, 1 = mo, 2 = di, usw.),
  #                   Tag,
  #                   Monat,
  #                   Jahr.
  #
  # Rueckgabewert:    Wochentag numerisch (0 = so, 1 = mo, 2 = di, usw.),
  #                   Tag,
  #                   Monat,
  #                   Jahr.
  my ($dow, $day, $month, $year) = @_;
  my @daysinmonth = (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  $daysinmonth[2]++ if ((($year%4 eq 0) && ($year%100 ne 0)) || ($year%400 eq 0));
  return("Invalid Day of Week - $dow") if ($dow < 0 || $dow > 6);
  return("Invalid Month - $month") if ($month < 1 || $month > 12);
  return("Invalid Days for Month - $day") if ($day < 1 || $day > $daysinmonth[$month]);
  $dow++;
  $dow = 0 if ($dow > 6);
  $day++;
  if ($day > $daysinmonth[$month])
    {
    $month++;
    if ($month eq 12)
      { $month = 1; $year++; }
    $day = 1;
    }
  return ($dow, $day, $month, $year);
  }

sub dec_day
{
  # Subtrahiert 1 vom Tag
  # Eingabeparameter: Wochentag numerisch (0 = so, 1 = mo, 2 = di, usw.),
  #                   Tag,
  #                   Monat,
  #                   Jahr.
  #
  # Rueckgabewert:    Wochentag numerisch (0 = so, 1 = mo, 2 = di, usw.),
  #                   Tag,
  #                   Monat,
  #                   Jahr.
  my ($dow, $day, $month, $year) = @_;
  my @daysinmonth = (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  $daysinmonth[2]++ if ((($year%4 eq 0) && ($year%100 ne 0)) || ($year%400 eq 0));
  return("Invalid Day of Week - $dow") if ($dow < 0 || $dow > 6);
  return("Invalid Month - $month") if ($month < 1 || $month > 12);
  return("Invalid Days for Month - $day") if ($day < 1 || $day > $daysinmonth[$month]);
  $dow--;
  $dow = 6 if ($dow < 0);
  $day--;
  if ($day eq 0)
    {
    $month--;
    if ($month eq 0)
      { $month = 12; $year--; }
    $day = $daysinmonth[$month];
    }
  return ($dow, $day, $month, $year);
  }

sub leapyear
  {
  # Schaltjahr
  # Eingabeparameter: Jahr
  #
  # Rueckgabewert: 1, falls Schaltjahr, sonst 0
  my ($year) = @_;
  return(1) if ((($year%4 eq 0) && ($year%100 ne 0)) || ($year%400 eq 0));
  return(0);
  }

1;
