# standards-version -- lintian check script -*- perl -*-

# Copyright (C) 1998 Christian Schwarz and Richard Braakman
#
# This program 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.  If not, you can find it on the World Wide
# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.

package Lintian::standards_version;
use strict;

use Date::Parse qw(str2time);
use POSIX qw(strftime);
use Parse::DebianChangelog;

use Tags;
use Util;

# This is a list of all known standards versions, current and older, with
# their dates of publication.
my @standards =
    ([ '3.8.0'  => '2008-06-04' ],
     [ '3.7.3'  => '2007-12-03' ],
     [ '3.7.2'  => '2006-05-03' ],
     [ '3.7.1'  => '2006-05-03' ],
     [ '3.7.0'  => '2006-04-26' ],
     [ '3.6.2'  => '2005-06-17' ],
     [ '3.6.1'  => '2003-08-19' ],
     [ '3.6.0'  => '2003-07-09' ],
     [ '3.5.10' => '2003-05-10' ],
     [ '3.5.9'  => '2003-03-07' ],
     [ '3.5.8'  => '2002-11-15' ],
     [ '3.5.7'  => '2002-08-31' ],
     [ '3.5.6'  => '2001-07-25' ],
     [ '3.5.5'  => '2001-06-01' ],
     [ '3.5.4'  => '2001-04-28' ],
     [ '3.5.3'  => '2001-04-15' ],
     [ '3.5.2'  => '2001-02-18' ],
     [ '3.5.1'  => '2001-02-15' ],
     [ '3.5.0'  => '2001-01-29' ],
     [ '3.2.1'  => '2000-08-24' ],
     [ '3.2.0'  => '2000-07-30' ],
     [ '3.1.1'  => '1999-11-16' ],
     [ '3.1.0'  => '1999-11-04' ],
     [ '3.0.1'  => '1999-07-15' ],
     [ '3.0.0'  => '1999-07-01' ],
     [ '2.5.1'  => '1999-04-27' ],
     [ '2.5.0'  => '1998-10-29' ],
     [ '2.4.1'  => '1998-04-14' ],
     [ '2.4.0'  => '1998-01-30' ],
     [ '2.3.0'  => '1997-09-01' ],
     [ '2.2.0'  => '1997-07-13' ],
     [ '2.1.3'  => '1997-03-15' ],
     [ '2.1.2'  => '1996-11-23' ],
     [ '2.1.1'  => '1996-09-12' ],
     [ '2.1.0'  => '1996-09-01' ],
     [ '2.0.1'  => '1996-08-31' ],
     [ '2.0.0'  => '1996-08-26' ],
     [ '0.2.1'  => '1996-08-23' ],
     [ '0.2.0'  => '1996-08-21' ]);
my %standards = map { $$_[0] => $$_[1] } @standards;
my $current = $standards[0][0];
my @current = split (/\./, $current);

sub run {

my $pkg = shift;
my $type = shift;
my $info = shift;

# udebs aren't required to conform to policy, so they don't need
# Standards-Version. (If they have it, though, it should be valid.)
my $version = $info->field('standards-version');
if (not defined $version) {
    tag 'no-standards-version-field' unless $type eq 'udeb';
    return 0;
}

# Check basic syntax and strip off the fourth digit.  People are allowed to
# include the fourth digit if they want, but it indicates a non-normative
# change in Policy and is therefore meaningless in the Standards-Version
# field.
unless ($version =~ m/^\s*(\d+\.\d+\.\d+)(?:\.\d+)?\s*$/) {
    tag 'invalid-standards-version', $version;
    return 0;
}
my $stdver = $1;
my ($major, $minor, $patch) = $stdver =~ m/^(\d+)\.(\d+)\.(\d+)/;

# To do some date checking, we have to get the package date from the changelog
# file.  If we can't find the changelog file, assume that the package was
# released today, since that activates the most tags.
my $changes = $info->changelog;
my $pkgdate;
if (defined $changes) {
    my ($entry) = $changes->data;
    $pkgdate = $entry ? $entry->Timestamp : 0;
} else {
    $pkgdate = time;
}

# Check for packages dated prior to the date of release of the standards
# version with which they claim to comply.
if ($standards{$stdver} && str2time($standards{$stdver}, '+0000') > $pkgdate) {
    my $pretty = strftime ('%Y-%m-%d', gmtime $pkgdate);
    tag 'timewarp-standards-version', "($pretty < $standards{$stdver})";
}

my $tag = "$version (current is $current)";
if (not exists $standards{$stdver}) {
    # Unknown standards version.  Perhaps newer?
    if (   ($major > $current[0])
        or ($major == $current[0] and $minor > $current[1])
        or ($major == $current[0] and $minor == $current[1]
            and $patch > $current[2])) {
        tag 'newer-standards-version', $tag;
    } else {
        tag 'invalid-standards-version', $version;
    }
} elsif ($stdver eq $current) {
    # Current standard.  Nothing more to check.
    return 0;
} else {
    # Otherwise, we need to see if the standard that this package declares is
    # both new enough to not be ancient and was the current standard at the
    # time the package was uploaded.
    #
    # A given standards version is considered obsolete if the version
    # following it has been out for at least two years (so the current version
    # is never obsolete).
    my $obsdate = time;
    for my $index (0 .. $#standards) {
        if ($standards[$index][0] eq $stdver) {
            $obsdate = $standards[$index - 1][1] if $index > 0;
            last;
        }
    }
    if (str2time($obsdate, '+0000') + (60 * 60 * 24 * 365 * 2) < time) {
        tag 'ancient-standards-version', $tag;
    } else {
        # We have to get the package date from the changelog file.  If we
        # can't find the changelog file, always issue the tag.
        my $changes = $info->changelog;
        if (not defined $changes) {
            tag 'out-of-date-standards-version', $tag;
            return 0;
        }
        my ($entry) = $changes->data;
        my $timestamp = $entry ? $entry->Timestamp : 0;
        for my $standard (@standards) {
            last if $standard->[0] eq $stdver;
            if (str2time($standard->[1], '+0000') < $timestamp) {
                tag 'out-of-date-standards-version', $tag;
                last;
            }
        }
    }
}

}

1;

# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 sts=4 ts=4 et shiftround