File Coverage

blib/lib/No/Dato.pm

Criterion	Covered	Total	%
statement	88	98	89.8
branch	29	38	76.3
condition	11	18	61.1
subroutine	12	12	100.0
pod	4	7	57.1
total	144	173	83.2

package No::Dato;

use Time::Local qw(timelocal);
use Carp ();

require Exporter;
@ISA=qw(Exporter);
@EXPORT_OK = qw(tekstdato helligdag hverdag helligdager @UKEDAGER @MANEDER);

use strict;
use vars qw(%SPECIAL_DAYS @UKEDAGER @MANEDER $VERSION);

$VERSION = sprintf("%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/);


=head1 NAME

No::Dato - Norwegian dates

=head1 SYNOPSIS

  use No::Dato qw(tekstdato helligdag helligdager);

  print tekstdato(time), "\n";
  if (helligdag(time)) {
      print "Idag er det ", helligdag(time), "\n";
  }

  for (helligdager()) {
      print "$_\n";
  }


=head1 DESCRIPTION

B

Denne modulen tilbyr funksjoner for å håndtere det som er spesielt med
datoer på norsk.  Dette gjelder blant annet å identifisere offentlige
høytidsdager.

Følgende funksjoner er tilgjengelig:

=over

=cut




%SPECIAL_DAYS = (
  "nyttårsdag"            => '01-01',
  "1. mai"                => '05-01',
  "grunnlovsdag"          => '05-17',
  "juledag"               => '12-25',
  "2. juledag"            => '12-26',

  # relative to easter day
  "skjærtorsdag"          => -3,
  "langfredag"            => -2,
  "påskedag"              =>  0,
  "2. påskedag"           => +1,
  "kristi himmelfartsdag" => +39,
  "pinsedag"              => +49,
  "2. pinsedag"           => +50,
);

@UKEDAGER = qw(søndag mandag tirsdag onsdag torsdag fredag lørdag);
@MANEDER = qw(januar februar mars      april   mai      juni
              juli   august  september oktober november desember);

my %hellig_cache = ();


=item tekstdato($time)

Denne rutinen returnerer en dato formatert på formen:

  fredag, 7. februar 2004

Argumentet er en vanlig perl $time verdi.  Hvis argumentet utelates så
benyttes dagens dato.

=cut

sub tekstdato (;$)
{
    my $time = shift || time;
    my($d,$m,$y,$wd) = (localtime $time)[3,4,5,6];
    sprintf "%s, %d. %s %d", $UKEDAGER[$wd], $d, $MANEDER[$m], $y+1900;
}


=item helligdag($time)

Rutinen avgjør om en gitt dato er en norsk helligdag eller ikke.  Hvis
det er en helligdag så vil navnet på helligdagen bli returnert.  Hvis
det er en vanlig hverdag eller lørdag så vil en tom streng (som er
FALSE i perl) bli returnert.

Argumentet kan være en vanlig $time verdi eller en streng på formen
"ÅÅÅÅ-MM-DD".

For denne funksjonen er "helligdag" definert til å være det samme som
norsk offentlig høytidsdag samt søndager, dvs de dagene som er røde på
kalenderen.  Dette inkluderer nyttårsdagen, samt 1. og 17. mai selv om
disse egentlig ikke er hellige.

=cut

sub helligdag (;$$)
{
    my $date = shift || time;
    my $year;
    my $weekday;
    if ($date =~ /^\d+$/) {
	my($d,$m,$y,$w) = (localtime $date)[3,4,5,6];
	$year = $y+1900;
	$weekday = $w;
	$date = sprintf "%02d-%02d", $m+1, $d;
    } elsif ($date =~ s/^(\d{4})-(\d\d-\d\d)$/$2/) {
	$year = $1;
    } else {
        Carp::croak("Bad date '$date'");
    }
    helligdager($year) unless exists $hellig_cache{$year};
    my $day = "";
    if (exists $hellig_cache{$year}{$date}) {
	$day = $hellig_cache{$year}{$date};
    } else {
	# sjekk om det er søndag
	unless (defined $weekday) {
	    my($m, $d) = split(/-/, $date);
	    $weekday = (localtime(timelocal(12,0,0,$d, $m-1, $year-1900)))[6];
        }
        $day = "søndag" if $weekday == 0;
	$day = "lørdag" if $weekday == 6 && $_[0];
    }
    $day;
}

=item hverdag($time)

Rutinen avgjør om en gitt date er en hverdag eller ikke.  Lørdag er
her ikke regnet som hverdag.

Argumentet kan være en vanlig $time verdi eller en streng på formen
"ÅÅÅÅ-MM-DD".

=cut

sub hverdag {
    return !helligdag(shift, 1);
}

=item helligdager($year)

Denne rutinen vil returnere en liste av datostrenger, én for hver
helligdag i året gitt som argument.  Hvis argumentet mangler vil vi
bruke inneværende år.  Datostrengene er på formen:

   "ÅÅÅÅ-MM-DD skjærtorsdag"

Dvs. datoen formatert i henhold til ISO 8601 etterfulgt av navnet på
helligdagen.  Listen vil være sortert på dato.

For denne funksjonen er "helligdag" definert til å være det samme som
norsk offentlig høytidsdag.  Søndagene er ikke tatt med selv om
funksjonen helligdag(), beskrevet over, er TRUE for disse.

=cut

sub helligdager (;$)
{
    my $year = shift || (localtime)[5] + 1900;

    unless (exists $hellig_cache{$year}) {
	my $easter = easter_day($year);

	my ($text, $date);
	while (($text, $date) = each %SPECIAL_DAYS) {
	    my($month, $mday);
	    if ($date =~ /^(\d+)-(\d+)$/) {
		# a fixed date
		($month, $mday) = ($1, $2);
	    } else {
		($month, $mday) = dayno_to_date($year, $easter + $date);
	    }
	    $hellig_cache{$year}{sprintf "%02d-%02d", $month, $mday} = $text;
	}
    }

    # we want to return a sorted array
    my @days;
    for (sort keys %{$hellig_cache{$year}}) {
	push(@days, "$year-$_ $hellig_cache{$year}{$_}");
    }
    @days;
}



sub easter_day ($)
{
    use integer;
    # The algoritm is taken from LaTeX calendar macros by  C. E. Chew, which
    # has taken the algoritm from "The Calculation of Easter", D.E.Knuth,
    # CACM April 1962 p 209.

    my $year = shift;
    my $golden;                      # year in Mentonic cycle
    my $easter;                      # easter sunday
    my $grCor;                       # Gregorian correction
    my $clCor;                       # Clavian correction
    my $epact;                       # age of calendar moon at start of year
    my $century;
    my $extra;                       # when Sunday occurs in March

    $golden = ($year / 19) * -19 + $year + 1;
    if ($year > 1582) {
	$century = ($year / 100) + 1;
	$grCor = ($century * 3) / -4 + 12;
	$clCor = (($century - 18)/ -25 + $century - 16) / 3;
	$extra = ($year * 5) / 4 + $grCor - 10;
	$epact = $golden * 11 + 20 + $clCor + $grCor;
	$epact += ($epact / 30) * -30;
	$epact += 30 if $epact <= 0;
	if ($epact == 25) {
	    $epact++ if $golden > 11;
	} else {
	    $epact++ if $epact == 24;
	}
    } else {                              # year <= 1582
	$extra = ($year * 5) / 4;
	$epact = ($golden * 11) - 4;
	$epact += ($epact / 30) * -30 + 1;
    }
    $easter = -$epact + 44;
    $easter += 30 if $easter < 21;
    $extra += $easter;
    $extra += ($extra / 7) * -7;
    $extra = -$extra;
    $easter += $extra + 7;
    # easter is now a date in march

    # convert to a dayno relative to 1. jan
    $easter += 31 + 28;   # days in january and february
    $easter++ if leap_year($year);
    $easter;
}


sub leap_year ($)
{
    my $year = shift;
    (($year % 4 == 0) && ($year % 100 != 0)) || ($year % 400 == 0);
}


sub dayno_to_date($$)
{
    my($year, $dayno) = @_;
    my @days_pr_month = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
    my $maxdayno = 365;
    if (leap_year($year)) {
	$days_pr_month[1]++;
	$maxdayno++;
    }
    die "Dayno $dayno out of range" if $dayno < 1 || $dayno > $maxdayno;

    my $month = 1;
    while ($dayno > $days_pr_month[0]) {
	$month++;
	$dayno -= shift @days_pr_month;
    }

    ($month, $dayno);
}

1;
__END__