#!/usr/bin/perl

# COPYRIGHT
#   Copyright (C) 2007 Markus Laire <malaire@gmail.com>
#   Modified by the gNewSense Community <http://www.gnewsense.org>
# LICENSE
#   This program is free software; you may
#   redistribute it and/or modify it under
#   the same terms as Perl itself.
# REQUIREMENTS
#   libwww-perl    - Provides LWP::Simple
# USAGE (command-line)
#   perl KPFV_info.pl s                 -- show source-code
#   perl KPFV_info.pl k                 -- show info for Kernel
#   perl KPFV_info.pl m                 -- show info for PackagesInMain
#   perl KPFV_info.pl u                 -- show info for PackagesInUniverse
# USAGE (web)
#   http://domain/path/KPFV_info.pl?s   -- show source-code
#   http://domain/path/KPFV_info.pl?k   -- show info for Kernel
#   http://domain/path/KPFV_info.pl?m   -- show info for PackagesInMain
#   http://domain/path/KPFV_info.pl?u   -- show info for PackagesInUniverse
# CHANGELOG
#   2008-03-12
#   - Add Support for Kernel
#   2007-10-25
#   - Add support for PackagesInUniverse
#   2007-10-27
#   - New wording for $URGENT_MESSAGE

use strict;
use warnings FATAL => 'all';

use LWP::Simple qw(get);
use Time::Local qw(timegm);

# ========== CONSTANTS ==========

# If section-summary is older than $STALLED_THRESHOLD days,
# section is considered "stalled".
my $STALLED_THRESHOLD = 28;

# If section-summary is older than $URGENT_THRESHOLD days,
# section is in need of urgent assistance.
my $URGENT_THRESHOLD = 56;
my $URGENT_MESSAGE   = " Stalled. URGENT assistance required, or adoption";

my @MONTHS = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my %MONTHS = map { $MONTHS[$_] => $_ } 0..$#MONTHS;

# ========== error-function ==========

sub error($) {
    print "ERROR: @_\n";
    exit;
}

# ========== Get Parameter ==========

my $param;
if (exists $ENV{QUERY_STRING}) {
    print "Content-Type: text/plain\r\n\r\n";
    $param = $ENV{QUERY_STRING};
} else {
    $param = $#ARGV >= 0 ? $ARGV[0] : '';
}

my $rep; # Repository - "Main" or "Universe"

my $URL;
my $TABLE_HEADING;


if ($param eq 'k') {
    $rep = "Kernel";
    $URL = "http://wiki.gnewsense.org/Kernel/Image?action=source";
    $TABLE_HEADING = "Driver sections in " . uc $rep;
} elsif ($param eq 'm') {
    $rep = "Main";
    $URL = "http://wiki.gnewsense.org/Main/PackagesIn$rep?action=source";
    $TABLE_HEADING = "Package sections in " . uc $rep;
} elsif ($param eq 'u') {
    $rep = "Universe";
    $URL = "http://wiki.gnewsense.org/Main/PackagesIn$rep?action=source";
    $TABLE_HEADING = "Package sections in " . uc $rep;
} elsif ($param eq 's') {
    # ===== VIEW SOURCE =====
    open SELF, '<', $0;
    print <SELF>;
    close SELF;
    exit;
} elsif ($param eq '') {
    error "Missing parameter";
} else {
    error "Invalid parameter: '$param'";
}

# ========== Get input ==========

my $input = get($URL);
error "Failed to retrieve $URL" unless defined $input;

# ========== Parse the table ==========
my @table;

# Find a table following heading $TABLE_HEADING
$input =~ m#!!$TABLE_HEADING\s*((?:\n\|\|.+)+)#i
    or error "Can't find the table. Format seems to have changed";
my $table = $1;
# Remove initial newline
$table =~ s#\n##;

# Process lines
for (split /\n/, $table) {
    # Skip table-attribute-lines
    next unless m#\|\|$#;
    # Skip table-header-line
    next if m#^\|\|!#;

    # Get columns
    s#^\|\|##;
    s#\|\|$##;
    push @table, [ split m#\s*\|\|\s*# ];
}

# ========== Check table data ==========

for my $n (0..$#table) {
    my @row = @{$table[$n]};
    # Information for error-messages
    my $err = "at row " . ($n+1) . ":\n" . join("\n", @row);

    if (@row != 8) {
        error "Wrong number of columns $err";
    }

    # Column 0: Section                     - Not checked
    # Column 1: Owner                       - Not checked
    # Column 2: Date adopted                - Not checked
    # Column 3: Package number              - Not checked
    # Column 4: % completed                 - '?' or '\d\d?%'
    # Column 5: % certified free            - '?' or '\d\d?%'
    # Column 6: suspected non-free reported - Not checked
    # Column 7: Date of summary (DD MMM YY) - '?' or 'DD MMM YY'
    if ($row[4] !~ m#^(\?|\d+\.?\d*%)$#) {
	error "Invalid value for '% completed' column $err";
    }
    if ($row[5] !~ m#^(\?|\d+\.?\d*%)$#) {
	error "Invalid value for '% certified free' column $err";
    }
    if ($row[7] =~ m#^\?$#){
   next;
    } elsif ($row[7] !~ m#^(\d\d) (\w\w\w) (\d\d)$#) {
	error "Invalid value for 'Date of summary' column $err";
    } elsif (not exists $MONTHS{$2}) {
	error "Invalid month for 'Date of summary' column $err";
    }
}

# ========== Fill @all table ==========

my @all;
for my $row (@table) {
    # Calculate age-in-days
    my $age_in_days = 0;
    if($$row[7] !~ /^\?$/) { # If the column 'Date of summary' doesn't contain '?' then calculate $age_in_days
      $$row[7] =~ /^(\d\d) (\w\w\w) (\d\d)$/ or error "Impossible error (A)";
      my $time    = timegm(0,0,0,$1,$MONTHS{$2}, 2000 + $3);
      my $curtime = timegm(0,0,0,(gmtime)[3..5]);
      $age_in_days = ($curtime - $time) / 86400;
    }

    push @all, {
        section      => $$row[0],
        owner        => $$row[1],
        completed    => $$row[4],
        free         => $$row[5],
        summary_date => $$row[7],
        age_in_days  => $age_in_days
    };
}

# ========== Categorize sections ==========

my @notadopted;
my @completed_free;
my @completed_notfree_ongoing;
my @completed_notfree_stalled;
my @notcompleted_ongoing;
my @notcompleted_stalled;

for my $section (@all) {
    my %s = %$section;

    my $isstalled   = $s{age_in_days} > $STALLED_THRESHOLD;
    my $iscompleted = $s{completed} eq '100%';
    my $isfree      = $s{free}      eq '100%';

    if ($s{owner} =~ /NEEDS ADOPTING|PRIORITY ADOPTION/) {
        push @notadopted, $section;
        next;
    }

    if ($iscompleted && $isfree) {
        push @completed_free, $section;
        next;
    }

    if ($iscompleted && ! $isfree && ! $isstalled) {
        push @completed_notfree_ongoing, $section;
        next;
    }

    if ($iscompleted && ! $isfree && $isstalled) {
        push @completed_notfree_stalled, $section;
        next;
    }

    if (! $iscompleted && ! $isstalled) {
        push @notcompleted_ongoing, $section;
	next;
    }

    if (! $iscompleted && $isstalled) {
        push @notcompleted_stalled, $section;
	next;
    }

    error "Impossible error (B)";
}

# ========== Sort "stalled" sections ==========

@completed_notfree_stalled =
    sort { $$b{age_in_days} <=> $$a{age_in_days} } @completed_notfree_stalled;

@notcompleted_stalled =
    sort { $$b{age_in_days} <=> $$a{age_in_days} } @notcompleted_stalled;

# ========== Create output ==========

my ($mday,$mon,$year) = (gmtime)[3..5];
if ($param eq 'k') {
printf "!!Kernel Section Summary (%d %s %d)\n",
    $mday, $MONTHS[$mon], 1900 + $year;
} else {
printf "!!Package Section Summary (%d %s %d)\n",
    $mday, $MONTHS[$mon], 1900 + $year;
}

print  "||border=1 width=50%\n";
printf "||Completed, Free||%d||\n", int @completed_free;
printf "||Completed, NOT Free, age <= %d days||%d||\n",
    $STALLED_THRESHOLD, int @completed_notfree_ongoing;
printf "||Completed, NOT Free, age > %d days||%d||\n",
    $STALLED_THRESHOLD, int @completed_notfree_stalled;
printf "||NOT Completed, age <= %d days||%d||\n",
    $STALLED_THRESHOLD, int @notcompleted_ongoing;
printf "||NOT Completed, age > %d days||%d||\n",
    $STALLED_THRESHOLD, int @notcompleted_stalled;
printf "||NOT adopted||%d||\n", int @notadopted;
printf "||Total||%d||\n", int @all;

print "!!Completed, NOT Free, age > $STALLED_THRESHOLD days\n";
print "||border=1 width=100%\n";
print "||!Section||!Owner||!Date of summary (DD MMM YY)||!Age of summary||\n";
for (@completed_notfree_stalled) {
    my ($section, $owner, $date, $age) =
        @$_{qw(section owner summary_date age_in_days)};
    $owner .= $URGENT_MESSAGE if $age > $URGENT_THRESHOLD;
    print "||$section||$owner||$date||$age days||\n";
}

print "!!NOT Completed, age > $STALLED_THRESHOLD days\n";
print "||!Section||!Owner||!Date of summary (DD MMM YY)||!Age of summary||\n";
for (@notcompleted_stalled) {
    my ($section, $owner, $date, $age) =
        @$_{qw(section owner summary_date age_in_days)};
    $owner .= $URGENT_MESSAGE if $age > $URGENT_THRESHOLD;
    print "||$section||$owner||$date||$age days||\n";
}

#print "!!NOT adopted\n";
#print "$$_{section}\n" for @notadopted;