]> git.vpit.fr Git - perl/modules/Task-Devel-Cover-Recommended.git/blob - samples/generate.pl
This is 0.930.0
[perl/modules/Task-Devel-Cover-Recommended.git] / samples / generate.pl
1 #!perl
2
3 use strict;
4 use warnings;
5
6 use autodie;
7 use version;
8
9 use Archive::Extract;
10 use Cwd;
11 use File::Fetch;
12 use File::Spec;
13 use File::Temp 0.19;
14 use List::Util;
15 use Parse::CPAN::Meta;
16
17 use File::HomeDir;
18 use Parse::CPAN::Packages::Fast;
19
20 my $target_dist = 'Devel-Cover';
21 my $first_year  = 2012;
22 my $cpan_mirror = 'http://www.cpan.org';
23 my %prereq_skip = (
24  'run' => {
25   'Perl::Tidy'        => 1,
26   'Test::Differences' => 1,
27  },
28 );
29 my %prereq_desc = (
30  '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.',
31 );
32
33 sub get_latest_dist {
34  my $dist = shift;
35
36  my $home = File::HomeDir->my_home;
37  my $pkgs = File::Spec->catfile($home, qw<.cpanplus 02packages.details.txt.gz>);
38  my $pcp  = Parse::CPAN::Packages::Fast->new($pkgs);
39
40  my $d = $pcp->latest_distribution($dist);
41  die "Could not find distribution '$dist' on the CPAN" unless $d;
42
43  return $d;
44 }
45
46 sub get_dist_meta {
47  my $d = shift;
48
49  $cpan_mirror =~s{/+$}{}g;
50  my $cpanid   = $d->cpanid;
51  my ($cp, $c) = $cpanid =~ /^((.).)/;
52  my $uri      = join '/', $cpan_mirror, 'authors', 'id', $c, $cp, $cpanid,
53                           $d->filename;
54
55  my $tmp_dir     = File::Temp->newdir;
56  # Force symlinks resolution
57  my $tmp_dirname = Cwd::abs_path($tmp_dir->dirname);
58
59  my $ff      = File::Fetch->new(uri => $uri);
60  my $archive = $ff->fetch(to => $tmp_dirname);
61  die $ff->error unless $archive;
62
63  my $ae = Archive::Extract->new(archive => $archive);
64  $ae->extract(to => $tmp_dirname) or die $ae->error;
65
66  my $files = {
67   map { File::Spec->catfile($tmp_dirname, $_) => 1 }
68    @{$ae->files}
69  };
70  my $abs_extract_path = Cwd::abs_path($ae->extract_path);
71  my @meta_candidates  = map File::Spec->catfile($abs_extract_path, $_),
72                          qw<META.json META.yml>;
73  my $meta_file;
74  for my $file (@meta_candidates) {
75   if ($files->{$file}) {
76    $meta_file = $file;
77    last;
78   }
79  }
80  die 'No META file for ' . $d->distvname . "\n" unless $meta_file;
81
82  return Parse::CPAN::Meta->load_file($meta_file);
83 }
84
85 my $latest_target  = get_latest_dist($target_dist);
86 my $target_version = $latest_target->version;
87 my $meta           = get_dist_meta($latest_target);
88
89 my %eumm_phases = (
90  configure => [ qw<configure>  ],
91  build     => [ qw<build test> ],
92  run       => [ qw<runtime>    ],
93 );
94 my %prereqs = (
95  configure => {
96   'ExtUtils::MakeMaker' => '0',
97  },
98  build => {
99   'ExtUtils::MakeMaker' => '0',
100   'Test::More'          => '0',
101  },
102  perl => '5',
103 );
104
105 for my $eumm_phase (keys %eumm_phases) {
106  my $prereqs = $prereqs{$eumm_phase} ||= { };
107  my $skip    = $prereq_skip{$eumm_phase};
108
109  for my $meta_phase (@{$eumm_phases{$eumm_phase}}) {
110
111   for my $type (qw<requires recommends>) {
112    my $phase_prereqs = $meta->{prereqs}{$meta_phase}{$type};
113    next unless $phase_prereqs;
114
115    while (my ($module, $version) = each %$phase_prereqs) {
116     next if $skip->{$module};
117
118     if ($module eq 'perl') {
119      if (not $prereqs{perl} or $prereqs{perl} < $version) {
120       $prereqs{perl} = $version;
121      }
122     } elsif (not exists $prereqs->{$module} or
123              version->parse($prereqs->{$module}) < version->parse($version)) {
124      $prereqs->{$module} = $version;
125     }
126    }
127   }
128  }
129 }
130
131 (my $target_pkg = $target_dist) =~ s/-/::/g;
132 my $task_pkg    = "Task::${target_pkg}::Recommended";
133 (my $task_file  = "lib/$task_pkg.pm") =~ s{::}{/}g;
134 my $years       = join ',', $first_year .. ((gmtime)[5] + 1900);
135
136 my $old_task_version = '0.0.0';
137 if (-e $task_file) {
138  open my $old_fh, '<', $task_file;
139  while (<$old_fh>) {
140   if (/our\s*\$VERSION\s*=\s*(.*);/) {
141    $old_task_version = $1;
142    $old_task_version =~ s/^(['"])(.*)\1$/$2/;
143   }
144  }
145  close $old_fh;
146 }
147 my ($old_task_revision) = $old_task_version =~ /([0-9]+)$/;
148
149 my $new_task_version  = version->parse($target_version)->normal;
150 my $new_task_revision = $old_task_revision;
151 ++$new_task_revision
152       if version->parse($new_task_version) <= version->parse($old_task_version);
153 if (($target_version =~ tr/.//) < 2) {
154  my @components     = split /\./, $new_task_version;
155  $components[2]     = $new_task_revision;
156  $new_task_version  = join '.', @components;
157 } else {
158  $new_task_version .= ".$new_task_revision";
159 }
160
161 (my $bug_queue = $task_pkg) =~ s/::/-/g;
162 my $bug_email  = "bug-\L$bug_queue\E at rt.cpan.org";
163 $bug_queue     = "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$bug_queue";
164
165 sub deplist_to_pod {
166  my @deplist = @_;
167  return 'None.' unless @deplist;
168
169  my $pod = "=over 4\n\n";
170  while (@deplist) {
171   my ($module, $version) = splice @deplist, 0, 2;
172   my $X = $module eq 'perl' ? 'C' : 'L';
173   $pod .= "=item $X<$module>";
174   $pod .= " $version" if $version;
175   $pod .= "\n\n";
176   if (my $desc = $prereq_desc{$module}) {
177    1 while chomp $desc;
178    $pod .= "$desc\n\n";
179   }
180  }
181  $pod .= '=back';
182
183  return $pod;
184 }
185
186 sub deplist_to_perl {
187  my @deplist = @_;
188  return '{ }' unless @deplist;
189
190  my $len = List::Util::max(
191   map length, @deplist[grep not($_ % 2), 0 .. $#deplist ]
192  );
193
194  my $perl = "{\n";
195  while (@deplist) {
196   my ($module, $version) = splice @deplist, 0, 2;
197   my $pad = $len + 1 - length $module;
198   $perl  .= sprintf " '%s'%*s=> '%s',\n", $module, $pad, ' ', $version;
199  }
200  $perl .= '}';
201
202  return $perl;
203 }
204
205 sub sorthr ($) {
206  my $hr = shift;
207  map { $_ => $hr->{$_} } sort keys %$hr;
208 }
209
210 my %vars = (
211  TARGET_PKG             => $target_pkg,
212  TARGET_VERSION         => $target_version,
213  TASK_PKG               => $task_pkg,
214  TASK_VERSION           => $new_task_version,
215  PERL_PREREQ            => $prereqs{perl},
216  CONFIGURE_PREREQS_POD  => deplist_to_pod(sorthr $prereqs{configure}),
217  BUILD_PREREQS_POD      => deplist_to_pod(sorthr $prereqs{build}),
218  RUN_PREREQS_POD        => deplist_to_pod(
219   $target_pkg => $target_version,
220   'perl'      => $prereqs{perl},
221   sorthr $prereqs{run}
222  ),
223  CONFIGURE_PREREQS_PERL => deplist_to_perl(sorthr $prereqs{configure}),
224  BUILD_PREREQS_PERL     => deplist_to_perl(sorthr $prereqs{build}),
225  RUN_PREREQS_PERL       => deplist_to_perl(
226   sorthr $prereqs{run},
227   $target_pkg => $target_version,
228  ),
229  TESTED_PREREQS         => deplist_to_perl(sorthr $prereqs{run}),
230  BUG_EMAIL              => $bug_email,
231  BUG_QUEUE              => $bug_queue,
232  YEARS                  => $years,
233 );
234
235 my %templates = (
236  $task_file => <<'TEMPLATE',
237 package __TASK_PKG__;
238
239 use strict;
240 use warnings;
241
242 =head1 NAME
243
244 __TASK_PKG__ - Install __TARGET_PKG__ and its recommended dependencies.
245
246 =head1 VERSION
247
248 Version __TASK_VERSION__
249
250 =cut
251
252 our $VERSION = '__TASK_VERSION__';
253
254 =head1 SYNOPSIS
255
256     $ cpan __TASK_PKG__
257     $ cpanp -i __TASK_PKG__
258     $ cpanm __TASK_PKG__
259
260 =head1 DESCRIPTION
261
262 This task module lets you easily install L<__TARGET_PKG__> __TARGET_VERSION__ and all its recommended dependencies.
263
264 =head1 DEPENDENCIES
265
266 =head2 Configure-time dependencies
267
268 __CONFIGURE_PREREQS_POD__
269
270 =head2 Build-time and test-time dependencies
271
272 __BUILD_PREREQS_POD__
273
274 =head2 Run-time dependencies
275
276 __RUN_PREREQS_POD__
277
278 =head1 AUTHOR
279
280 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
281
282 You can contact me by mail or on C<irc.perl.org> (vincent).
283
284 =head1 BUGS
285
286 Please report any bugs or feature requests to C<__BUG_EMAIL__>, or through the web interface at L<__BUG_QUEUE__>.
287 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
288
289 =head1 SUPPORT
290
291 You can find documentation for this module with the perldoc command.
292
293     perldoc __TASK_PKG__
294
295 =head1 COPYRIGHT & LICENSE
296
297 Copyright __YEARS__ Vincent Pit, all rights reserved.
298
299 This program is free software; you can redistribute it and/or modify it
300 under the same terms as Perl itself.
301
302 =cut
303
304 1; # End of __TASK_PKG__
305 TEMPLATE
306  # ----------------------------------------------------------------------------
307  'Makefile.PL' => <<'TEMPLATE',
308 use __PERL_PREREQ__;
309
310 use strict;
311 use warnings;
312 use ExtUtils::MakeMaker;
313
314 my $dist = 'Task-Devel-Cover-Recommended';
315
316 (my $name = $dist) =~ s{-}{::}g;
317
318 (my $file = $dist) =~ s{-}{/}g;
319 $file = "lib/$file.pm";
320
321 my $CONFIGURE_PREREQS = __CONFIGURE_PREREQS_PERL__;
322
323 my $BUILD_PREREQS = __BUILD_PREREQS_PERL__;
324
325 my $RUN_PREREQS = __RUN_PREREQS_PERL__;
326
327 my %META = (
328  configure_requires => $CONFIGURE_PREREQS,
329  build_requires     => $BUILD_PREREQS,
330  dynamic_config     => 0,
331  resources          => {
332   bugtracker => "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$dist",
333   homepage   => "http://search.cpan.org/dist/$dist/",
334   license    => 'http://dev.perl.org/licenses/',
335   repository => "http://git.profvince.com/?p=perl%2Fmodules%2F$dist.git",
336  },
337 );
338
339 WriteMakefile(
340  NAME             => $name,
341  AUTHOR           => 'Vincent Pit <perl@profvince.com>',
342  LICENSE          => 'perl',
343  VERSION_FROM     => $file,
344  ABSTRACT_FROM    => $file,
345  PL_FILES         => {},
346  PREREQ_PM        => $RUN_PREREQS,
347  MIN_PERL_VERSION => '__PERL_PREREQ__',
348  META_MERGE       => \%META,
349  dist             => {
350   PREOP    => "pod2text -u $file > \$(DISTVNAME)/README",
351   COMPRESS => 'gzip -9f', SUFFIX => 'gz'
352  },
353  clean            => {
354   FILES => "$dist-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt*"
355  }
356 );
357 TEMPLATE
358  # ----------------------------------------------------------------------------
359  't/01-deps.t' => <<'TEMPLATE',
360 #!perl
361
362 use strict;
363 use warnings;
364
365 use Test::More;
366
367 my $TESTED_PREREQS = __TESTED_PREREQS__;
368
369 plan tests => keys(%$TESTED_PREREQS) + 1;
370
371 my @tests = map [ $_ => $TESTED_PREREQS->{$_} ], keys %$TESTED_PREREQS;
372 push @tests, [ '__TARGET_PKG__' => '__TARGET_VERSION__' ];
373
374 for my $test (@tests) {
375  my ($module, $version) = @$test;
376  local $@;
377  if ($version && $version !~ /^[0._]*$/) {
378   eval "use $module $version ()";
379   is $@, '', "$module v$version is available";
380  } else {
381   eval "use $module ()";
382   is $@, '', "any version of $module is available";
383  }
384 }
385 TEMPLATE
386 );
387
388 my $valid_keys = join '|', keys %vars;
389 $valid_keys    = qr/$valid_keys/;
390
391 for my $file (sort keys %templates) {
392  my $template = $templates{$file};
393  $template =~ s/\b__($valid_keys)__\b/$vars{$1}/go;
394
395  open my $fh, '>', $file;
396  print $fh $template;
397  close $fh;
398 }