#!perl

use strict;
use warnings;

use autodie;
use version;

use Archive::Extract;
use Cwd;
use File::Fetch;
use File::Spec;
use File::Temp 0.19;
use Getopt::Std;
use List::Util;
use Parse::CPAN::Meta;

use File::HomeDir;
use Parse::CPAN::Packages::Fast;

my $target_dist = 'Devel-Cover';
my $first_year  = 2012;
my $cpan_mirror = 'http://www.cpan.org';
my %prereq_skip = (
 'run' => {
  'Perl::Tidy'        => 1,
  'Test::Differences' => 1,
 },
);
my %prereq_desc = (
 'PPI::HTML' => 'Devel::Cover lets you optionally pick between L<PPI::HTML> and L<Perl::Tidy>, but it will only use the former if both are installed.',
);

my %opts;
getopts 'n' => \%opts;

sub get_latest_dist {
 my $dist = shift;

 my $home = File::HomeDir->my_home;
 my $pkgs = File::Spec->catfile($home, qw<.cpanplus 02packages.details.txt.gz>);
 my $pcp  = Parse::CPAN::Packages::Fast->new($pkgs);

 my $d = $pcp->latest_distribution($dist);
 die "Could not find distribution '$dist' on the CPAN" unless $d;

 return $d;
}

sub get_dist_meta {
 my $d = shift;

 $cpan_mirror =~s{/+$}{}g;
 my $cpanid   = $d->cpanid;
 my ($cp, $c) = $cpanid =~ /^((.).)/;
 my $uri      = join '/', $cpan_mirror, 'authors', 'id', $c, $cp, $cpanid,
                          $d->filename;

 my $tmp_dir     = File::Temp->newdir;
 # Force symlinks resolution
 my $tmp_dirname = Cwd::abs_path($tmp_dir->dirname);

 my $ff      = File::Fetch->new(uri => $uri);
 my $archive = $ff->fetch(to => $tmp_dirname);
 die $ff->error unless $archive;

 my $ae = Archive::Extract->new(archive => $archive);
 $ae->extract(to => $tmp_dirname) or die $ae->error;

 my $files = {
  map { File::Spec->catfile($tmp_dirname, $_) => 1 }
   @{$ae->files}
 };
 my $abs_extract_path = Cwd::abs_path($ae->extract_path);
 my @meta_candidates  = map File::Spec->catfile($abs_extract_path, $_),
                         qw<META.json META.yml>;
 my $meta_file;
 for my $file (@meta_candidates) {
  if ($files->{$file}) {
   $meta_file = $file;
   last;
  }
 }
 die 'No META file for ' . $d->distvname . "\n" unless $meta_file;

 return Parse::CPAN::Meta->load_file($meta_file);
}

my $latest_target  = get_latest_dist($target_dist);
my $target_version = $latest_target->version;
my $meta           = get_dist_meta($latest_target);

my %eumm_phases = (
 configure => [ qw<configure>  ],
 build     => [ qw<build test> ],
 run       => [ qw<runtime>    ],
);
my %prereqs = (
 configure => {
  'ExtUtils::MakeMaker' => '0',
 },
 build => {
  'ExtUtils::MakeMaker' => '0',
  'Test::More'          => '0',
 },
 perl => '5',
);

for my $eumm_phase (keys %eumm_phases) {
 my $prereqs = $prereqs{$eumm_phase} ||= { };
 my $skip    = $prereq_skip{$eumm_phase};

 for my $meta_phase (@{$eumm_phases{$eumm_phase}}) {

  for my $type (qw<requires recommends>) {
   my $phase_prereqs = $meta->{prereqs}{$meta_phase}{$type};
   next unless $phase_prereqs;

   while (my ($module, $version) = each %$phase_prereqs) {
    next if $skip->{$module};

    if ($module eq 'perl') {
     if (not $prereqs{perl} or $prereqs{perl} < $version) {
      $prereqs{perl} = $version;
     }
    } elsif (not exists $prereqs->{$module} or
             version->parse($prereqs->{$module}) < version->parse($version)) {
     $prereqs->{$module} = $version;
    }
   }
  }
 }
}

(my $target_pkg = $target_dist) =~ s/-/::/g;
my $task_pkg    = "Task::${target_pkg}::Recommended";
(my $task_file  = "lib/$task_pkg.pm") =~ s{::}{/}g;
my $years       = join ',', $first_year .. ((gmtime)[5] + 1900);

my $old_task_version = '0.0.0';
if (-e $task_file) {
 open my $old_fh, '<', $task_file;
 while (<$old_fh>) {
  if (/our\s*\$VERSION\s*=\s*(.*);/) {
   $old_task_version = $1;
   $old_task_version =~ s/^(['"])(.*)\1$/$2/;
  }
 }
 close $old_fh;
}
my ($old_task_revision) = $old_task_version =~ /([0-9]+)$/;

my $new_task_version  = version->parse($target_version)->normal;
my $new_task_revision = $old_task_revision;
if (!$opts{n}
   and version->parse($new_task_version) <= version->parse($old_task_version)) {
 ++$new_task_revision;
}
if (($target_version =~ tr/.//) < 2) {
 my @components     = split /\./, $new_task_version;
 $components[2]     = $new_task_revision;
 $new_task_version  = join '.', @components;
} else {
 $new_task_version .= ".$new_task_revision";
}

(my $bug_queue = $task_pkg) =~ s/::/-/g;
my $bug_email  = "bug-\L$bug_queue\E at rt.cpan.org";
$bug_queue     = "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$bug_queue";

sub deplist_to_pod {
 my @deplist = @_;
 return 'None.' unless @deplist;

 my $pod = "=over 4\n\n";
 while (@deplist) {
  my ($module, $version) = splice @deplist, 0, 2;
  my $X = $module eq 'perl' ? 'C' : 'L';
  $pod .= "=item *\n\n$X<$module>";
  $pod .= " $version" if $version;
  $pod .= "\n\n";
  if (my $desc = $prereq_desc{$module}) {
   1 while chomp $desc;
   $pod .= "$desc\n\n";
  }
 }
 $pod .= '=back';

 return $pod;
}

sub deplist_to_perl {
 my @deplist = @_;
 return '{ }' unless @deplist;

 my $len = List::Util::max(
  map length, @deplist[grep not($_ % 2), 0 .. $#deplist ]
 );

 my $perl = "{\n";
 while (@deplist) {
  my ($module, $version) = splice @deplist, 0, 2;
  my $pad = $len + 1 - length $module;
  $perl  .= sprintf " '%s'%*s=> '%s',\n", $module, $pad, ' ', $version;
 }
 $perl .= '}';

 return $perl;
}

sub sorthr ($) {
 my $hr = shift;
 map { $_ => $hr->{$_} } sort keys %$hr;
}

# Make sure no package FOO statement appears in this file.
my $package_statement = join ' ', 'package',
                                   $task_pkg;

my %vars = (
 TARGET_PKG             => $target_pkg,
 TARGET_VERSION         => $target_version,
 TASK_PKG               => $task_pkg,
 PACKAGE_TASK_PKG       => $package_statement,
 TASK_VERSION           => $new_task_version,
 PERL_PREREQ            => $prereqs{perl},
 CONFIGURE_PREREQS_POD  => deplist_to_pod(sorthr $prereqs{configure}),
 BUILD_PREREQS_POD      => deplist_to_pod(sorthr $prereqs{build}),
 RUN_PREREQS_POD        => deplist_to_pod(
  $target_pkg => $target_version,
  'perl'      => $prereqs{perl},
  sorthr $prereqs{run}
 ),
 CONFIGURE_PREREQS_PERL => deplist_to_perl(sorthr $prereqs{configure}),
 BUILD_PREREQS_PERL     => deplist_to_perl(sorthr $prereqs{build}),
 RUN_PREREQS_PERL       => deplist_to_perl(
  sorthr $prereqs{run},
  $target_pkg => $target_version,
 ),
 TESTED_PREREQS         => deplist_to_perl(sorthr $prereqs{run}),
 BUG_EMAIL              => $bug_email,
 BUG_QUEUE              => $bug_queue,
 YEARS                  => $years,
);

my %templates = (
 $task_file => <<'TEMPLATE',
__PACKAGE_TASK_PKG__;

use strict;
use warnings;

=head1 NAME

__TASK_PKG__ - Install __TARGET_PKG__ and its recommended dependencies.

=head1 VERSION

Version __TASK_VERSION__

=cut

our $VERSION = '__TASK_VERSION__';

=head1 SYNOPSIS

    $ cpan __TASK_PKG__
    $ cpanp -i __TASK_PKG__
    $ cpanm __TASK_PKG__

=head1 DESCRIPTION

This task module lets you easily install L<__TARGET_PKG__> __TARGET_VERSION__ and all its recommended dependencies.

=head1 DEPENDENCIES

=head2 Configure-time dependencies

__CONFIGURE_PREREQS_POD__

=head2 Build-time and test-time dependencies

__BUILD_PREREQS_POD__

=head2 Run-time dependencies

__RUN_PREREQS_POD__

=head1 AUTHOR

Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.

You can contact me by mail or on C<irc.perl.org> (vincent).

=head1 BUGS

Please report any bugs or feature requests to C<__BUG_EMAIL__>, or through the web interface at L<__BUG_QUEUE__>.
I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc __TASK_PKG__

=head1 COPYRIGHT & LICENSE

Copyright __YEARS__ Vincent Pit, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of __TASK_PKG__
TEMPLATE
 # ----------------------------------------------------------------------------
 'Makefile.PL' => <<'TEMPLATE',
use __PERL_PREREQ__;

use strict;
use warnings;
use ExtUtils::MakeMaker;

my $dist = 'Task-Devel-Cover-Recommended';

(my $name = $dist) =~ s{-}{::}g;

(my $file = $dist) =~ s{-}{/}g;
$file = "lib/$file.pm";

my $CONFIGURE_PREREQS = __CONFIGURE_PREREQS_PERL__;

my $BUILD_PREREQS = __BUILD_PREREQS_PERL__;

my $RUN_PREREQS = __RUN_PREREQS_PERL__;

my %META = (
 configure_requires => $CONFIGURE_PREREQS,
 build_requires     => $BUILD_PREREQS,
 dynamic_config     => 0,
 resources          => {
  bugtracker => "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$dist",
  homepage   => "http://search.cpan.org/dist/$dist/",
  license    => 'http://dev.perl.org/licenses/',
  repository => "http://git.profvince.com/?p=perl%2Fmodules%2F$dist.git",
 },
);

WriteMakefile(
 NAME             => $name,
 AUTHOR           => 'Vincent Pit <perl@profvince.com>',
 LICENSE          => 'perl',
 VERSION_FROM     => $file,
 ABSTRACT_FROM    => $file,
 PL_FILES         => {},
 PREREQ_PM        => $RUN_PREREQS,
 MIN_PERL_VERSION => '__PERL_PREREQ__',
 META_MERGE       => \%META,
 dist             => {
  PREOP    => "pod2text -u $file > \$(DISTVNAME)/README",
  COMPRESS => 'gzip -9f', SUFFIX => 'gz'
 },
 clean            => {
  FILES => "$dist-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt*"
 }
);
TEMPLATE
 # ----------------------------------------------------------------------------
 't/01-deps.t' => <<'TEMPLATE',
#!perl

use strict;
use warnings;

use Test::More;

my $TESTED_PREREQS = __TESTED_PREREQS__;

plan tests => keys(%$TESTED_PREREQS) + 1;

my @tests = map [ $_ => $TESTED_PREREQS->{$_} ], keys %$TESTED_PREREQS;
push @tests, [ '__TARGET_PKG__' => '__TARGET_VERSION__' ];

for my $test (@tests) {
 my ($module, $version) = @$test;
 local $@;
 if ($version && $version !~ /^[0._]*$/) {
  eval "use $module $version ()";
  is $@, '', "$module v$version is available";
 } else {
  eval "use $module ()";
  is $@, '', "any version of $module is available";
 }
}
TEMPLATE
);

my $valid_keys = join '|', keys %vars;
$valid_keys    = qr/$valid_keys/;

for my $file (sort keys %templates) {
 my $template = $templates{$file};
 $template =~ s/\b__($valid_keys)__\b/$vars{$1}/go;

 open my $fh, '>', $file;
 print $fh $template;
 close $fh;
}
