#!/usr/bin/env perl

# Last modified: 10 Oct 2006 at 12:02 PM EDT
# Author: Soren Andersen <intrepid -AT- perlmonk *dot* org>
# $Id$

use strict;
use warnings;
use YAML qw/ Load Dump LoadFile /;
use LWP::Simple;
use POSIX qw(isatty);
sub coremod { "" };
sub hr;
sub dimmer;
sub find_longest_keystring;
sub mtest;

sub testyml {
    my $metayml_uri =
      (shift(@_) || 'http://search.cpan.org/src/RUBYKAT/html2dbk-0.03/
+META.yml');
    my $docu;

    if( $docu = get $metayml_uri ) {
    return $docu
    }
    die "Could not retrieve '$metayml_uri'. Network troubles? Bad URI?
+";
}

## And now a brief interlude of presentational trivia, not very intere
+sting
my $screenW = $ENV{COLUMNS} || 42;
my $unxterm = isatty(*STDOUT) && $^O !~/MSWin32/ ? 1 : 0;
if ($unxterm) {
    require Term::ANSIColor and import Term::ANSIColor ('colored');
   #print colored("Using Term::ANSIColor", 'dark white'), "\n";
} ## done with interlude, back to main show

my $metadoc = testyml (shift(@ARGV) || undef);
my $modmeta = Load( $metadoc );

if( $modmeta->{requires} ) {
    my ($k,$v);
    my $fmtlen;
    my %reqrs = %{
                   my($mkl,@hash)
                    = find_longest_keystring($modmeta->{requires});
                   $fmtlen = $mkl || 28;
                   my $rh = {@hash};
                 };
    if (eval "use Module::CoreList; 1" and not $@)
    {
        no warnings ('redefine','once');
        sub coremod
        {
            my($pm) = @_;
            my $presence_in_core = $Module::CoreList::version{$]}{$pm}
+;
            return "\n" unless defined $presence_in_core;
            my $pmv;
            $pmv = $presence_in_core == 0 ? "without a VERSION number"
               : "version $presence_in_core";
            my $prn  = Module::CoreList->first_release($pm);
            my $note = <<"        ELEPHANT";

  CORE: $pm was first included in the core Perl distribution at Perl r
+elease $prn
        The present Perl system shipped with $pm $pmv
        ELEPHANT
            return $note;
        }
    }

    print hr;
    printf <<"        YODOWN"
 %-${fmtlen}s %s
   %s%s
        YODOWN
 => ($k,($v eq '0'? 'any version':"at version $v") , mtest($k), coremo
+d($k))
           while ($k,$v) = each %reqrs;
    print hr;
} else # there are no prerequisite modules or pragmata listed
    {  print "No requires for $modmeta->{name}\n"; }

sub mtest
{
    my $installed_version;
    my $wherep;
    my $modname = shift();
    my $modlibp = $modname;
    $modlibp =~ s{ :: } {/}xg;
    $modlibp .= '.pm';
    my $can_req = eval "use $modname; 1;";
  if   ($can_req and not $@)
    {
        no strict 'refs';
        $wherep = $INC{ $modlibp };
        $installed_version = (${$modname.'::VERSION'}) || 0;
    }
  else
    {
        return colored(sprintf(
            "%-32s is not installed"=> $modname) , 'cyan')
           if ($unxterm);
        return sprintf(
            "%-32s is not installed"=> $modname)
    }
    
    if ($unxterm) {
    colored(
        sprintf('%-32s v%4s found as %s'
         => ($modname , $installed_version , $wherep))
      , 'magenta' );
    } else {
        sprintf('%-32s v%-4s found as %s'
         => ($modname , $installed_version , $wherep))
    }
}

sub find_longest_keystring
{
    my %rethash = %{ shift() };
    return () unless 1 * @{[ %rethash ]};
    delete $rethash{'perl'};
    my $l_maxed_at = 0;
    for (keys(%rethash)) {
    $l_maxed_at = length() > $l_maxed_at ? length() : $l_maxed_at
    }
    return ( $l_maxed_at, %rethash );
}

sub hr
{
    my $decor = $unxterm
      ? dimmer("-" x $screenW)
      :       ("-" x $screenW);
    $decor . "\n";
}

sub dimmer
{
    colored( shift() , 'dark white' );
}
__END__

=head1 NAME

METAreqWeb

=head1 SYNOPSIS

  ./METAreqWeb [ <http://search.cpan.org/src/MOCONNOR/YAML-AppConfig-0
+.16/META.yml> ]

=cut