#!/pro/bin/perl

use 5.20.0;
use warnings;

use Data::Peek;
use LWP;
use JSON::XS;
use LWP::UserAgent;
use HTML::TreeBuilder;
use Encode qw( encode decode );
use Date::Calc qw( Parse_Date Date_to_Time );

use MetaCPAN::Client;
use CPAN::Testers::WWW::Reports::Query::AJAX;

my %mod = (
    "App::SpeedTest"		=> {
	git	=> "https://github.com/Tux/speedtest",
	tci	=> "",
	},
    "App::tkiv"			=> {
	tci	=> "",
	},
    "Config::Perl::V"		=> { },
    "Data::Peek"		=> { },
    "DBD::CSV"			=> {
	git	=> "https://github.com/perl5-dbi/DBD-CSV",
	},
    "DBD::Unify"		=> {
	git	=> "https://github.com/perl5-dbi/DBD-Unify",
	tci	=> "",
	},
    "GSM::Gnokii"		=> {
	tci	=> "",
	},
    "Spreadsheet::Read"		=> { },
    "Test::Smoke"		=> {
	git	=> "https://github.com/abeltje/Test-Smoke",
	tci	=> "",
	},
    "Test::Smoke::Metabase"	=> {
	skip	=> 1,
	git	=> "http://repo.or.cz/w/Test-Smoke-Metabase.git",
	},
    "Text::CSV"			=> {
	note	=> "perl6",
	git	=> "https://github.com/Tux/CSV",
	cpan	=> "http://modules.perl6.org",
	doc	=> "https://github.com/Tux/CSV/blob/master/Text-CSV.pod",
	cpants	=> "",
	tci	=> "https://travis-ci.org/Tux/CSV/builds",
	rt	=> "https://github.com/Tux/CSV/issues",
	data	=> {
	    version	=> "*",
	    kwalitee	=> "",
	    rt		=> "",
	    rd		=> "",
	    tests	=> [],
	    },
	},
    "Text::CSV_XS"		=> { },
    "Text::OutputFilter"	=> { },
    "Tie::Hash::DBD"		=> { },
    "Tk::Clock"			=> {
	tci	=> "",
	},
    "VCS::SCCS"			=> { },
    );

binmode STDOUT, ":encoding(utf-8)";

header ();
modules ();
footer ();

sub href
{
    my ($txt, $ref) = @_;
    $ref ? qq{<a href="$ref">$txt</a>} : @_ == 1 ? $txt : "-";
    } # href

sub dta
{
    my ($tag, %attr, @arg) = ("td");
    for (@_) {
	if (ref $_ eq "ARRAY") {
	    local $" = " ";
	    $tag .= qq{ class="@$_"};
	    next;
	    }
	push @arg, $_;
	}
    my $info = @arg > 2 ? join " ", "", splice @arg, 2 : "";
    my $link = href (@arg);
    if ($tag =~ m{class=".*\b(pass|na|warn|fail)"}) {
	my $c = $1;
	$link =~ s{<a \K}{class="$c" };
	}
    say "            <$tag>$link$info</td>";
    } # dta

sub modules
{
    print <<"EOH";

  <tr class="boxed">
    <td class="boxed" colspan="2">
      <p class="header">My modules</p>
      <table>
        <thead>
          <tr>
            <th><a href="http://metacpan.org/author/HMBRAND">Distribution</a></th>
            <th>version</th>
            <th class="released">released</th>
            <th class="git"><a href="https://github.com/Tux">repo</a></th>
            <th>doc</th>
            <th class="cpants"><a href="http://cpants.perl.org/author/HMBRAND">kwalitee</a></th>
            <th class="tci"><a href="https://travis-ci.org/profile/Tux">Tci</a></th>
            <th class="rt"><a href="http://rt.cpan.org/Public/Dist/ByMaintainer.html?Name=HMBRAND">RT</a></th>
            <th colspan="3" class="center"><a href="http://www.cpantesters.org/author/H/HMBRAND.html">cpantesters</a></th>
            <th class="rd"><a href="http://deps.cpantesters.org">&#x219d;</a></th>
            </tr>
          </thead>
        <tbody>
EOH

    my $ua = LWP::UserAgent->new;
    $ua->agent ("Opera/30");

    my $mcpan = MetaCPAN::Client->new ();

    foreach my $mod (sort keys %mod) {
	my $m    = $mod{$mod}; $m->{skip} and next;
	my $dist = $mod =~ s/::/-/gr;
	my $data = $m->{data} || eval { $mcpan->module ($mod)->{data} } || {};

	unless (defined $data->{kwalitee}) {
	    ($_ = $ua->get ("http://cpants.cpanauthors.org/dist/$dist")) &&
	     $_->is_success && $_->content =~ m{
		<dt> [\s\r\n]*  Kwalitee          [\s\r\n]* </dt> [\s\r\n]*
		<dd> [\s\r\n]* ([0-9.]+)          [\s\r\n]* </dd> [\s\r\n]*
		<dt> [\s\r\n]*  Core \s* Kwalitee [\s\r\n]* </dt> [\s\r\n]*
		<dd> [\s\r\n]* ([0-9.]+)          [\s\r\n]* </dd>
		}xi and ($data->{kwk}, $data->{kwc}) = ($1, $2);
	     $data->{kwalitee} = join " / " =>
		 $data->{kwc} // "-", $data->{kwk} // "&nbsp;&nbsp;&nbsp;-&nbsp;&nbsp;";
	     }
	!defined $data->{tests} and
	    $data->{tests} =
	      ($_ = CPAN::Testers::WWW::Reports::Query::AJAX->new (dist => $dist))
		? [ $_->pass, $_->na, $_->fail, $_->unknown ]
		: [ "", "", "", "" ];
	unless (defined $data->{rt}) {
	    $data->{rt} = 
		(($_ = $ua->get ("https://api.metacpan.org/distribution/$dist")) &&
		  $_->is_success && decode_json ($_->content)->{bugs}{active}) || "*";
	    }
	my $rd = $data->{rd} // do {
	    $_ = $ua->get ("http://deps.cpantesters.org/depended-on-by.pl?module=$mod");
	    my $tree = HTML::TreeBuilder->new;
	    $tree->parse_content ($_ && $_->is_success ? $_->content : "");
	    my $x = 0;
	    $x++ for $tree->look_down (_tag => "li");
	    $x || "-";
	    };

	my $git = $m->{git} // "https://github.com/Tux/$dist";
	my $git_clss = [ "git" ];
	if ($git =~ m/\b github.com \b/x) {
	    $_ = $ua->get ("$git/commits/master");
	    my $tree = HTML::TreeBuilder->new;
	    $tree->parse_content ($_ && $_->is_success ? decode ("utf-8", $_->content) : "");
	    # Get most recent commit date
	    for ($tree->look_down (_tag => "div", class => "commit-group-title")) {
		# Commits on Apr 24, 2015
		my ($y, $m, $d) = Parse_Date ($_->as_text =~ s/^\s*Commits\s+on\s*//r) or next;
		my $t = Date_to_Time ($y, $m, $d, 0, 0, 0) or next;
		my $span = time - $t;
		push @$git_clss,
		    $span <=   604800 ? "pass" :	# green,  <= 1 week
		    $span <=  2592000 ? "na"   :	# yellow, <= 30 days
		    $span <= 15724800 ? "warn" :	# orange, <= 6 months
					"fail" ;	# red
		last;
		}
	    }

	my $rel_date = ($data->{date} // " ") =~ s/T.*//r;
	my $rel_clss = [ "date" ];
	if (my ($y, $m, $d) = ($rel_date =~ m/^(\d+)-(\d+)-(\d+)\b/)) {
	    my $t = Date_to_Time ($y, $m, $d, 0, 0, 0) or next;
	    my $span = time - $t;
	    push @$rel_clss,
		$span <=  2592000 ? "pass" :	# green,  <= 30 days
		$span <= 15724800 ? "na"   :	# yellow, <= 6 months
		$span <= 31536000 ? "warn" :	# orange, <= 1 year
				    "fail" ;	# red
	    }

	my $tci = $m->{tci} // "https://travis-ci.org/Tux/$dist/builds";
	my $tci_tag = "Tci";
	$tci =~ m/travis-ci/ and $_ = $ua->get ($tci =~ s{/builds$}{.svg}r) and $_->is_success and
	    $tci_tag = $_->content;

	say qq{          <tr>};
	# Maybe add the $data->{abstract} to the alt for balloon
	dta (                $mod,                    $m->{cpan}   // "http://metacpan.org/release/$dist");
	dta ([ "version"  ], $data->{version} // "*");
	dta ($rel_clss,      $rel_date);
	dta ($git_clss,      "git",                   $git);
	dta (                "doc",                   $m->{doc}    // "http://metacpan.org/module/$mod");
	dta ([ "kwalitee" ], $data->{kwalitee},       $m->{cpants} // "http://cpants.perl.org/dist/overview/$dist");
	dta ([ "tci"      ], $tci_tag,                $tci);
	dta ([ "rt"       ], $data->{rt},             $m->{rt}     // "http://rt.cpan.org/NoAuth/Bugs.html?Dist=$dist");
	dta ([ "pass"     ], $data->{tests}[0] // "", $m->{ct}     // "http://www.cpantesters.org/show/$dist.html");
	dta ([ "na"       ], $data->{tests}[1] // "");
	dta ([ "fail"     ], $data->{tests}[2] // "", $m->{ctm}    // "http://matrix.cpantesters.org/?dist=$dist");
	dta ([ "rd"       ], $rd,                     $m->{rd}     // "http://deps.cpantesters.org/depended-on-by.pl?module=$mod");
	say qq{            </tr>};
	}

    print <<"EOH";

          <tr><td colspan="14"><hr /></td></tr>
          <tr>
            <td><a href="http://backpan.perl.org/authors/id/H/HM/HMBRAND/">BackPAN</a></td>
            <td colspan="7"><a href="http://analysis.cpantesters.org/?author=HMBRAND&amp;age=91.3&amp;SUBMIT_xxx=Submit">CPANTESTERS analysis</a></td>
            <td colspan="3" class="center"><a href="http://matrix.cpantesters.org/?author=HMBRAND">matrix</a></td>
            </tr>
          </tbody>
        </table>
      </td>
    </tr>
EOH
    } # modules

sub header
{
    print <<"EOH";
<?xml version="1.0" encoding="utf-8"?>  
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">       
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
  <title>Tux.nl - Perl</title>
  <meta name="Generator"     content="make-www.pl" />
  <meta name="Author"        content="H.Merijn Brand" />
  <meta name="Description"   content="Perl" />

  <link rel="SHORTCUT ICON"  href="images/tux.ico" />

  <link rel="stylesheet" type="text/css"  href="tux.css" />
  </head>
<body>

<table>
EOH
    } # header

sub footer
{
    my @d = localtime;
    my $stamp = sprintf "%02d-%02d-%04d", $d[3], $d[4] + 1, $d[5] + 1900;
    print <<"EOH";

  <tr class="boxed">
    <td class="boxed" rowspan="2">
      <p class="header">My talks</p>
      <ul>
        <li><a href="Talks/Spreadsheet-Read/intro.html">Spreadsheet::Read</a></li>
        <li><a href="Talks/japhu/">Upside down JAPH</a></li>
        <li><a href="Talks/DBDc">DBD</a></li>
        <li>Perl5 Porter</li>
        <li>Test::Smoke</li>
        <li><a href="Talks/fs/">Traffic info</a></li>
        <li><a href="Talks/CSV/">Parsing CSV with Text::CSV_XS</a></li>
        <li><a href="Talks/CSVu/">CSV less complicated</a></li>
        <li><a href="Talks/Kwalitee/">How to improve on your modules</a></li>
        <li><a href="Talks/Data-Peek/">What does your data look like</a></li>
        <li><a href="Talks/GSM-Gnokii/">Gnokii - an alternative approach</a></li>
        <li><a href="Talks/Statement-Modifiers/">Statement modifiers can suck</a></li>
        <li><a href="Talks/Tie-Hash-DBD/">Tie hashes to databases</a></li>
        <li><a href="Talks/Unicode-Encoding/">Unicode and Encoding</a></li>
        </ul>
      <p style="font-size: 75%">My talks are best viewed with
        <a href="http://www.opera.com">
          <img src="images/opera.png"   width="16" height="16" alt="Opera"   /></a> or
        <a href="http://www.mozilla.com/en-US/firefox/">
          <img src="images/firefox.png" width="20" height="16" alt="FireFox" /></a> +
        <a href="http://addons.mozilla.org/en-US/firefox/addon/space-next/">
          <img src="images/spcnxt.png"  width="20" height="16" alt="Space Next" /></a></p>
      </td>

    <td class="boxed">
      <p class="header">Perl resources:</p>

      <table>
        <tr>
	  <td><a href="http://amsterdam.pm.org/">Amsterdam Perl Mongers</a></td>
	  <td><a href="http://www.perl.org">perl.org</a></td>
	  </tr>
        <tr>
	  <td><a href="http://metacpan.org">CPAN</a></td>
	  <td><a href="http://backpan.perl.org">BackPAN</a></td>
	  </tr>
        <tr>
	  <td><a href="http://www.perlmonks.org">Perl Monks</a></td>
	  <td><a href="http://use.perl.org">use perl;</a></td>
	  </tr>
        <tr>
	  <td><a href="http://www.cpantesters.org">cpantesters</a></td>
	  <td><a href="http://matrix.cpantesters.org">matrix</a></td>
	  </tr>
        <tr>
	  <td><a href="http://blogs.perl.org">perl blogs</a></td>
	  <td><a href="http://p3rl.org">p3rl</a></td>
	  </tr>
        <tr>
	  <td><a href="http://doc.perl6.org">perl6 documentation</a></td>
	  <td><a href="http://modules.perl6.org">perl6 modules</a></td>
	  </tr>
        <tr>
	  <td><a href="http://www.perl.org/docs.html">perl5 documentation</a></td>
	  <td><a href="http://www.perl.org/learn.html">learning perl</a></td>
	  </tr>
	</table>
      </td>
    </tr>

  <tr class="boxed">
    <td class="boxed">
      <p class="header">My applications</p>
      <table>
        <tr>
          <td class="apps">
            <a href="https://github.com/Tux/App-tkiv">iv</a></td>
          <td>An image viewer written in
            <a href="http://metacpan.org/release/Tk">Perl-Tk</a> based on
            <a href="http://www.irfanview.com/">IrfanView</a>. It has been
            released to CPAN as
            <a href="http://metacpan.org/release/App-tkiv">App::tkiv</a>.
            </td>
          </tr>
        <tr>
          <td class="apps">
            <a href="https://github.com/Tux/speedtest">speedtest</a></td>
          <td>A command-line interface to the
            <a href="http://www.speedtest.net/">speedtest.net</a>
            infrastructure so that flash is not required.<br />
            It has been released to CPAN as
            <a href="http://metacpan.org/release/App-SpeedTest">App::SpeedTest</a>.
            </td>
          </tr>
        <tr>
          <td class="apps">
            <a href="Files/kruler.pl">kruler</a></td>
          <td>A rewrite of KDE's kruler in
            <a href="http://metacpan.org/release/Tk">Perl-Tk</a>.
            This version can reverse the scale (left-to-right or down-up)
            and change the scale (cm, inch).
            </td>
          </tr>
        </table>
      </td>
    </tr>
  </table>

<table>
  <colgroup>
    <col width="33%" />
    <col width="33%" />
    </colgroup>
  <tr>
    <td class="footer">&nbsp;</td>
    <td class="footer" style="text-align:center">
      last update: $stamp
      </td>
    <td></td>
    </tr>
  </table>
</body>
</html>
EOH
    } # footer
