Skip to content

Instantly share code, notes, and snippets.

@motemen
Created October 29, 2013 08:47
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save motemen/7211104 to your computer and use it in GitHub Desktop.
Save motemen/7211104 to your computer and use it in GitHub Desktop.
while ! carton exec perl -MCartonPacker foo.pl do; sleep 3; done
package CartonPacker;
use strict;
use warnings;
use Config;
BEGIN {
# as lib::core::only
@INC = @Config{qw(privlibexp archlibexp)};
}
use lib split /\Q$Config{path_sep}\E/, $ENV{PERL5LIB};
use File::Copy;
my $carton = $ENV{CARTON} || 'carton';
my $cpanm = $ENV{CPANM} || 'cpanm';
our %IGNORE = map { $_ => 1 } (
'Encode::ConfigLocal',
'Devel::StackTraceFrame',
'Log::Agent',
);
if (open my $fh, '<', '.cartonpackerignore') {
foreach (<$fh>) {
chomp;
$IGNORE{$_}++;
}
}
open my $cpanfile, '>>', 'cpanfile' or die "open >> cpanfile: $!";
open my $cartonpackerignore, '>>', '.cartonpackerignore' or die "open >> .cartonpackerignore: $!";
sub import {
push @INC, sub {
my ($self, $pkg) = @_;
$pkg =~ s/\.pm$//;
$pkg =~ s</><::>g;
return if $IGNORE{$pkg};
return if do {
no strict 'refs';
%{ "$pkg\::" };
};
my @caller;
for (1..10) {
@caller = caller($_);
last if $caller[1] !~ /^\(eval/;
}
copy 'cpanfile', '.cpanfile.bak' or die "cp failed: $!";
# Canonicalize to module (eg. HTML::TreeBuilder::XPath::Node -> HTML::TreeBuilder::XPath)
my $module = qx($cpanm --info $pkg);
chomp $module;
die "Could not retrieve result: `$cpanm --info $pkg`" unless length $module;
$module =~ s<^.*/><>;
$module =~ s<-[\d\.\w]+$><>;
$module =~ s<-><::>g;
print { $cpanfile } qq(requires '$module';\n);
print STDERR "# +requires '$module' ($pkg <- $caller[1]#$caller[2]) ... ";
my $installed = (system("$carton install") == 0);
if ($installed) {
print STDERR "# Added $module\n";
} else {
# Revert
copy '.cpanfile.bak', 'cpanfile' or die "cp failed: $!";
}
if (!$installed || $pkg ne $module) {
print { $cartonpackerignore } "$pkg\n";
print STDERR "# Ignored $pkg\n";
}
exit 1;
};
}
1;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment