<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># Copyright (C) 2011, Stefano Rivera &lt;stefanor@debian.org&gt;
#
# Permission to use, copy, modify, and/or distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

package Debian::DistroInfo;

=head1 NAME

Debian::DistroInfo - provides information about Ubuntu's and Debian's distributions

=cut

use strict;
use warnings;

use Exporter;
our @EXPORT_OK = qw(convert_date);

our $VERSION = '0.2.2';

my $outdated_error = "Distribution data outdated. "
    . "Please check for an update for distro-info-data. "
    . "See /usr/share/doc/distro-info-data/README.Debian for details.";

sub convert_date {
    my ($date) = @_;
    my @parts = split(/-/, $date);
    if (scalar(@parts) == 2) {
        $date .= '-01';
    }
    $date = Time::Piece-&gt;strptime($date, "%Y-%m-%d");
    if (scalar(@parts) == 2) {
        $date-&gt;add_months(1);
        $date -= Time::Piece-&gt;ONE_DAY;
    }
    return $date;
}


{
    package DistroInfo;

    use Time::Piece;

    sub _get_data_dir {
        return '/usr/share/distro-info';
    }

    sub new {
        my ($class, $distro) = @_;
        my @rows;
        my $self = {'distro' =&gt; $distro,
                    'rows' =&gt; \@rows,
                    'date' =&gt; Time::Piece-&gt;new(),
                   };
        open(my $fh, '&lt;', $class-&gt;_get_data_dir . "/$distro.csv")
          or die "Unable to open ${distro}'s data file.";

        my $line = &lt;$fh&gt;;
        chomp($line);
        my @header = split(/,/, $line);

        while (&lt;$fh&gt;) {
            chomp;
            my @raw_row = split (/,/);
            my %row;
            for my $col (@header) {
                $row{$col} = shift(@raw_row) or undef;
            }
            for my $col ('created', 'release', 'eol', 'eol-server', 'eol-esm') {
                if(defined($row{$col})) {
                    $row{$col} = Debian::DistroInfo::convert_date($row{$col});
                }
            }
            push(@rows, \%row);
        }
        close($fh);

        bless($self, $class);
        return $self;
    }

    sub all {
        my ($self) = @_;
        my @all;
        my @rows = @{$self-&gt;{'rows'}};
        for my $row (@rows) {
            push(@all, $row-&gt;{'series'})
        }
        return @all;
    }

    sub _avail {
        my ($self, $date) = @_;
        my @avail;
        for my $row (@{$self-&gt;{'rows'}}) {
            push(@avail, $row) if $date &gt; $row-&gt;{'created'}
        }
        return @avail;
    }

    sub codename {
        my ($self, $release, $date, $default) = @_;
        return $release;
    }

    sub devel {
        my ($self, $date) = @_;
        $date = $self-&gt;{'date'} if (!defined($date));
        my @distros;
        for my $row ($self-&gt;_avail($date)) {
            if (!defined($row-&gt;{'release'})
                  || ($date &lt; $row-&gt;{'release'}
                      &amp;&amp; (!defined($row-&gt;{'release'})
                          || $date &lt;= $row-&gt;{'eol'}))) {
                push(@distros, $row);
            }
        }
        if (scalar(@distros) == 0) {
            warn $outdated_error;
            return 0;
        }
        return $distros[-1]{'series'};
    }

    sub stable {
        my ($self, $date) = @_;
        $date = $self-&gt;{'date'} if (!defined($date));
        my @distros;
        for my $row ($self-&gt;_avail($date)) {
            if (defined($row-&gt;{'release'}) &amp;&amp; $date &gt;= $row-&gt;{'release'}
                  &amp;&amp; (!defined($row-&gt;{'eol'}) || $date &lt;= $row-&gt;{'eol'})) {
                push(@distros, $row);
            }
        }
        if (scalar(@distros) == 0) {
            warn $outdated_error;
            return 0;
        }
        return $distros[-1]{'series'};
    }

    sub supported {
        die "Not implemented";
    }

    sub valid {
        my ($self, $codename) = @_;
        return !! grep {$_ eq $codename} $self-&gt;all;
    }

    sub unsupported {
        my ($self, $date) = @_;
        $date = $self-&gt;{'date'} if (!defined($date));
        my @supported = $self-&gt;supported($date);
        my @unsupported = ();
        for my $row ($self-&gt;_avail($date)) {
            push(@unsupported, $row-&gt;{'series'}) if ! grep {$_ eq $row-&gt;{'series'}} @supported;
        }
        return @unsupported;
    }
}

{
    package DebianDistroInfo;
    use parent -norequire, 'DistroInfo';

    sub new {
        my ($class) = @_;
        my $self = $class-&gt;SUPER::new('debian');
        bless($self, $class);
        return $self;
    }

    sub codename {
        my ($self, $release, $date, $default) = @_;
        $date = $self-&gt;{'date'} if (!defined($date));
        return $self-&gt;devel($date) if ($release eq 'unstable');
        return $self-&gt;testing($date) if ($release eq 'testing');
        return $self-&gt;stable($date) if ($release eq 'stable');
        return $self-&gt;old($date) if ($release eq 'oldstable');
        return $default;
    }

    sub devel {
        my ($self, $date) = @_;
        $date = $self-&gt;{'date'} if (!defined($date));
        my @distros;
        for my $row ($self-&gt;_avail($date)) {
            if (!defined($row-&gt;{'release'})
                  || ($date &lt; $row-&gt;{'release'}
                      &amp;&amp; !defined($row-&gt;{'eol'}) || $date &lt;= $row-&gt;{'eol'})) {
                push(@distros, $row);
            }
        }
        if (scalar(@distros) &lt; 2) {
            warn $outdated_error;
            return 0;
        }
        return $distros[-2]{'series'};
    }

    sub old {
        my ($self, $date) = @_;
        $date = $self-&gt;{'date'} if (!defined($date));
        my @distros;
        for my $row ($self-&gt;_avail($date)) {
            if (defined($row-&gt;{'release'}) &amp;&amp; $date &gt;= $row-&gt;{'release'}) {
                push(@distros, $row);
            }
        }
        if (scalar(@distros) &lt; 2) {
            warn $outdated_error;
            return 0;
        }
        return $distros[-2]{'series'};
    }

    sub supported {
        my ($self, $date) = @_;
        $date = $self-&gt;{'date'} if (!defined($date));
        my @distros;
        for my $row ($self-&gt;_avail($date)) {
            if (!defined($row-&gt;{'eol'}) || $date &lt;= $row-&gt;{'eol'}) {
                push(@distros, $row-&gt;{'series'});
            }
        }
        return @distros;
    }

    sub testing {
        my ($self, $date) = @_;
        $date = $self-&gt;{'date'} if (!defined($date));
        my @distros;
        for my $row ($self-&gt;_avail($date)) {
            if ((!defined($row-&gt;{'release'}) &amp;&amp; $row-&gt;{'version'})
                  || (defined($row-&gt;{'release'}) &amp;&amp; $date &lt; $row-&gt;{'release'}
                      &amp;&amp; (!defined($row-&gt;{'eol'}) || $date &lt;= $row-&gt;{'eol'}))) {
                push(@distros, $row);
            }
        }
        if (scalar(@distros) == 0) {
            warn $outdated_error;
            return 0;
        }
        return $distros[-1]{'series'};
    }

    sub valid {
        my ($self, $codename) = @_;
        my %codenames = (
            'unstable' =&gt; 1,
            'testing' =&gt; 1,
            'stable' =&gt; 1,
            'oldstable' =&gt; 1,
        );
        return $self-&gt;SUPER::valid($codename) || exists($codenames{$codename});
    }
}

{
    package UbuntuDistroInfo;
    use parent -norequire, 'DistroInfo';

    sub new {
        my ($class) = @_;
        my $self = $class-&gt;SUPER::new('ubuntu');
        bless($self, $class);
        return $self;
    }

    sub lts {
        my ($self, $date) = @_;
        $date = $self-&gt;{'date'} if (!defined($date));
        my @distros;
        for my $row ($self-&gt;_avail($date)) {
            if ($row-&gt;{'version'} =~ m/LTS/ &amp;&amp; $date &gt;= $row-&gt;{'release'}
                  &amp;&amp; $date &lt;= $row-&gt;{'eol'}) {
                push(@distros, $row);
            }
        }
        if (scalar(@distros) == 0) {
            warn $outdated_error;
            return 0;
        }
        return $distros[-1]{'series'};
    }

    sub is_lts {
        my ($self, $codename) = @_;
        for my $row (@{$self-&gt;{'rows'}}) {
            if ($row-&gt;{'series'} eq $codename) {
                return ($row-&gt;{'version'} =~ m/LTS/);
            }
        }
        return 0;
    }

    sub supported {
        my ($self, $date) = @_;
        $date = $self-&gt;{'date'} if (!defined($date));
        my @distros;
        for my $row ($self-&gt;_avail($date)) {
            if ($date &lt;= $row-&gt;{'eol'}
                  || (defined($row-&gt;{'eol-server'}) &amp;&amp; $date &lt;= $row-&gt;{'eol-server'})) {
                push(@distros, $row-&gt;{'series'});
            }
        }
        return @distros;
    }

    sub supported_esm {
        my ($self, $date) = @_;
        $date = $self-&gt;{'date'} if (!defined($date));
        my @distros;
        for my $row ($self-&gt;_avail($date)) {
            if (defined($row-&gt;{'eol-esm'}) &amp;&amp; $date &lt;= $row-&gt;{'eol-esm'}) {
                push(@distros, $row-&gt;{'series'});
            }
        }
        return @distros;
    }
}
1;
# vi: set et sta sw=4 ts=4:
</pre></body></html>