add hook script to run cpanm against shim

Author: haarg

bin/cpanm-shim

@@ -0,0 +1,40 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Getopt::Long qw(:config gnu_getopt pass_through permute);
+
+GetOptions(
+  'cpanm=s'         => \my $cpanm,
+  'disable-metadb!' => \my $disable_metadb,
+  'debug!'          => \my $debug,
+) or die "Error in command line arguments.\n";
+
+if (!defined $cpanm) {
+  $cpanm = `which cpanm`;
+  chomp $cpanm;
+}
+
+die "can't find cpanm!\n"
+  unless $cpanm && -e $cpanm;
+
+my @libs = do {
+  my @incs = `"$^X" -le"print for \@INC"`;
+  chomp @incs;
+  my %inc = map +($_ => 1), @incs;
+  grep !$inc{$_}, 'lib', @INC;
+};
+
+my @opts;
+push @opts, 'disable-metadb'
+  if $disable_metadb;
+push @opts, 'debug'
+  if $debug;
+
+exec
+  "$^X",
+  (map "-I$_", @libs),
+  "-MMetaCPAN::V0Shim::cpanm_hook".(@opts ? '='.join(',', @opts) : ''),
+  $cpanm,
+  @ARGV;
+

cpanfile

@@ -11,3 +11,4 @@ requires 'Plack::Middleware::SimpleLogger';
 requires 'WWW::Form::UrlEncoded';
 requires 'HTTP::Request::Common';
 requires 'Plack::Test';
+requires 'LWP::Protocol::PSGI';

lib/MetaCPAN/V0Shim/cpanm_hook.pm

@@ -0,0 +1,43 @@
+package MetaCPAN::V0Shim::cpanm_hook;
+use strict;
+use warnings;
+
+use LWP::Protocol::PSGI;
+use MetaCPAN::V0Shim;
+use Plack::Builder;
+
+my @hooks;
+
+sub import {
+  my ($class, @opts) = @_;
+  my %opts = map +($_ => 1), @opts;
+  my $shim = MetaCPAN::V0Shim->new(
+    ($opts{debug} ? (debug => 1) : ()),
+  )->to_app;
+
+  $shim = builder {
+    if ($opts{debug}) {
+      enable sub {
+        my $app = shift;
+        return sub {
+          my ($env) = @_;
+          $env->{'psgi.errors'} = \*STDERR;
+          $app->($env);
+        };
+      };
+    }
+    enable 'SimpleLogger', level => 'debug';
+    mount '/v0' => $shim;
+    mount '/' => $shim;
+  };
+  push @hooks, LWP::Protocol::PSGI->register($shim, host => 'api.metacpan.org');
+  if ($opts{'disable-metadb'}) {
+    push @hooks, LWP::Protocol::PSGI->register(sub { [500, [], [''] ] }, host => 'cpanmetadb.plackperl.org');
+  }
+}
+
+sub unimport {
+  @hooks = ();
+}
+
+1;