16 use Parse::CPAN::Meta;
19 use Parse::CPAN::Packages::Fast;
21 my $target_dist = 'Devel-Cover';
22 my $first_year = 2012;
23 my $cpan_mirror = 'http://www.cpan.org';
27 'Test::Differences' => 1,
31 '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.',
35 getopts 'n' => \%opts;
40 my $home = File::HomeDir->my_home;
41 my $pkgs = File::Spec->catfile($home, qw<.cpanplus 02packages.details.txt.gz>);
42 my $pcp = Parse::CPAN::Packages::Fast->new($pkgs);
44 my $d = $pcp->latest_distribution($dist);
45 die "Could not find distribution '$dist' on the CPAN" unless $d;
53 $cpan_mirror =~s{/+$}{}g;
54 my $cpanid = $d->cpanid;
55 my ($cp, $c) = $cpanid =~ /^((.).)/;
56 my $uri = join '/', $cpan_mirror, 'authors', 'id', $c, $cp, $cpanid,
59 my $tmp_dir = File::Temp->newdir;
60 # Force symlinks resolution
61 my $tmp_dirname = Cwd::abs_path($tmp_dir->dirname);
63 my $ff = File::Fetch->new(uri => $uri);
64 my $archive = $ff->fetch(to => $tmp_dirname);
65 die $ff->error unless $archive;
67 my $ae = Archive::Extract->new(archive => $archive);
68 $ae->extract(to => $tmp_dirname) or die $ae->error;
71 map { File::Spec->catfile($tmp_dirname, $_) => 1 }
74 my $abs_extract_path = Cwd::abs_path($ae->extract_path);
75 my @meta_candidates = map File::Spec->catfile($abs_extract_path, $_),
76 qw<META.json META.yml>;
78 for my $file (@meta_candidates) {
79 if ($files->{$file}) {
84 die 'No META file for ' . $d->distvname . "\n" unless $meta_file;
86 return Parse::CPAN::Meta->load_file($meta_file);
89 my $latest_target = get_latest_dist($target_dist);
90 my $target_version = $latest_target->version;
91 my $meta = get_dist_meta($latest_target);
94 configure => [ qw<configure> ],
95 build => [ qw<build test> ],
96 run => [ qw<runtime> ],
100 'ExtUtils::MakeMaker' => '0',
103 'ExtUtils::MakeMaker' => '0',
109 for my $eumm_phase (keys %eumm_phases) {
110 my $prereqs = $prereqs{$eumm_phase} ||= { };
111 my $skip = $prereq_skip{$eumm_phase};
113 for my $meta_phase (@{$eumm_phases{$eumm_phase}}) {
115 for my $type (qw<requires recommends>) {
116 my $phase_prereqs = $meta->{prereqs}{$meta_phase}{$type};
117 next unless $phase_prereqs;
119 while (my ($module, $version) = each %$phase_prereqs) {
120 next if $skip->{$module};
122 if ($module eq 'perl') {
123 if (not $prereqs{perl} or $prereqs{perl} < $version) {
124 $prereqs{perl} = $version;
126 } elsif (not exists $prereqs->{$module} or
127 version->parse($prereqs->{$module}) < version->parse($version)) {
128 $prereqs->{$module} = $version;
135 (my $target_pkg = $target_dist) =~ s/-/::/g;
136 my $task_pkg = "Task::${target_pkg}::Recommended";
137 (my $task_file = "lib/$task_pkg.pm") =~ s{::}{/}g;
138 my $years = join ',', $first_year .. ((gmtime)[5] + 1900);
140 my $old_task_version = '0.0.0';
142 open my $old_fh, '<', $task_file;
144 if (/our\s*\$VERSION\s*=\s*(.*);/) {
145 $old_task_version = $1;
146 $old_task_version =~ s/^(['"])(.*)\1$/$2/;
151 my ($old_task_revision) = $old_task_version =~ /([0-9]+)$/;
153 my $new_task_version = version->parse($target_version)->normal;
154 my $new_task_revision = $old_task_revision;
156 and version->parse($new_task_version) <= version->parse($old_task_version)) {
157 ++$new_task_revision;
159 if (($target_version =~ tr/.//) < 2) {
160 my @components = split /\./, $new_task_version;
161 $components[2] = $new_task_revision;
162 $new_task_version = join '.', @components;
164 $new_task_version .= ".$new_task_revision";
167 (my $bug_queue = $task_pkg) =~ s/::/-/g;
168 my $bug_email = "bug-\L$bug_queue\E at rt.cpan.org";
169 $bug_queue = "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$bug_queue";
173 return 'None.' unless @deplist;
175 my $pod = "=over 4\n\n";
177 my ($module, $version) = splice @deplist, 0, 2;
178 my $X = $module eq 'perl' ? 'C' : 'L';
179 $pod .= "=item *\n\n$X<$module>";
180 $pod .= " $version" if $version;
182 if (my $desc = $prereq_desc{$module}) {
192 sub deplist_to_perl {
194 return '{ }' unless @deplist;
196 my $len = List::Util::max(
197 map length, @deplist[grep not($_ % 2), 0 .. $#deplist ]
202 my ($module, $version) = splice @deplist, 0, 2;
203 my $pad = $len + 1 - length $module;
204 $perl .= sprintf " '%s'%*s=> '%s',\n", $module, $pad, ' ', $version;
213 map { $_ => $hr->{$_} } sort keys %$hr;
216 # Make sure no package FOO statement appears in this file.
217 my $package_statement = join ' ', 'package',
221 TARGET_PKG => $target_pkg,
222 TARGET_VERSION => $target_version,
223 TASK_PKG => $task_pkg,
224 PACKAGE_TASK_PKG => $package_statement,
225 TASK_VERSION => $new_task_version,
226 PERL_PREREQ => $prereqs{perl},
227 CONFIGURE_PREREQS_POD => deplist_to_pod(sorthr $prereqs{configure}),
228 BUILD_PREREQS_POD => deplist_to_pod(sorthr $prereqs{build}),
229 RUN_PREREQS_POD => deplist_to_pod(
230 $target_pkg => $target_version,
231 'perl' => $prereqs{perl},
234 CONFIGURE_PREREQS_PERL => deplist_to_perl(sorthr $prereqs{configure}),
235 BUILD_PREREQS_PERL => deplist_to_perl(sorthr $prereqs{build}),
236 RUN_PREREQS_PERL => deplist_to_perl(
237 sorthr $prereqs{run},
238 $target_pkg => $target_version,
240 TESTED_PREREQS => deplist_to_perl(sorthr $prereqs{run}),
241 BUG_EMAIL => $bug_email,
242 BUG_QUEUE => $bug_queue,
247 $task_file => <<'TEMPLATE',
248 __PACKAGE_TASK_PKG__;
255 __TASK_PKG__ - Install __TARGET_PKG__ and its recommended dependencies.
259 Version __TASK_VERSION__
263 our $VERSION = '__TASK_VERSION__';
268 $ cpanp -i __TASK_PKG__
273 This task module lets you easily install L<__TARGET_PKG__> __TARGET_VERSION__ and all its recommended dependencies.
277 =head2 Configure-time dependencies
279 __CONFIGURE_PREREQS_POD__
281 =head2 Build-time and test-time dependencies
283 __BUILD_PREREQS_POD__
285 =head2 Run-time dependencies
291 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
293 You can contact me by mail or on C<irc.perl.org> (vincent).
297 Please report any bugs or feature requests to C<__BUG_EMAIL__>, or through the web interface at L<__BUG_QUEUE__>.
298 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
302 You can find documentation for this module with the perldoc command.
306 =head1 COPYRIGHT & LICENSE
308 Copyright __YEARS__ Vincent Pit, all rights reserved.
310 This program is free software; you can redistribute it and/or modify it
311 under the same terms as Perl itself.
315 1; # End of __TASK_PKG__
317 # ----------------------------------------------------------------------------
318 'Makefile.PL' => <<'TEMPLATE',
323 use ExtUtils::MakeMaker;
325 my $dist = 'Task-Devel-Cover-Recommended';
327 (my $name = $dist) =~ s{-}{::}g;
329 (my $file = $dist) =~ s{-}{/}g;
330 $file = "lib/$file.pm";
332 my $CONFIGURE_PREREQS = __CONFIGURE_PREREQS_PERL__;
334 my $BUILD_PREREQS = __BUILD_PREREQS_PERL__;
336 my $RUN_PREREQS = __RUN_PREREQS_PERL__;
339 configure_requires => $CONFIGURE_PREREQS,
340 build_requires => $BUILD_PREREQS,
343 bugtracker => "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$dist",
344 homepage => "http://search.cpan.org/dist/$dist/",
345 license => 'http://dev.perl.org/licenses/',
346 repository => "http://git.profvince.com/?p=perl%2Fmodules%2F$dist.git",
352 AUTHOR => 'Vincent Pit <perl@profvince.com>',
354 VERSION_FROM => $file,
355 ABSTRACT_FROM => $file,
357 PREREQ_PM => $RUN_PREREQS,
358 MIN_PERL_VERSION => '__PERL_PREREQ__',
359 META_MERGE => \%META,
361 PREOP => "pod2text -u $file > \$(DISTVNAME)/README",
362 COMPRESS => 'gzip -9f', SUFFIX => 'gz'
365 FILES => "$dist-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt*"
369 # ----------------------------------------------------------------------------
370 't/01-deps.t' => <<'TEMPLATE',
378 my $TESTED_PREREQS = __TESTED_PREREQS__;
380 plan tests => keys(%$TESTED_PREREQS) + 1;
382 my @tests = map [ $_ => $TESTED_PREREQS->{$_} ], keys %$TESTED_PREREQS;
383 push @tests, [ '__TARGET_PKG__' => '__TARGET_VERSION__' ];
385 for my $test (@tests) {
386 my ($module, $version) = @$test;
388 if ($version && $version !~ /^[0._]*$/) {
389 eval "use $module $version ()";
390 is $@, '', "$module v$version is available";
392 eval "use $module ()";
393 is $@, '', "any version of $module is available";
399 my $valid_keys = join '|', keys %vars;
400 $valid_keys = qr/$valid_keys/;
402 for my $file (sort keys %templates) {
403 my $template = $templates{$file};
404 $template =~ s/\b__($valid_keys)__\b/$vars{$1}/go;
406 open my $fh, '>', $file;