Dogcows Code - chaz/git-codeowners/blob - maint/fatpack.pl

   1 #!/usr/bin/env perl
   2
   3 =head1 NAME
   4
   5     maint/fatpack.pl - Generate a fatpack version of git-codeowners
   6
   7 =head1 SYNOPSIS
   8
   9     maint/fatpack.pl --dist-dir DIRPATH [--clean]
  10
  11 =cut
  12
  13 use 5.010001;
  14 use strict;
  15 use warnings;
  16
  17 use CPAN::Meta;
  18 use Capture::Tiny qw(capture_stdout);
  19 use Config;
  20 use File::pushd;
  21 use Getopt::Long;
  22 use MetaCPAN::API;
  23 use Module::CoreList;
  24 use Path::Tiny 0.089;
  25
  26 my $core_version        = '5.010001';
  27 my $plenv_version       = '5.10.1';
  28 my %blacklist_modules   = map { $_ => 1 } (
  29     'perl',
  30     'Text::Table::ASV',     # brought in by Text::Table::Any but not actually required
  31     'Unicode::GCString',    # optional XS module
  32 );
  33 my @extra_modules = (
  34     'Proc::Find::Parents',  # used by Term::Detect::Software on some platforms
  35 );
  36
  37 my $clean = 0;
  38 my $distdir;
  39 GetOptions(
  40     'clean!'    => \$clean,
  41     'dist=s'    => \$distdir,
  42 ) or die "Invalid options.\n";
  43 $distdir && -d $distdir or die "Use --dist to specify path to a distribution directory.\n";
  44
  45 my $mcpan = MetaCPAN::API->new;
  46
  47 run($distdir, $clean);
  48 exit;
  49
  50 sub install_modules {
  51     my $path    = path(shift);
  52     my @modules = @_;
  53     run_command('cpanm', '-n', "-L$path", @modules);
  54 }
  55
  56 sub run {
  57     my $distdir = path(shift);
  58     my $clean   = shift;
  59
  60     my $builddir = path('.build');
  61     my $fatlibdir = path('fatlib');
  62
  63     if ($clean) {
  64         print STDERR "Cleaning...\n";
  65         $builddir->remove_tree({safe => 0});
  66         $fatlibdir->remove_tree({safe => 0});
  67     }
  68
  69     $builddir->mkpath;
  70
  71     my @modules = required_modules($distdir, $builddir->child('deps.txt'));
  72     install_modules($builddir->child('local'), @modules);
  73     pack_modules($builddir->child('local'), @modules);
  74
  75     clean_fatlib($fatlibdir);
  76
  77     # consolidate all modules into a new directory for packing
  78     my $moduledir = $builddir->child('modules');
  79     $moduledir->remove_tree({safe => 0});
  80     $moduledir->mkpath;
  81     system(qw{cp -r}, $fatlibdir, $distdir->child('lib'), "$moduledir/");
  82
  83     $moduledir->child('lib/Test/File/Codeowners.pm')->remove;    # don't need this
  84
  85     my $fatpack = do {
  86         my $cd_builddir = pushd($moduledir);
  87
  88         system('perlstrip', '--cache', '-v', find_modules('.'));
  89         `fatpack file`;
  90     };
  91
  92     generate_script($distdir->child('bin/git-codeowners'), $fatpack, 'git-codeowners');
  93 }
  94
  95 sub required_modules {
  96     my $path            = path(shift);
  97     my $cache_filepath  = shift;
  98
  99     print STDERR "Determining required modules...\n";
 100
 101     my $cachefile = $cache_filepath && path($cache_filepath);
 102     if (my $contents = eval { $cachefile->slurp_utf8 }) {
 103         chomp $contents;
 104         return split(/\n/, $contents);
 105     }
 106
 107     my $meta = CPAN::Meta->load_file($path->child('META.json'));
 108
 109     my $requires = CPAN::Meta::Requirements->new;
 110
 111     for my $type (qw{requires recommends suggests}) {
 112         my $reqs = $meta->effective_prereqs->requirements_for('runtime', $type);
 113         for my $module ($reqs->required_modules) {
 114             next if $blacklist_modules{$module};
 115
 116             my $core = $Module::CoreList::version{$core_version}{$module};
 117             print STDERR "skipping core: $module $core\n" if $core;
 118             next if $core && $reqs->accepts_module($module, $core);
 119
 120             $requires->add_string_requirement($module => $reqs->requirements_for_module($module));
 121             dependencies_for_module($requires, $module);
 122         }
 123     }
 124     $requires->clear_requirement($_) for qw(Module::CoreList ExtUtils::MakeMaker Carp);
 125     my @deps = $requires->required_modules;
 126
 127     push @deps, @extra_modules;
 128
 129     $cachefile->spew_utf8([map { "$_\n" } @deps]) if $cachefile;
 130
 131     return @deps;
 132 }
 133
 134 sub dependencies_for_dist {
 135     my $requires    = shift;
 136     my $name        = shift;
 137
 138     state %dists;
 139     return if $dists{$name}++;
 140     print STDERR "Finding dependencies for dist $name\n";
 141
 142     my $dist = $mcpan->release(distribution => $name);
 143
 144     my $reqs = CPAN::Meta::Requirements->new;
 145
 146     foreach my $dep (@{$dist->{dependency}}) {
 147         next if $dep->{phase} ne 'runtime';
 148         next if $dep->{relationship} ne 'requires'; # && $dep->{relationship} ne 'recommends';
 149
 150         my $module = $dep->{module};
 151         next if $blacklist_modules{$module};
 152
 153         $reqs->add_minimum($dep->{module} => $dep->{version});
 154         my $core = $Module::CoreList::version{$core_version}{$module};
 155         print STDERR "skipping core: $module $core\n" if $core;
 156         next if $core && $reqs->accepts_module($module, $core);
 157
 158         $requires->add_string_requirement($module => $reqs->requirements_for_module($module));
 159         dependencies_for_module($requires, $dep->{module});
 160     }
 161 }
 162
 163 sub dependencies_for_module {
 164     my $requires    = shift;
 165     my $name        = shift;
 166
 167     state %modules;
 168     return if $modules{$name}++;
 169     print STDERR "Finding dependencies for module $name\n";
 170
 171     my $module = $mcpan->module($name);
 172     dependencies_for_dist($requires, $module->{distribution});
 173 }
 174
 175 sub clean_fatlib {
 176     my $path = path(shift);
 177     $path->child($Config{archname})->remove_tree({safe => 0});
 178     $path->child('POD2')->remove_tree({safe => 0});
 179     $path->visit(sub {
 180         local $_ = shift;
 181         if (/\.p(od|l)$/ || /\.sample$/) {
 182             print "rm $_\n";
 183             $_->remove;
 184         }
 185     }, {recurse => 1});
 186 }
 187
 188 sub find_modules {
 189     my $path = path(shift);
 190     my @pm_filepaths;
 191     $path->visit(sub {
 192         local $_ = shift;
 193         push @pm_filepaths, $_ if /\.pm$/;
 194     }, {recurse => 1});
 195     return @pm_filepaths;
 196 }
 197
 198 sub pack_modules {
 199     my ($path, @modules) = @_;
 200
 201     my @filepaths = map { my $s = $_; $s =~ s!::!/!g; "$s.pm" } @modules;
 202
 203     my $stdout = capture_stdout {
 204         local $ENV{PERL5LIB} = $path->child('lib/perl5')->absolute;
 205         system('fatpack', 'packlists-for', @filepaths);
 206     };
 207
 208     my @packlists = split(/\n/, $stdout);
 209     for my $packlist (@packlists) {
 210         warn "Packing $packlist\n";
 211     }
 212
 213     system('fatpack', 'tree', map { path($_)->absolute } @packlists);
 214 }
 215
 216 sub generate_script {
 217     my ($input_filepath, $fatpack, $output_filepath) = @_;
 218
 219     open(my $in,  '<', $input_filepath)        or die "open failed: $!";
 220     open(my $out, '>', "$output_filepath.tmp") or die "open failed: $!";
 221
 222     while (<$in>) {
 223         s|^#!\h*perl|#!/usr/bin/env perl|;
 224         s|^# FATPACK.*|$fatpack|;
 225         print $out $_;
 226     }
 227
 228     unlink($output_filepath);
 229     rename("$output_filepath.tmp", $output_filepath);
 230
 231     path($output_filepath)->chmod(0755);
 232
 233     print STDERR "Wrote fatpacked script: $output_filepath\n";
 234 }
 235
 236 sub run_command {
 237     local $ENV{PLENV_VERSION} = $plenv_version;
 238     system('plenv', 'exec', @_);
 239 }
 240