Dogcows Code - chaz/graphql-client/blob - maint/fatpack.pl

   1 #!/usr/bin/env perl
   2
   3 =head1 NAME
   4
   5     maint/fatpack.pl - Generate a fatpack version of graphql
   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     my $fatpack = do {
  84         my $cd_builddir = pushd($moduledir);
  85
  86         system('perlstrip', '--cache', '-v', find_modules('.'));
  87         `fatpack file`;
  88     };
  89
  90     generate_script($distdir->child('bin/graphql'), $fatpack, 'graphql');
  91 }
  92
  93 sub required_modules {
  94     my $path            = path(shift);
  95     my $cache_filepath  = shift;
  96
  97     print STDERR "Determining required modules...\n";
  98
  99     my $cachefile = $cache_filepath && path($cache_filepath);
 100     if (my $contents = eval { $cachefile->slurp_utf8 }) {
 101         chomp $contents;
 102         return split(/\n/, $contents);
 103     }
 104
 105     my $meta = CPAN::Meta->load_file($path->child('META.json'));
 106
 107     my $requires = CPAN::Meta::Requirements->new;
 108
 109     for my $type (qw{requires recommends suggests}) {
 110         my $reqs = $meta->effective_prereqs->requirements_for('runtime', $type);
 111         for my $module ($reqs->required_modules) {
 112             next if $blacklist_modules{$module};
 113
 114             my $core = $Module::CoreList::version{$core_version}{$module};
 115             print STDERR "skipping core: $module $core\n" if $core;
 116             next if $core && $reqs->accepts_module($module, $core);
 117
 118             $requires->add_string_requirement($module => $reqs->requirements_for_module($module));
 119             dependencies_for_module($requires, $module);
 120         }
 121     }
 122     $requires->clear_requirement($_) for qw(Module::CoreList ExtUtils::MakeMaker Carp);
 123     my @deps = $requires->required_modules;
 124
 125     push @deps, @extra_modules;
 126
 127     $cachefile->spew_utf8([map { "$_\n" } @deps]) if $cachefile;
 128
 129     return @deps;
 130 }
 131
 132 sub dependencies_for_dist {
 133     my $requires    = shift;
 134     my $name        = shift;
 135
 136     state %dists;
 137     return if $dists{$name}++;
 138     print STDERR "Finding dependencies for dist $name\n";
 139
 140     my $dist = $mcpan->release(distribution => $name);
 141
 142     my $reqs = CPAN::Meta::Requirements->new;
 143
 144     foreach my $dep (@{$dist->{dependency}}) {
 145         next if $dep->{phase} ne 'runtime';
 146         next if $dep->{relationship} ne 'requires'; # && $dep->{relationship} ne 'recommends';
 147
 148         my $module = $dep->{module};
 149         next if $blacklist_modules{$module};
 150
 151         $reqs->add_minimum($dep->{module} => $dep->{version});
 152         my $core = $Module::CoreList::version{$core_version}{$module};
 153         print STDERR "skipping core: $module $core\n" if $core;
 154         next if $core && $reqs->accepts_module($module, $core);
 155
 156         $requires->add_string_requirement($module => $reqs->requirements_for_module($module));
 157         dependencies_for_module($requires, $dep->{module});
 158     }
 159 }
 160
 161 sub dependencies_for_module {
 162     my $requires    = shift;
 163     my $name        = shift;
 164
 165     state %modules;
 166     return if $modules{$name}++;
 167     print STDERR "Finding dependencies for module $name\n";
 168
 169     my $module = $mcpan->module($name);
 170     dependencies_for_dist($requires, $module->{distribution});
 171 }
 172
 173 sub clean_fatlib {
 174     my $path = path(shift);
 175     $path->child($Config{archname})->remove_tree({safe => 0});
 176     $path->child('POD2')->remove_tree({safe => 0});
 177     $path->visit(sub {
 178         local $_ = shift;
 179         if (/\.p(od|l)$/ || /\.sample$/) {
 180             print "rm $_\n";
 181             $_->remove;
 182         }
 183     }, {recurse => 1});
 184 }
 185
 186 sub find_modules {
 187     my $path = path(shift);
 188     my @pm_filepaths;
 189     $path->visit(sub {
 190         local $_ = shift;
 191         push @pm_filepaths, $_ if /\.pm$/;
 192     }, {recurse => 1});
 193     return @pm_filepaths;
 194 }
 195
 196 sub pack_modules {
 197     my ($path, @modules) = @_;
 198
 199     my @filepaths = map { my $s = $_; $s =~ s!::!/!g; "$s.pm" } @modules;
 200
 201     my $stdout = capture_stdout {
 202         local $ENV{PERL5LIB} = $path->child('lib/perl5')->absolute;
 203         system('fatpack', 'packlists-for', @filepaths);
 204     };
 205
 206     my @packlists = split(/\n/, $stdout);
 207     for my $packlist (@packlists) {
 208         warn "Packing $packlist\n";
 209     }
 210
 211     system('fatpack', 'tree', map { path($_)->absolute } @packlists);
 212 }
 213
 214 sub generate_script {
 215     my ($input_filepath, $fatpack, $output_filepath) = @_;
 216
 217     open(my $in,  '<', $input_filepath)        or die "open failed: $!";
 218     open(my $out, '>', "$output_filepath.tmp") or die "open failed: $!";
 219
 220     while (<$in>) {
 221         s|^#!\h*perl|#!/usr/bin/env perl|;
 222         s|^# FATPACK.*|$fatpack|;
 223         print $out $_;
 224     }
 225
 226     unlink($output_filepath);
 227     rename("$output_filepath.tmp", $output_filepath);
 228
 229     path($output_filepath)->chmod(0755);
 230
 231     print STDERR "Wrote fatpacked script: $output_filepath\n";
 232 }
 233
 234 sub run_command {
 235     local $ENV{PLENV_VERSION} = $plenv_version;
 236     system('plenv', 'exec', @_);
 237 }
 238