lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / WeekCalculator.pm

package Lire::WeekCalculator;

use strict;

use Carp;
use Time::Local;
use POSIX qw/ strftime mktime localtime /;

use Lire::Config;

use vars qw/ $haveV /;

=pod

=head1 NAME

Lire::WeekCalculator - handle different weeknumbering schemes

=head1 SYNOPSIS

    use Lire::WeekCalculator;

    my $week_calc = new Lire::WeekCalculator();
    my $week_no   = $week_calc->week_number( $time );

=head1 DESCRIPTION

We support three values for LR_WEEK_NUMBERING: ISO (strftime's %V):
week starts on monday; W (week starts on monday) and U (week starts on
sunday). See strftime(1).

=cut

# week numbering voodoo:
# in non-iso case, some weeks have two names:
# sunday december 30 2001 - saturday jan 5 2002 is known as
# 2001's week 53 and 2002's week 00, in the %U case.  We use
# only the 2001 week 53 name for this (complete) week.  Lire
# never shows statistics for week 00. A similar case holds
# for %W numbering.
#

# requirements:

#We should contruct Lire_number from a date and config, and construct
#weekstring from Lire_number and config

=pod

=head1 CONSTRUCTOR

=head2 new( %params )

Creates a new week calculator. The style of week numbering is selected
using the C<style> parameter. If that parameter is omitted, it
defaults to the style set in 'lr_week_numbering' configuration variable.

=cut

sub new {
    my ( $class, %params ) = @_;

    my $style = $params{'style'} || Lire::Config->get( 'lr_week_numbering' );

    my $self = bless { 'style' => $style }, $class;

    if ( $style eq 'W' ) {
        # range 00 to 53, week starts at monday
        $self->{'fmt'} = '%W';
    } elsif ( $style eq 'U' ) {
        # range 00 to 53
        # if jan 1 is a sunday, its in week 01, else in week 00.
        $self->{'fmt'} = '%U';
    } elsif ( $style eq 'ISO' ) {
        # LR_WEEK_NUMBERING is ISO, range 01 to 53, indicate week like
        # e.g. `2002-W37'
        $self->{'fmt'} = '%V';
    } else {
        croak "invalid week numbering style: $style (should be W, U or ISO )\n"
    }

    $haveV = (strftime('%V', POSIX::localtime(time) ) ne '%V')
        unless defined $haveV;

    return $self;
}


=pod

=head2 style()

Returns the week numbering style used. This will be either C<U>, C<W>
or C<ISO>.

=cut

sub style {
    $_[0]{'style'};
}

=pod

=head2 week_number( $time )

Returns the week number of $time according the current week numbering
scheme. The week number returned is between 1 and 53.

=cut

sub week_number {
    my ( $self, $time ) = @_;

    return $self->strfdate( $self->{'fmt'}, localtime $time) + 0;
}

=pod

=head2 week_idx( $time )

Returns the week index of $time according to the week numbering
scheme. The week index is Lire specific and is used to normalise
computations between different scheme in regards of the first
incomplete week of the year. In the ISO case, the week index is always
equals to week_number() - 1, for the other style, the week index of
the week 0 will be one less than the last week number of the previous
year.

=cut

sub week_idx {
    my ( $self, $time ) = @_;

    my $week_idx = $self->week_number( $time ) - 1;
    if ( $self->{'style'} ne 'ISO' && $week_idx < 0 ) {
        my $year = (localtime( $time ))[5] + 1900;
        return $self->last_week_of_year( $year ) - 1;
    }

    return $week_idx;
}

=pod

=head2 last_week_of_year($year)

Returns the week number of the last week in the year $year.

=cut

sub last_week_of_year {
    my ($self, $year) = @_;

    $year = $year - 1900 if $year >= 1900;

    # Look into the cache first
    return $self->{'year_last_week'}{$year}
      if $self->{'year_last_week'}{$year};

    # When using ISO style, the week of December 31st may be
    # week 1, so we need to find the last assigned week number in
    # December
    my $last_week;
    my $day = 31;
    do {
        $last_week = $self->strfdate( $self->{'fmt'}, (0,0,0,$day,11,$year) )+0;
        $day--;
    } while ( $last_week < 52 );

    return $self->{'year_last_week'}{$year} = $last_week;
}

=pod

=head2 week_start( $year, $week_no )

Returns the epoch time of the first day of week $week_no in year $year
when calculated using current style.

=cut

sub week_start {
    my ( $self, $year, $week_no ) = @_;

    my $week1_start = $self->find_year_week1_start_date( $year );

    # If week == 0, this will be 7 days before (in the previous year)
    # the start of week 1
    return $week1_start + 86400 * 7 * ($week_no - 1);
}

=pod

=head2 find_year_week1_start_date($year)

Returns the date (epoch) at which the first day of the first week
of the year $year starts.

=cut

sub find_year_week1_start_date {
    my ($self, $year) = @_;

    $year = $year - 1900 if $year >= 1900;

    # Look into the cache first
    return $self->{'week1_start'}{$year}
      if $self->{'week1_start'}{$year};

    # Start the search at the end of the previous year
    # for ISO case
    my $year_o = $year;
    my ($time, $week_no);
    my $date = 28;
    my $month = 11;
    $year = $year_o - 1;
    do {
        $time = timelocal( 0, 0, 0, $date, $month, $year );
        $week_no = $self->strfdate( $self->{'fmt'}, localtime($time) )+0;
        $date++;
        if ( $date == 32 ) {
            $year++;
            $month = 0;
            $date = 1;
        }
    } while ( $week_no != 1 );

    return $self->{'week1_start'}{$year_o} = $time;
}

=pod

=head2 strformat()

Returns a string that can be used as the format specificier in calls
to strftime to print the week number of this style.

=cut

sub strformat {
    my ( $self ) = @_;

    return $self->{'style'} eq 'ISO' ? "%G-W%V" : "Week $self->{'fmt'}, %Y";
}

=pod

=head2 strfdate()

Emulates POSIX::strftime() but picks up the %V if the system strftime
doesn't support it. Should be called whenever you use format strings
that may contain week-of-the-year-codes.

=cut

sub strfdate {
    my $self = shift;
    my $fmt = shift;

    if(!$haveV and $_[0] =~ /\%V/) {
        my $d = $_[6] || 7;
        my @c = localtime(mktime(@_) - ($d-4)*86400);
        my $v = int($c[7]/7)+1;
        $v = '0'.$v
            if $v < 10;
        $fmt =~ s/\%V/$v/g;
    }

    return strftime($fmt, @_)
}

1;

__END__

=pod

=head1 AUTHORS

  Joost van Baal <joostvb@logreport.org>,
  Francis J. Lacoste <flacoste@logreport.org>,
  Wessel Dankers <wsl@logreport.org>

=head1 VERSION

$Id: WeekCalculator.pm,v 1.16 2006/07/23 13:16:30 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2002 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html.

=cut