cpanm

#!/usr/bin/env perl
# DO NOT EDIT -- this is an auto generated file
use strict;
# App::cpanminus::script 0.991 (auto embedded by script/build.PL)
package App::cpanminus::script;
use strict;
use Config;
use Cwd ();
use File::Basename ();
use File::Path ();
use File::Spec ();
use File::Copy ();
use Getopt::Long ();

use constant WIN32 => $^O eq 'MSWin32';
use constant PLUGIN_API_VERSION => 0.1;

our $VERSION = "0.9910";
$VERSION = eval $VERSION;

my $quote = WIN32 ? q/"/ : q/'/;

sub new {
    my $class = shift;

    bless {
        home => "$ENV{HOME}/.cpanm",
        cmd  => 'install',
        seen => {},
        notest => undef,
        installdeps => undef,
        force => undef,
        sudo => undef,
        make  => undef,
        verbose => undef,
        quiet => undef,
        interactive => undef,
        log => undef,
        mirrors => [],
        perl => $^X,
        argv => [],
        hooks => {},
        plugins => [],
        local_lib => undef,
        configure_timeout => 60,
        build_timeout => 60 * 10,
        test_timeout  => 60 * 10,
        @_,
    }, $class;
}

sub env {
    my($self, $key) = @_;
    $ENV{"PERL_CPANM_" . $key} || $ENV{"CPANMINUS_" . $key};
}

sub parse_options {
    my $self = shift;

    local @ARGV = @{$self->{argv}};
    push @ARGV, split /\s+/, $self->env('OPT');
    push @ARGV, @_;

    if ($0 ne '-' && !-t STDIN){ # e.g. $ cpanm < author/requires.cpanm
        push @ARGV, $self->load_argv_from_fh(\*STDIN);
    }

    Getopt::Long::Configure("bundling");
    Getopt::Long::GetOptions(
        'f|force'  => \$self->{force},
        'n|notest' => \$self->{notest},
        'S|sudo'   => \$self->{sudo},
        'v|verbose' => sub { $self->{verbose} = $self->{interactive} = 1 },
        'q|quiet'   => \$self->{quiet},
        'h|help'    => sub { $self->{action} = 'help' },
        'V|version' => sub { $self->{action} = 'version' },
        'perl=s'    => \$self->{perl},
        'l|local-lib=s' => \$self->{local_lib},
        'recent'    => sub { $self->{action} = 'show_recent' },
        'list-plugins' => sub { $self->{action} = 'list_plugins' },
        'installdeps' => \$self->{installdeps},
        'skip-installed' => \$self->{skip_installed},
        'interactive' => \$self->{interactive},
        'i|install' => sub { $self->{cmd} = 'install' },
        'look'      => sub { $self->{cmd} = 'look' },
        'info'      => sub { $self->{cmd} = 'info' },
        'self-upgrade' => sub { $self->{cmd} = 'install'; $self->{argv} = [ 'App::cpanminus' ] },
        'disable-plugins' => \$self->{disable_plugins},
        'no-lwp'    => \$self->{no_lwp},
    );

    $self->{argv} = \@ARGV;
}

sub init {
    my $self = shift;

    $self->setup_home;
    $self->load_plugins;
    $self->bootstrap;

    $self->{make} = $self->which($Config{make});
    $self->init_tools;

    if (@{$self->{bootstrap_deps} || []}) {
        $self->configure_mirrors;
        local $self->{force} = 1; # to force install EUMM
        $self->install_deps($self->{base}, 0, @{$self->{bootstrap_deps}});
    }
}

sub doit {
    my $self = shift;

    $self->init;
    $self->configure_mirrors;

    if (my $action = $self->{action}) {
        $self->$action() and return;
    }

    $self->help(1) unless @{$self->{argv}};

    for my $module (@{$self->{argv}}) {
        $self->install_module($module, 0);
    }

    $self->run_hooks(finalize => {});
}

sub setup_home {
    my $self = shift;

    $self->{home} = $self->env('HOME') if $self->env('HOME');

    $self->{base} = "$self->{home}/work/" . time . ".$$";
    $self->{plugin_dir} = "$self->{home}/plugins";
    File::Path::mkpath([ $self->{base}, $self->{plugin_dir} ], 0, 0777);

    my $link = "$self->{home}/latest-build";
    eval { unlink $link; symlink $self->{base}, $link };

    $self->{log} = File::Spec->catfile($self->{home}, "build.log"); # because we use shell redirect

    {
        my $log = $self->{log}; my $base = $self->{base};
        $self->{at_exit} = sub { File::Copy::copy($log, "$base/build.log") };
    }

    open my $out, ">$self->{log}" or die "$self->{log}: $!";
    print $out "cpanm (App::cpanminus) $VERSION on perl $] built for $Config{archname}\n";
    print $out "Work directory is $self->{base}\n";
}

sub register_core_hooks {
    my $self = shift;

    $self->hook('core', search_module => sub {
        my $args = shift;
        push @{$args->{uris}}, sub {
            $self->chat("Searching $args->{module} on search.cpan.org ...\n");
            my $uri  = "http://search.cpan.org/perldoc?$args->{module}";
            my $html = $self->get($uri);
            $html =~ m!<a href="/CPAN/authors/id/(.*?\.(?:tar\.gz|tgz|tar\.bz2|zip))">!
                and return $self->cpan_uri($1);
            $self->diag("! Finding $args->{module} on search.cpan.org failed.\n");
            return;
        };
    });

    $self->hook('core', show_recent => sub {
        my $args = shift;

        $self->chat("Fetching recent feed from search.cpan.org ...\n");
        my $feed = $self->get("http://search.cpan.org/uploads.rdf");

        my @dists;
        while ($feed =~ m!<link>http://search\.cpan\.org/~([a-z_\-0-9]+)/(.*?)/</link>!g) {
            my($pause_id, $dist) = (uc $1, $2);
            # FIXME Yes, it doesn't always have to be 'tar.gz'
            push @dists, substr($pause_id, 0, 1) . "/" . substr($pause_id, 0, 2) . "/" . $pause_id . "/$dist.tar.gz";
            last if @dists >= 50;
        }

        return \@dists;
    });
}

sub load_plugins {
    my $self = shift;

    $self->_load_plugins;
    $self->register_core_hooks;

    for my $hook (keys %{$self->{hooks}}) {
        $self->{hooks}->{$hook} = [ sort { $a->[0] <=> $b->[0] } @{$self->{hooks}->{$hook}} ];
    }

    $self->run_hooks(init => {});
}

sub _load_plugins {
    my $self = shift;
    return if $self->{disable_plugins};
    return unless $self->{plugin_dir} && -e $self->{plugin_dir};

    opendir my $dh, $self->{plugin_dir} or return;
    my @plugins;
    while (my $e = readdir $dh) {
        my $f = "$self->{plugin_dir}/$e";
        next unless -f $f && $e =~ /^[A-Za-z0-9_]+$/ && $e ne 'README';
        push @plugins, [ $f, $e ];
    }

    for my $plugin (sort { $a->[1] <=> $b->[1] } @plugins) {
        $self->load_plugin(@$plugin);
    }
}

sub load_plugin {
    my($self, $file, $name) = @_;

    # TODO remove this once plugin API is official
    unless ($self->env('DEV')) {
        $self->chat("! Found plugin $file but PERL_CPANM_DEV is not set. Skipping.\n");
        return;
    }

    $self->chat("Loading plugin $file\n");

    my $plugin = { name => $name, file => $file };
    my @attr   = qw( name description author version synopsis );
    my $dsl    = join "\n", map "sub $_ { \$plugin->{$_} = shift }", @attr;

    (my $package = $file) =~ s/[^a-zA-Z0-9_]/_/g;
    my $code = do { open my $io, "<$file"; local $/; <$io> };

    my $api_version = PLUGIN_API_VERSION;

    my @hooks;
    eval "package App::cpanplus::plugin::$package;\n".
        "use strict;\n$dsl\n" .
        'sub api_version { die "API_COMPAT: $_[0]" if $_[0] < $api_version }' . "\n" .
        "sub hook { push \@hooks, [\@_] };\n$code";

    if ($@ =~ /API_COMPAT: (\S+)/) {
        $self->diag("! $plugin->{name} plugin API version is outdated ($1 < $api_version) and needs an update.\n");
        return;
    } elsif ($@) {
        $self->diag("! Loading $name plugin failed. See $self->{log} for details.\n");
        $self->chat($@);
        return;
    }

    for my $hook (@hooks) {
        $self->hook($plugin->{name}, @$hook);
    }

    push @{$self->{plugins}}, $plugin;
}

sub load_argv_from_fh {
    my($self, $fh) = @_;

    my @argv;
    while(defined(my $line = <$fh>)){
        chomp $line;
        $line =~ s/#.+$//; # comment
        $line =~ s/^\s+//; # trim spaces
        $line =~ s/\s+$//; # trim spaces

        push @argv, split ' ', $line if $line;
    }
    return @argv;
}

sub hook {
    my $cb = pop;
    my($self, $name, $hook, $order) = @_;
    $order = 50 unless defined $order;
    push @{$self->{hooks}->{$hook}}, [ $order, $cb, $name ];
}

sub run_hook {
    my($self, $hook, $args) = @_;
    $self->run_hooks($hook, $args, 1);
}

sub run_hooks {
    my($self, $hook, $args, $first) = @_;
    $args->{app} = $self;
    my $res;
    for my $plugin (@{$self->{hooks}->{$hook} || []}) {
        $res = eval { $plugin->[1]->($args) };
        $self->chat("Running hook '$plugin->[2]' error: $@") if $@;
        last if $res && $first;
    }

    return $res;
}

sub version {
    print "cpanm (App::cpanminus) version $VERSION\n";
    return 1;
}

sub help {
    my $self = shift;

    if ($_[0]) {
        die <<USAGE;
Usage: cpanm [options] Module [...]

Try `cpanm --help` for more options.
USAGE
    }

    print <<HELP;
Usage: cpanm [options] Module [...]

Options:
  -v,--verbose       Turns on chatty output
  --interactive      Turns on interactive configure (required for Task:: modules)
  -f,--force         force install
  -n,--notest        Do not run unit tests
  -S,--sudo          sudo to run install commands
  --installdeps      Only install dependencies
  --disable-plugins  Disable plugin loading

Commands:
  --self-upgrade     upgrades itself
  --look             Download the tarball and open the directory with your shell
  --info             Displays distribution info on CPAN
  --recent           Show recently updated modules

Examples:

  cpanm CGI                                                 # install CGI
  cpanm MIYAGAWA/Plack-0.99_05.tar.gz                       # full distribution name
  cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz           # install from URL
  cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz            # install from a local file
  cpanm --interactive Task::Kensho                          # Configure interactively
  cpanm .                                                   # install from local directory
  cpanm --installdeps .                                     # install all the deps for the current directory

HELP

    return 1;
}

sub bootstrap {
    my $self = shift;

    # If -l is specified, use that.
    if ($self->{local_lib}) {
        return $self->_try_local_lib($self->{local_lib});
    }

    # root, locally-installed perl or --sudo: don't care about install_base
    return if $self->{sudo} or (-w $Config{installsitelib} and -w $Config{installsitebin});

    # local::lib is configured in the shell -- yay
    return if $ENV{PERL_MM_OPT} and ($ENV{MODULEBUILDRC} or $ENV{PERL_MB_OPT});

    $self->_try_local_lib;

    $self->diag(<<DIAG);
!
! Can't write to $Config{installsitelib} and $Config{installsitebin}: Installing modules to $ENV{HOME}/perl5
! To turn off this warning, you have 3 options:
!   - run me as a root or with --sudo option (to install to $Config{installsitelib} and $Config{installsitebin})
!   - Configure local::lib in your shell to set PERL_MM_OPT etc.
!   - Set PERL_CPANM_OPT="--local-lib=~/perl5" in your shell
!
DIAG
    sleep 2;
}

sub _try_local_lib {
    my($self, $base) = @_;

    my $bootstrap;
    eval    { require local::lib };
    if ($@) { $self->_bootstrap_local_lib; $bootstrap = 1 };

    # TODO -L option should remove PERL5LIB here
    { local $0 = 'cpanm'; local::lib->import($base || "~/perl5") };

    if ($bootstrap) {
        push @{$self->{bootstrap_deps}},
            'ExtUtils::MakeMaker' => 6.31,
            'ExtUtils::Install'   => 1.43;
    }
}

# XXX Installing local::lib using cpanm causes CPAN.pm configuration
# as of 1.4.9, so avoid that until it can be bypassed
sub _bootstrap_local_lib {
    my $self = shift;
    $self->_require('local::lib');
}

sub _require {
    my($self, $module) = @_;

    $self->{_embed_cache} ||= do {
        my($cache, $curr);
        while (<::DATA>) {
            if (/^# CPANM_EMBED_BEGIN (\S+)/)  { $curr = $1 }
            elsif (/^# CPANM_EMBED_END (\S+)/) { $curr = undef }
            elsif ($curr) {
                $cache->{$curr} .= $_;
            }
        }
        $cache || {};
    };

    eval $self->{_embed_cache}{$module};
}

sub diag {
    my $self = shift;
    print STDERR @_ if $self->{verbose} or !$self->{quiet};
    $self->log(@_);
}

sub chat {
    my $self = shift;
    print STDERR @_ if $self->{verbose};
    $self->log(@_);
}

sub log {
    my $self = shift;
    open my $out, ">>$self->{log}";
    print $out @_;
}

sub run {
    my($self, $cmd) = @_;
    unless ($self->{verbose}) {
        $cmd .= " >> " . $self->shell_quote($self->{log}) . " 2>&1";
    }
    !system $cmd;
}

sub run_exec {
    my($self, $cmd) = @_;
    unless ($self->{verbose}) {
        $cmd .= " >> " . $self->shell_quote($self->{log}) . " 2>&1";
    }
    exec $cmd;
    return;
}

sub run_timeout {
    my($self, $cmd, $timeout) = @_;
    return $self->run($cmd) if WIN32 || $self->{verbose};

    my $pid = fork;
    if ($pid) {
        eval {
            local $SIG{ALRM} = sub { die "alarm\n" };
            alarm $timeout;
            waitpid $pid, 0;
            alarm 0;
        };
        if ($@ && $@ eq "alarm\n") {
            $self->diag("Timed out (> ${timeout}s). Use --verbose to retry. ");
            local $SIG{TERM} = 'IGNORE';
            kill TERM => 0;
            waitpid $pid, 0;
            return;
        }
        return !$?;
    } elsif ($pid == 0) {
        $self->run_exec($cmd);
    } else {
        $self->chat("! fork failed: falling back to system()\n");
        $self->run($cmd);
    }
}

sub configure {
    my($self, $cmd) = @_;

    # trick AutoInstall
    local $ENV{PERL5_CPAN_IS_RUNNING} = $ENV{PERL5_CPANPLUS_IS_RUNNING} = 1;

    my $use_default = !$self->{interactive};
    local $ENV{PERL_MM_USE_DEFAULT} = $use_default;

    local $self->{verbose} = $self->{interactive};
    $self->run_timeout($cmd, $self->{configure_timeout});
}

sub build {
    my($self, $cmd) = @_;
    $self->run_timeout($cmd, $self->{build_timeout});
}

sub test {
    my($self, $cmd) = @_;
    return 1 if $self->{notest};
    return $self->run_timeout($cmd,  $self->{test_timeout}) || $self->{force};
}

sub install {
    my($self, $cmd) = @_;
    $cmd = "sudo $cmd" if $self->{sudo};
    $self->run($cmd);
}

sub chdir {
    my $self = shift;
    chdir(File::Spec->canonpath($_[0])) or die "$_[0]: $!";
}

sub configure_mirrors {
    my $self = shift;

    my @mirrors;
    $self->run_hook(configure_mirrors => { mirrors => \@mirrors });

    @mirrors = ('http://search.cpan.org/CPAN') unless @mirrors;
    $self->{mirrors} = \@mirrors;
}

sub show_recent {
    my $self = shift;

    my $dists = $self->run_hook(show_recent => {});
    for my $dist (@$dists) {
        print $dist, "\n";
    }

    return 1;
}

sub list_plugins {
    my $self = shift;

    for my $plugin (@{$self->{plugins}}) {
        print "$plugin->{name} - $plugin->{description}\n";
    }

    return 1;
}

sub self_upgrade {
    my $self = shift;
    $self->{argv} = [ 'App::cpanminus' ];
    return; # continue
}

sub install_module {
    my($self, $module, $depth) = @_;

    if ($self->{seen}{$module}++) {
        $self->diag("Already tried $module. Skipping.\n");
        return;
    }

    # FIXME return richer data strture including version number here
    # so --skip-installed option etc. can skip it
    my $dir = $self->fetch_module($module);

    return if $self->{cmd} eq 'info';

    unless ($dir) {
        $self->diag("! Couldn't find module or a distribution $module\n");
        return;
    }

    if ($self->{seen}{$dir}++) {
        $self->diag("Already built the distribution $dir. Skipping.\n");
        return;
    }

    $self->chat("Entering $dir\n");
    $self->chdir($self->{base});
    $self->chdir($dir);

    if ($self->{cmd} eq 'look') {
        my $shell = $ENV{SHELL};
        $shell  ||= $ENV{COMSPEC} if WIN32;
        if ($shell) {
            $self->diag("Entering $dir with $shell\n");
            system $shell;
        } else {
            $self->diag("! You don't seem to have a SHELL :/\n");
        }
    } else {
        $self->build_stuff($module, $dir, $depth);
    }
}

sub generator_cb {
    my($self, $ref) = @_;

    $ref = [ $ref ] unless ref $ref eq 'ARRAY';

    my @stack;
    return sub {
        if (@stack) {
            return shift @stack;
        }

        return -1 unless @$ref;
        my $curr = (shift @$ref)->();
        if (ref $curr eq 'ARRAY') {
            @stack = @$curr;
            return shift @stack;
        } else {
            return $curr;
        }
    };
}

sub fetch_module {
    my($self, $module) = @_;

    my($uris, $local_dir) = $self->locate_dist($module);

    return $local_dir if $local_dir;
    return unless $uris;

    my $iter = $self->generator_cb($uris);

    while (1) {
        my $uri = $iter->();
        last if $uri == -1;
        next unless $uri;

        # Yikes this is dirty
        if ($self->{cmd} eq 'info') {
            $uri =~ s!.*authors/id/!!;
            print $uri, "\n";
            return;
        }

        if ($uri =~ m{/perl-5}){
            $self->diag("skip $uri\n");
            next;
        }

        $self->chdir($self->{base});
        $self->diag("Fetching $uri ... ");

        my $name = File::Basename::basename $uri;

        my $cancelled;
        my $fetch = sub {
            my $file;
            eval {
                local $SIG{INT} = sub { $cancelled = 1; die "SIGINT\n" };
                $self->mirror($uri, $name);
                $file = $name if -e $name;
            };
            $self->chat("$@") if $@ && $@ ne "SIGINT\n";
            return $file;
        };

        my($try, $file);
        while ($try++ < 3) {
            $file = $fetch->();
            last if $cancelled or $file;
            $self->diag("FAIL\nDownload $uri failed. Retrying ... ");
        }

        if ($cancelled) {
            $self->diag("\n! Download cancelled.\n");
            return;
        }

        unless ($file) {
            $self->diag("FAIL\n! Failed to download $uri\n");
            next;
        }

        $self->diag("OK\n");

        # TODO add more metadata so plugins can tell how to verify and pass through
        my $args = { file => $file, uri => $uri, fail => 0 };
        $self->run_hooks(verify_archive => $args);

        if ($args->{fail} && !$self->{force}) {
            $self->diag("! Verifying the archive $file failed. Skipping. (use --force to install)\n");
            next;
        }

        $self->chat("Unpacking $file\n");

        my $dir = $file =~ /\.zip/i ? $self->unzip($file) : $self->untar($file);
        unless ($dir) {
            $self->diag("! Failed to unpack $name: no directory\n");
            next;
        }

        return $dir;
    }
}

sub locate_dist {
    my($self, $module) = @_;

    if (my $located = $self->run_hook(locate_dist => { module => $module })) {
        return ref $located eq 'ARRAY' ? @$located :
               ref $located eq 'CODE'  ? $located  : sub { $located };
    }

    # URL
    return sub { $module } if $module =~ /^(ftp|https?|file):/;

    # Directory
    return undef, Cwd::abs_path($module) if -e $module && -d _;

    # File
    return sub { "file://" . Cwd::abs_path($module) } if -f $module;

    # cpan URI
    $module =~ s!^cpan:///distfile/!!;

    # PAUSEID/foo
    $module =~ s!^([A-Z]{3,})/!substr($1, 0, 1)."/".substr($1, 0, 2) ."/" . $1 . "/"!e;

    # CPAN tarball
    return sub { $self->cpan_uri($module) } if $module =~ m!^[A-Z]/[A-Z]{2}/!;

    # Module name -- search.cpan.org
    return $self->search_module($module);
}

sub cpan_uri {
    my($self, $dist) = @_;

    my @mirrors = @{$self->{mirrors}};
    my @urls    = map "$_/authors/id/$dist", @mirrors;

    return wantarray ? @urls : $urls[int(rand($#urls))];
}

sub search_module {
    my($self, $module) = @_;

    my @cbs;
    $self->run_hooks(search_module => { module => $module, uris => \@cbs });

    return \@cbs;
}

sub check_module {
    my($self, $mod, $ver) = @_;

    $ver = '' if $ver == 0;
    my $test = `$self->{perl} -e ${quote}eval q{use $mod $ver (); print q{OK:}, $mod\::->VERSION};print \$\@ if \$\@${quote}`;
    if ($test =~ s/^\s*OK://) {
        $self->{local_versions}{$mod} = $test;
        return 1, $test;
    } elsif ($test =~ /^Can't locate|required--this is only version (\S+)/) {
        $self->{local_versions}{$mod} = $1;
        return 0, $1;
    } else {
        return 0, undef, $test;
    }
}

sub should_install {
    my($self, $mod, $ver) = @_;

    $self->chat("Checking if you have $mod $ver ... ");
    my($ok, $local, $err) = $self->check_module($mod, $ver);

    if ($err) {
        $self->chat("Unknown ($err)\n");
        return;
    }

    if ($ok)       { $self->chat("Yes ($local)\n") }
    elsif ($local) { $self->chat("No ($local < $ver)\n") }
    else           { $self->chat("No\n") }

    return $mod unless $ok;
    return;
}

sub install_deps {
    my($self, $dir, $depth, %deps) = @_;

    my @install;
    while (my($mod, $ver) = each %deps) {
        next if $mod eq 'perl' or $mod eq 'Config';
        push @install, $self->should_install($mod, $ver);
    }

    if (@install) {
        $self->diag("==> Found dependencies: ", join(", ", @install), "\n");
    }

    for my $mod (@install) {
        $self->install_module($mod, $depth + 1);
    }

    $self->chdir($self->{base});
    $self->chdir($dir) if $dir;
}

sub build_stuff {
    my($self, $module, $dir, $depth) = @_;

    my $args = { module => $module, dir => $dir };
    $self->run_hooks(verify_dist => $args);

    if ($args->{fail} && !$self->{force}) {
        $self->diag("! Verifying the module $module failed. Skipping. (use --force to install)\n");
        return;
    }

    my($meta, @config_deps);
    if (-e 'META.yml') {
        $self->chat("Checking configure dependencies from META.yml ...\n");
        $meta = $self->parse_meta('META.yml');
        push @config_deps, %{$meta->{configure_requires} || {}};
    }

    # TODO yikes, $module doesn't always have to be CPAN module
    # TODO extract/fetch meta info earlier so you don't need to download tarballs
    if ($depth == 0 && $meta->{version} && $module =~ /^[a-zA-Z0-9_:]+$/) {
        my($ok, $local, $err) = $self->check_module($module, $meta->{version});
        if ($self->{skip_installed} && $ok) {
            $self->diag("$module is up to date. ($local)\n");
            return;
        }
    }

    $self->run_hooks(pre_configure => { meta => $meta, deps => \@config_deps });

    $self->install_deps($dir, $depth, @config_deps);

    my $target = $meta->{name} ? "$meta->{name}-$meta->{version}" : $dir;
    $self->diag("Configuring $target ... ");

    my($use_module_build, $configured, $configured_ok);
    if (-e 'Makefile.PL') {
        local $ENV{X_MYMETA} = 'YAML';

        # NOTE: according to Devel::CheckLib, most XS modules exit
        # with 0 even if header files are missing, to avoid receiving
        # tons of FAIL reports in such cases. So exit code can't be
        # trusted if it went well.
        if ($self->configure("$self->{perl} Makefile.PL")) {
            $configured_ok = -e 'Makefile';
        }
        $configured++;
    }

    if ((!$self->{make} or !$configured_ok) and -e 'Build.PL') {
        if ($self->configure("$self->{perl} Build.PL")) {
            $configured_ok = -e 'Build' && -f _;
        }
        $use_module_build++;
        $configured++;
    }

    my %deps;
    if (-e 'MYMETA.yml') {
        $self->chat("Checking dependencies from MYMETA.yml ...\n");
        $meta = $self->parse_meta('MYMETA.yml');
        %deps = (%{$meta->{requires} || {}});
        unless ($self->{notest}) {
            %deps = (%deps, %{$meta->{build_requires} || {}}, %{$meta->{test_requires} || {}});
        }
    }

    if (-e 'Makefile') {
        $self->chat("Finding PREREQ from Makefile ...\n");
        open my $mf, "Makefile";
        while (<$mf>) {
            if (/^\#\s+PREREQ_PM => ({.*?})/) {
                no strict; # WTF bareword keys
                my $prereq = eval "+$1";
                %deps = (%deps, %$prereq) if $prereq;
                last;
            }
        }
    }

    $self->diag($configured_ok ? "OK\n" : "N/A\n");

    $self->run_hooks(find_deps => { deps => \%deps, module => $module, meta => $meta });

    $self->install_deps($dir, $depth, %deps);

    if ($self->{installdeps} && $depth == 0) {
        $self->diag("<== Installed dependencies for $module. Finishing.\n");
        return 1;
    }

    my $installed;
    if ($use_module_build && -e 'Build' && -f _) {
        $self->diag("Building ", ($self->{notest} ? "" : "and testing "), "$target for $module ... ");
        $self->build("$self->{perl} ./Build") &&
        $self->test("$self->{perl} ./Build test") &&
        $self->install("$self->{perl} ./Build install") &&
        $installed++;
    } elsif ($self->{make} && -e 'Makefile') {
        $self->diag("Building ", ($self->{notest} ? "" : "and testing "), "$target for $module ... ");
        $self->build("$self->{make}") &&
        $self->test("$self->{make} test") &&
        $self->install("$self->{make} install") &&
        $installed++;
    } else {
        my $why;
        if ($configured && !$configured_ok) { $why = "Configure failed on $dir." }
        elsif ($self->{make})               { $why = "The distribution doesn't have a proper Makefile.PL/Build.PL" }
        else                                { $why = "Can't configure the distribution. You probably need to have 'make'." }

        $self->diag("! $why See $self->{log} for details.\n");
        $self->run_hooks(configure_failure => { module => $module, build_dir => $dir, meta => $meta });
        return;
    }

    # TODO calculate this earlier and put it in the stash
    my $distname = $meta->{name} ? "$meta->{name}-$meta->{version}" : $module;

    if ($installed) {
        my $local = $self->{local_versions}{$module};
        my $reinstall = $local && $local eq $meta->{version};

        my $how = $reinstall ? "reinstalled $distname"
                : $local     ? "installed $distname (upgraded from $local)"
                             : "installed $distname" ;
        my $msg = "Successfully $how";
        $self->diag("OK\n$msg\n");
        $self->run_hooks(install_success => {
            module => $module, build_dir => $dir, meta => $meta,
            local => $local, reinstall => $reinstall, depth => $depth,
            message => $msg, dist => $distname
        });
        return 1;
    } else {
        my $msg = "Building $distname failed";
        $self->diag("FAIL\n! Installing $module failed. See $self->{log} for details.\n");
        $self->run_hooks(build_failure => {
            module => $module, build_dir => $dir, meta => $meta,
            message => $msg, dist => $distname,
        });
        return;
    }
}

sub DESTROY {
    my $self = shift;
    $self->{at_exit}->($self) if $self->{at_exit};
}

# Utils

sub shell_quote {
    my($self, $stuff) = @_;
    $quote . $stuff . $quote;
}

sub which {
    my($self, $name) = @_;
    my $exe_ext = $Config{_exe};
    for my $dir (File::Spec->path) {
        my $fullpath = File::Spec->catfile($dir, $name);
        if (-x $fullpath || -x ($fullpath .= $exe_ext)) {
            if ($fullpath =~ /\s/ && $fullpath !~ /^$quote/) {
                $fullpath = $self->shell_quote($fullpath);
            }
            return $fullpath;
        }
    }
    return;
}

sub get      { shift->{_backends}{get}->(@_) };
sub mirror   { shift->{_backends}{mirror}->(@_) };
sub redirect { shift->{_backends}{redirect}->(@_) };
sub untar    { shift->{_backends}{untar}->(@_) };
sub unzip    { shift->{_backends}{unzip}->(@_) };

sub file_get {
    my($self, $uri) = @_;
    open my $fh, "<$uri" or return;
    join '', <$fh>;
}

sub file_mirror {
    my($self, $uri, $path) = @_;
    File::Copy::copy($uri, $path);
}

sub init_tools {
    my $self = shift;

    # use --no-lwp if they have a broken LWP, to upgrade LWP
    if (!$self->{no_lwp} && eval { require LWP::UserAgent }) {
        $self->{_backends}{get} = sub {
            my $self = shift;
            my $ua = LWP::UserAgent->new(parse_head => 0, env_proxy => 1);
            $ua->request(HTTP::Request->new(GET => $_[0]))->decoded_content;
        };
        $self->{_backends}{mirror} = sub {
            my $self = shift;
            my $ua = LWP::UserAgent->new(parse_head => 0, env_proxy => 1);
            my $res = $ua->mirror(@_);
            $res->code;
        };
        $self->{_backends}{redirect} = sub {
            my $self = shift;
            my $ua   = LWP::UserAgent->new(parse_head => 0, max_redirect => 1, env_proxy => 1);
            my $res  = $ua->simple_request(HTTP::Request->new(GET => $_[0]));
            return $res->header('Location') if $res->is_redirect;
            return;
        };
    } elsif (my $wget = $self->which('wget')) {
        $self->{_backends}{get} = sub {
            my($self, $uri) = @_;
            return $self->file_get($uri) if $uri =~ s!^file:/+!/!;
            my $q = $self->{verbose} ? '' : '-q';
            open my $fh, "$wget $uri $q -O - |" or die "wget $uri: $!";
            local $/;
            <$fh>;
        };
        $self->{_backends}{mirror} = sub {
            my($self, $uri, $path) = @_;
            return $self->file_mirror($uri, $path) if $uri =~ s!^file:/+!/!;
            my $q = $self->{verbose} ? '' : '-q';
            system "$wget $uri $q -O $path";
        };
        $self->{_backends}{redirect} = sub {
            my($self, $uri) = @_;
            my $out = `$wget --max-redirect=0 $uri 2>&1`;
            if ($out =~ /^Location: (\S+)/m) {
                return $1;
            }
            return;
        };
    } elsif (my $curl = $self->which('curl')) {
        $self->{_backends}{get} = sub {
            my($self, $uri) = @_;
            return $self->file_get($uri) if $uri =~ s!^file:/+!/!;
            my $q = $self->{verbose} ? '' : '-s';
            open my $fh, "$curl -L $q $uri |" or die "curl $uri: $!";
            local $/;
            <$fh>;
        };
        $self->{_backends}{mirror} = sub {
            my($self, $uri, $path) = @_;
            return $self->file_mirror($uri, $path) if $uri =~ s!^file:/+!/!;
            my $q = $self->{verbose} ? '' : '-s';
            system "$curl -L $uri $q -# -o $path";
        };
        $self->{_backends}{redirect} = sub {
            my($self, $uri) = @_;
            my $out = `$curl -I -s $uri 2>&1`;
            if ($out =~ /^Location: (\S+)/m) {
                return $1;
            }
            return;
        };
    } else {
        eval    { require HTTP::Lite };
        if ($@) { $self->_require('HTTP::Lite') }

        my $http_cb = sub {
            my($uri, $redir, $cb_gen) = @_;

            my $http = HTTP::Lite->new;

            my($data_cb, $done_cb) = $cb_gen ? $cb_gen->() : ();
            my $req = $http->request($uri, $data_cb);
            $done_cb->($req) if $done_cb;

            my $redir_count;
            while ($req == 302 or $req == 301)  {
                last if $redir_count++ > 5;
                my $loc;
                for ($http->headers_array) {
                    /Location: (\S+)/ and $loc = $1, last;
                }
                $loc or last;
                if ($loc =~ m!^/!) {
                    $uri =~ s!^(\w+?://[^/]+)/.*$!$1!;
                    $uri .= $loc;
                } else {
                    $uri = $loc;
                }

                return $uri if $redir;

                my($data_cb, $done_cb) = $cb_gen ? $cb_gen->() : ();
                $req = $http->request($uri, $data_cb);
                $done_cb->($req) if $done_cb;
            }

            return if $redir;
            return ($http, $req);
        };


        $self->{_backends}{get} = sub {
            my($self, $uri) = @_;
            return $self->file_get($uri) if $uri =~ s!^file:/+!/!;
            my($http, $req) = $http_cb->($uri);
            return $http->body;
        };

        $self->{_backends}{mirror} = sub {
            my($self, $uri, $path) = @_;
            return $self->file_mirror($uri, $path) if $uri =~ s!^file:/+!/!;

            my($http, $req) = $http_cb->($uri, undef, sub {
                open my $out, ">$path" or die "$path: $!";
                binmode $out;
                sub { print $out ${$_[1]} }, sub { close $out };
            });

            return $req;
        };

        $self->{_backends}{redirect} = sub {
            my($self, $uri) = @_;
            return $http_cb->($uri, 1);
        };
    }

    if (my $tar = $self->which('tar')) {
        $self->{_backends}{untar} = sub {
            my($self, $tarfile) = @_;

            my $xf = "xf" . ($self->{verbose} ? 'v' : '');
            my $ar = $tarfile =~ /bz2$/ ? 'j' : 'z';

            my($root, @others) = `$tar tf$ar $tarfile`
                or return undef;

            chomp $root;
            $root =~ s{^(.+)/[^/]*$}{$1};

            system "$tar $xf$ar $tarfile";
            return $root if -d $root;

            $self->diag("! Bad archive: $tarfile\n");
            return undef;
        }
    } elsif (eval { require Archive::Tar }) { # uses too much memory!
        $self->{_backends}{untar} = sub {
            my $self = shift;
            my $t = Archive::Tar->new($_[0]);
            my $root = ($t->list_files)[0];
            $t->extract;
            return -d $root ? $root : undef;
        };
    } else {
        $self->{_backends}{untar} = sub {
            die "Failed to extract $_[1] - You need to have tar or Archive::Tar installed.\n";
        };
    }

    if (my $unzip = $self->which('unzip')) {
        $self->{_backends}{unzip} = sub {
            my($self, $zipfile) = @_;

            my $opt = $self->{verbose} ? '' : '-q';
            my(undef, $root, @others) = `$unzip -t $zipfile`
                or return undef;

            chomp $root;
            $root =~ s{^\s+testing:\s+(.+?)/\s+OK$}{$1};

            system "$unzip $opt $zipfile";
            return $root if -d $root;

            $self->diag("! Bad archive: [$root] $zipfile\n");
            return undef;
        }
    } elsif (eval { require Archive::Zip }) {
        $self->{_backends}{unzip} = sub {
            my($self, $file) = @_;
            my $zip = Archive::Zip->new();
            my $status;
            $status = $zip->read($file);
            $self->diag("Read of file[$file] failed\n")
                if $status != Archive::Zip::AZ_OK();
            my @members = $zip->members();
            my $root;
            for my $member ( @members ) {
                my $af = $member->fileName();
                next if ($af =~ m!^(/|\.\./)!);
                $root = $af unless $root;
                $status = $member->extractToFileNamed( $af );
                $self->diag("Extracting of file[$af] from zipfile[$file failed\n") if $status != Archive::Zip::AZ_OK();
            }
            return -d $root ? $root : undef;
        };
    } else {
        $self->{_backends}{unzip} = sub {
            die "Failed to extract $_[1] - You need to have unzip or Archive::Zip installed.\n";
        };
    }
}

sub parse_meta {
    my($self, $file) = @_;
    return eval { (Parse::CPAN::Meta::LoadFile($file))[0] } || {};
}

# Parse::CPAN::Meta 1.40 (auto embedded by script/build.PL)
package Parse::CPAN::Meta;

use strict;
use Carp 'croak';

# UTF Support?
sub HAVE_UTF8 () { $] >= 5.007003 }
BEGIN {
	if ( HAVE_UTF8 ) {
		# The string eval helps hide this from Test::MinimumVersion
		eval "require utf8;";
		die "Failed to load UTF-8 support" if $@;
	}

	# Class structure
	require 5.004;
	require Exporter;
	$Parse::CPAN::Meta::VERSION   = '1.40';
	@Parse::CPAN::Meta::ISA       = qw{ Exporter      };
	@Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile };
}

# Prototypes
sub LoadFile ($);
sub Load     ($);
sub _scalar  ($$$);
sub _array   ($$$);
sub _hash    ($$$);

# Printable characters for escapes
my %UNESCAPES = (
	z => "\x00", a => "\x07", t    => "\x09",
	n => "\x0a", v => "\x0b", f    => "\x0c",
	r => "\x0d", e => "\x1b", '\\' => '\\',
);





#####################################################################
# Implementation

# Create an object from a file
sub LoadFile ($) {
	# Check the file
	my $file = shift;
	croak('You did not specify a file name')            unless $file;
	croak( "File '$file' does not exist" )              unless -e $file;
	croak( "'$file' is a directory, not a file" )       unless -f _;
	croak( "Insufficient permissions to read '$file'" ) unless -r _;

	# Slurp in the file
	local $/ = undef;
	local *CFG;
	unless ( open( CFG, $file ) ) {
		croak("Failed to open file '$file': $!");
	}
	my $yaml = <CFG>;
	unless ( close(CFG) ) {
		croak("Failed to close file '$file': $!");
	}

	# Hand off to the actual parser
	Load( $yaml );
}

# Parse a document from a string.
# Doing checks on $_[0] prevents us having to do a string copy.
sub Load ($) {
	my $string = $_[0];
	unless ( defined $string ) {
		croak("Did not provide a string to load");
	}

	# Byte order marks
	if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
		croak("Stream has a non UTF-8 Unicode Byte Order Mark");
	} else {
		# Strip UTF-8 bom if found, we'll just ignore it
		$string =~ s/^\357\273\277//;
	}

	# Try to decode as utf8
	utf8::decode($string) if HAVE_UTF8;

	# Check for some special cases
	return () unless length $string;
	unless ( $string =~ /[\012\015]+\z/ ) {
		croak("Stream does not end with newline character");
	}

	# Split the file into lines
	my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
	            split /(?:\015{1,2}\012|\015|\012)/, $string;

	# Strip the initial YAML header
	@lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;

	# A nibbling parser
	my @documents = ();
	while ( @lines ) {
		# Do we have a document header?
		if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
			# Handle scalar documents
			shift @lines;
			if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
				push @documents, _scalar( "$1", [ undef ], \@lines );
				next;
			}
		}

		if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
			# A naked document
			push @documents, undef;
			while ( @lines and $lines[0] !~ /^---/ ) {
				shift @lines;
			}

		} elsif ( $lines[0] =~ /^\s*\-/ ) {
			# An array at the root
			my $document = [ ];
			push @documents, $document;
			_array( $document, [ 0 ], \@lines );

		} elsif ( $lines[0] =~ /^(\s*)\S/ ) {
			# A hash at the root
			my $document = { };
			push @documents, $document;
			_hash( $document, [ length($1) ], \@lines );

		} else {
			croak("Parse::CPAN::Meta failed to classify line '$lines[0]'");
		}
	}

	if ( wantarray ) {
		return @documents;
	} else {
		return $documents[-1];
	}
}

# Deparse a scalar string to the actual scalar
sub _scalar ($$$) {
	my ($string, $indent, $lines) = @_;

	# Trim trailing whitespace
	$string =~ s/\s*\z//;

	# Explitic null/undef
	return undef if $string eq '~';

	# Quotes
	if ( $string =~ /^\'(.*?)\'\z/ ) {
		return '' unless defined $1;
		$string = $1;
		$string =~ s/\'\'/\'/g;
		return $string;
	}
	if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
		# Reusing the variable is a little ugly,
		# but avoids a new variable and a string copy.
		$string = $1;
		$string =~ s/\\"/"/g;
		$string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
		return $string;
	}

	# Special cases
	if ( $string =~ /^[\'\"!&]/ ) {
		croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");
	}
	return {} if $string eq '{}';
	return [] if $string eq '[]';

	# Regular unquoted string
	return $string unless $string =~ /^[>|]/;

	# Error
	croak("Parse::CPAN::Meta failed to find multi-line scalar content") unless @$lines;

	# Check the indent depth
	$lines->[0]   =~ /^(\s*)/;
	$indent->[-1] = length("$1");
	if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
		croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
	}

	# Pull the lines
	my @multiline = ();
	while ( @$lines ) {
		$lines->[0] =~ /^(\s*)/;
		last unless length($1) >= $indent->[-1];
		push @multiline, substr(shift(@$lines), length($1));
	}

	my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
	my $t = (substr($string, 1, 1) eq '-') ? ''  : "\n";
	return join( $j, @multiline ) . $t;
}

# Parse an array
sub _array ($$$) {
	my ($array, $indent, $lines) = @_;

	while ( @$lines ) {
		# Check for a new document
		if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
			while ( @$lines and $lines->[0] !~ /^---/ ) {
				shift @$lines;
			}
			return 1;
		}

		# Check the indent level
		$lines->[0] =~ /^(\s*)/;
		if ( length($1) < $indent->[-1] ) {
			return 1;
		} elsif ( length($1) > $indent->[-1] ) {
			croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
		}

		if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
			# Inline nested hash
			my $indent2 = length("$1");
			$lines->[0] =~ s/-/ /;
			push @$array, { };
			_hash( $array->[-1], [ @$indent, $indent2 ], $lines );

		} elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
			# Array entry with a value
			shift @$lines;
			push @$array, _scalar( "$2", [ @$indent, undef ], $lines );

		} elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
			shift @$lines;
			unless ( @$lines ) {
				push @$array, undef;
				return 1;
			}
			if ( $lines->[0] =~ /^(\s*)\-/ ) {
				my $indent2 = length("$1");
				if ( $indent->[-1] == $indent2 ) {
					# Null array entry
					push @$array, undef;
				} else {
					# Naked indenter
					push @$array, [ ];
					_array( $array->[-1], [ @$indent, $indent2 ], $lines );
				}

			} elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
				push @$array, { };
				_hash( $array->[-1], [ @$indent, length("$1") ], $lines );

			} else {
				croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
			}

		} elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
			# This is probably a structure like the following...
			# ---
			# foo:
			# - list
			# bar: value
			#
			# ... so lets return and let the hash parser handle it
			return 1;

		} else {
			croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
		}
	}

	return 1;
}

# Parse an array
sub _hash ($$$) {
	my ($hash, $indent, $lines) = @_;

	while ( @$lines ) {
		# Check for a new document
		if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
			while ( @$lines and $lines->[0] !~ /^---/ ) {
				shift @$lines;
			}
			return 1;
		}

		# Check the indent level
		$lines->[0] =~ /^(\s*)/;
		if ( length($1) < $indent->[-1] ) {
			return 1;
		} elsif ( length($1) > $indent->[-1] ) {
			croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
		}

		# Get the key
		unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
			if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
				croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");
			}
			croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
		}
		my $key = $1;

		# Do we have a value?
		if ( length $lines->[0] ) {
			# Yes
			$hash->{$key} = _scalar( shift(@$lines), [ @$indent, undef ], $lines );
		} else {
			# An indent
			shift @$lines;
			unless ( @$lines ) {
				$hash->{$key} = undef;
				return 1;
			}
			if ( $lines->[0] =~ /^(\s*)-/ ) {
				$hash->{$key} = [];
				_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
			} elsif ( $lines->[0] =~ /^(\s*)./ ) {
				my $indent2 = length("$1");
				if ( $indent->[-1] >= $indent2 ) {
					# Null hash entry
					$hash->{$key} = undef;
				} else {
					$hash->{$key} = {};
					_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
				}
			}
		}
	}

	return 1;
}


package main;

unless (caller) {
    my $app = App::cpanminus::script->new;
    $app->parse_options(@ARGV);
    $app->doit;
}

__DATA__
# local::lib 1.004009 (auto embedded by script/build.PL)
# CPANM_EMBED_BEGIN local::lib
use strict;
use warnings;

package local::lib;

use 5.008001; # probably works with earlier versions but I'm not supporting them
              # (patches would, of course, be welcome)

use File::Spec ();
use File::Path ();
use Carp ();
use Config;

our $VERSION = '1.004009'; # 1.4.9
my @KNOWN_FLAGS = (qw/--self-contained/);

sub import {
  my ($class, @args) = @_;
  @args <= 1 + @KNOWN_FLAGS or die <<'DEATH';
Please see `perldoc local::lib` for directions on using this module.
DEATH

  # Remember what PERL5LIB was when we started
  my $perl5lib = $ENV{PERL5LIB} || '';

  my %arg_store;
  for my $arg (@args) {
    # check for lethal dash first to stop processing before causing problems
    if ($arg =~ /−/) {
      die <<'DEATH';
WHOA THERE! It looks like you've got some fancy dashes in your commandline!
These are *not* the traditional -- dashes that software recognizes. You
probably got these by copy-pasting from the perldoc for this module as
rendered by a UTF8-capable formatter. This most typically happens on an OS X
terminal, but can happen elsewhere too. Please try again after replacing the
dashes with normal minus signs.
DEATH
    }
    elsif(grep { $arg eq $_ } @KNOWN_FLAGS) {
      (my $flag = $arg) =~ s/--//;
      $arg_store{$flag} = 1;
    }
    elsif($arg =~ /^--/) {
      die "Unknown import argument: $arg";
    }
    else {
      # assume that what's left is a path
      $arg_store{path} = $arg;
    }
  }

  if($arg_store{'self-contained'}) {
    # The only directories that remain are those that we just defined and those
    # where core modules are stored.  We put PERL5LIB first, so it'll be favored
    # over privlibexp and archlibexp

    @INC = _uniq(
      $class->install_base_arch_path($arg_store{path}),
      $class->install_base_perl_path($arg_store{path}),
      split( $Config{path_sep}, $perl5lib ),
      $Config::Config{archlibexp},
      $Config::Config{privlibexp},
    );

    # We explicitly set PERL5LIB here to the above de-duped list to prevent
    # @INC from growing with each invocation
    $ENV{PERL5LIB} = join( $Config{path_sep}, @INC );
  }

  $arg_store{path} = $class->resolve_path($arg_store{path});
  $class->setup_local_lib_for($arg_store{path});

  for (@INC) { # Untaint @INC
    next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
    m/(.*)/ and $_ = $1;
  }
}

sub pipeline;

sub pipeline {
  my @methods = @_;
  my $last = pop(@methods);
  if (@methods) {
    \sub {
      my ($obj, @args) = @_;
      $obj->${pipeline @methods}(
        $obj->$last(@args)
      );
    };
  } else {
    \sub {
      shift->$last(@_);
    };
  }
}


sub _uniq {
    my %seen;
    grep { ! $seen{$_}++ } @_;
}

sub resolve_path {
  my ($class, $path) = @_;
  $class->${pipeline qw(
    resolve_relative_path
    resolve_home_path
    resolve_empty_path
  )}($path);
}

sub resolve_empty_path {
  my ($class, $path) = @_;
  if (defined $path) {
    $path;
  } else {
    '~/perl5';
  }
}


sub resolve_home_path {
  my ($class, $path) = @_;
  return $path unless ($path =~ /^~/);
  my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us'
  my $tried_file_homedir;
  my $homedir = do {
    if (eval { require File::HomeDir } && $File::HomeDir::VERSION >= 0.65) {
      $tried_file_homedir = 1;
      if (defined $user) {
        File::HomeDir->users_home($user);
      } else {
        File::HomeDir->my_home;
      }
    } else {
      if (defined $user) {
        (getpwnam $user)[7];
      } else {
        if (defined $ENV{HOME}) {
          $ENV{HOME};
        } else {
          (getpwuid $<)[7];
        }
      }
    }
  };
  unless (defined $homedir) {
    Carp::croak(
      "Couldn't resolve homedir for "
      .(defined $user ? $user : 'current user')
      .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
    );
  }
  $path =~ s/^~[^\/]*/$homedir/;
  $path;
}

sub resolve_relative_path {
  my ($class, $path) = @_;
  $path = File::Spec->rel2abs($path);
}


sub setup_local_lib_for {
  my ($class, $path) = @_;
  $path = $class->ensure_dir_structure_for($path);
  if ($0 eq '-') {
    $class->print_environment_vars_for($path);
    exit 0;
  } else {
    $class->setup_env_hash_for($path);
    @INC = _uniq(split($Config{path_sep}, $ENV{PERL5LIB}), @INC);
  }
}

sub modulebuildrc_path {
  my ($class, $path) = @_;
  File::Spec->catfile($path, '.modulebuildrc');
}

sub install_base_bin_path {
  my ($class, $path) = @_;
  File::Spec->catdir($path, 'bin');
}

sub install_base_perl_path {
  my ($class, $path) = @_;
  File::Spec->catdir($path, 'lib', 'perl5');
}

sub install_base_arch_path {
  my ($class, $path) = @_;
  File::Spec->catdir($class->install_base_perl_path($path), $Config{archname});
}

sub ensure_dir_structure_for {
  my ($class, $path) = @_;
  unless (-d $path) {
    warn "Attempting to create directory ${path}\n";
  }
  File::Path::mkpath($path);
  # Need to have the path exist to make a short name for it, so
  # converting to a short name here.
  $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32';
  my $modulebuildrc_path = $class->modulebuildrc_path($path);
  if (-e $modulebuildrc_path) {
    unless (-f _) {
      Carp::croak("${modulebuildrc_path} exists but is not a plain file");
    }
  } else {
    warn "Attempting to create file ${modulebuildrc_path}\n";
    open MODULEBUILDRC, '>', $modulebuildrc_path
      || Carp::croak("Couldn't open ${modulebuildrc_path} for writing: $!");
    print MODULEBUILDRC qq{install  --install_base  ${path}\n}
      || Carp::croak("Couldn't write line to ${modulebuildrc_path}: $!");
    close MODULEBUILDRC
      || Carp::croak("Couldn't close file ${modulebuildrc_path}: $@");
  }

  return $path;
}

sub INTERPOLATE_ENV () { 1 }
sub LITERAL_ENV     () { 0 }

sub print_environment_vars_for {
  my ($class, $path) = @_;
  my @envs = $class->build_environment_vars_for($path, LITERAL_ENV);
  my $out = '';

  # rather basic csh detection, goes on the assumption that something won't
  # call itself csh unless it really is. also, default to bourne in the
  # pathological situation where a user doesn't have $ENV{SHELL} defined.
  # note also that shells with funny names, like zoid, are assumed to be
  # bourne.
  my $shellbin = 'sh';
  if(defined $ENV{'SHELL'}) {
      my @shell_bin_path_parts = File::Spec->splitpath($ENV{'SHELL'});
      $shellbin = $shell_bin_path_parts[-1];
  }
  my $shelltype = do {
      local $_ = $shellbin;
      if(/csh/) {
          'csh'
      } else {
          'bourne'
      }
  };

  # Both Win32 and Cygwin have $ENV{COMSPEC} set.
  if (defined $ENV{'COMSPEC'} && $^O ne 'cygwin') {
      my @shell_bin_path_parts = File::Spec->splitpath($ENV{'COMSPEC'});
      $shellbin = $shell_bin_path_parts[-1];
         $shelltype = do {
                 local $_ = $shellbin;
                 if(/command\.com/) {
                         'win32'
                 } elsif(/cmd\.exe/) {
                         'win32'
                 } elsif(/4nt\.exe/) {
                         'win32'
                 } else {
                         $shelltype
                 }
         };
  }

  while (@envs) {
    my ($name, $value) = (shift(@envs), shift(@envs));
    $value =~ s/(\\")/\\$1/g;
    $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value);
  }
  print $out;
}

# simple routines that take two arguments: an %ENV key and a value. return
# strings that are suitable for passing directly to the relevant shell to set
# said key to said value.
sub build_bourne_env_declaration {
  my $class = shift;
  my($name, $value) = @_;
  return qq{export ${name}="${value}"\n};
}

sub build_csh_env_declaration {
  my $class = shift;
  my($name, $value) = @_;
  return qq{setenv ${name} "${value}"\n};
}

sub build_win32_env_declaration {
  my $class = shift;
  my($name, $value) = @_;
  return qq{set ${name}=${value}\n};
}

sub setup_env_hash_for {
  my ($class, $path) = @_;
  my %envs = $class->build_environment_vars_for($path, INTERPOLATE_ENV);
  @ENV{keys %envs} = values %envs;
}

sub build_environment_vars_for {
  my ($class, $path, $interpolate) = @_;
  return (
    MODULEBUILDRC => $class->modulebuildrc_path($path),
    PERL_MM_OPT => "INSTALL_BASE=${path}",
    PERL5LIB => join($Config{path_sep},
                  $class->install_base_perl_path($path),
                  $class->install_base_arch_path($path),
                  ($ENV{PERL5LIB} ?
                    ($interpolate == INTERPOLATE_ENV
                      ? ($ENV{PERL5LIB})
                      : (($^O ne 'MSWin32') ? '$PERL5LIB' : '%PERL5LIB%' ))
                    : ())
                ),
    PATH => join($Config{path_sep},
              $class->install_base_bin_path($path),
              ($interpolate == INTERPOLATE_ENV
                ? $ENV{PATH}
                : (($^O ne 'MSWin32') ? '$PATH' : '%PATH%' ))
             ),
  )
}


# CPANM_EMBED_END local::lib
# HTTP::Lite 2.2 (auto embedded by script/build.PL)
# CPANM_EMBED_BEGIN HTTP::Lite
package HTTP::Lite;

use 5.005;
use strict;
use Socket 1.3;
use Fcntl;
use Errno qw(EAGAIN);

use vars qw($VERSION);
BEGIN {
	$VERSION = "2.2";
}

my $BLOCKSIZE = 65536;
my $CRLF = "\r\n";
my $URLENCODE_VALID = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-.";

# Forward declarations
sub prepare_post;
sub http_write;
sub http_readline;
sub http_read;
sub http_readbytes;

# Prepare the urlencode validchars lookup hash
my @urlencode_valid;
foreach my $char (split('', $URLENCODE_VALID)) {
  $urlencode_valid[ord $char]=$char;
}
for (my $n=0;$n<255;$n++) {
  if (!defined($urlencode_valid[$n])) {
    $urlencode_valid[$n]=sprintf("%%%02X", $n);
  }
}

sub new 
{
  my $self = {};
  bless $self;
  $self->initialize();
  return $self;
}

sub initialize
{
  my $self = shift;
  $self->reset;
  $self->{timeout} = 120;
  $self->{HTTP11} = 0;
  $self->{DEBUG} = 0;
  $self->{header_at_once} = 0; 
  $self->{holdback} = 0;       # needed for http_write 
}

sub header_at_once
{
  my $self=shift;
  $self->{header_at_once} = 1;
}

sub local_addr
{
  my $self = shift;
  my $val = shift;
  my $oldval = $self->{'local_addr'};
  if (defined($val)) {
    $self->{'local_addr'} = $val;
  }
  return $oldval;
}

sub local_port
{
  my $self = shift;
  my $val = shift;
  my $oldval = $self->{'local_port'};
  if (defined($val)) {
    $self->{'local_port'} = $val;
   }
  return $oldval;
}

sub method
{
  my $self = shift;
  my $method = shift;
  $method = uc($method);
  $self->{method} = $method;
}

sub DEBUG
{
  my $self = shift;
  if ($self->{DEBUG}) {
    print STDERR join(" ", @_),"\n";
  }
}

sub reset
{
  my $self = shift;
  foreach my $var ("body", "request", "content", "status", "proxy",
    "proxyport", "resp-protocol", "error-message",  
    "resp-headers", "CBARGS", "callback_function", "callback_params")
  {
    $self->{$var} = undef;
  }
  $self->{HTTPReadBuffer} = "";
  $self->{method} = "GET";
  $self->{headers} = { 'user-agent' => "HTTP::Lite/$VERSION" };
  $self->{headermap} = { 'user-agent'  => 'User-Agent' };
}


# URL-encode data
sub escape {
  my $toencode = shift;
  return join('', 
    map { $urlencode_valid[ord $_] } split('', $toencode));
}

sub set_callback {
  my ($self, $callback, @callbackparams) = @_;
  $self->{'callback_function'} = $callback;
  $self->{'callback_params'} = [ @callbackparams ];
}

sub request
{
  my ($self, $url, $data_callback, $cbargs) = @_;
  
  my $method = $self->{method};
  if (defined($cbargs)) {
    $self->{CBARGS} = $cbargs;
  }

  my $callback_func = $self->{'callback_function'};
  my $callback_params = $self->{'callback_params'};

  # Parse URL 
  my ($protocol,$host,$junk,$port,$object) = 
    $url =~ m{^([^:/]+)://([^/:]*)(:(\d+))?(/.*)$};

  # Only HTTP is supported here
  if ($protocol ne "http")
  {
    warn "Only http is supported by HTTP::Lite";
    return undef;
  }
  
  # Setup the connection
  my $proto = getprotobyname('tcp');
  local *FH;
  socket(FH, PF_INET, SOCK_STREAM, $proto);
  $port = 80 if !$port;

  my $connecthost = $self->{'proxy'} || $host;
  $connecthost = $connecthost ? $connecthost : $host;
  my $connectport = $self->{'proxyport'} || $port;
  $connectport = $connectport ? $connectport : $port;
  my $addr = inet_aton($connecthost);
  if (!$addr) {
    close(FH);
    return undef;
  }
  if ($connecthost ne $host)
  {
    # if proxy active, use full URL as object to request
    $object = "$url";
  }

  # choose local port and address
  my $local_addr = INADDR_ANY; 
  my $local_port = "0";
  if (defined($self->{'local_addr'})) {
    $local_addr = $self->{'local_addr'};
    if ($local_addr eq "0.0.0.0" || $local_addr eq "0") {
      $local_addr = INADDR_ANY;
    } else {
      $local_addr = inet_aton($local_addr);
    }
  }
  if (defined($self->{'local_port'})) {
    $local_port = $self->{'local_port'};
  }
  my $paddr = pack_sockaddr_in($local_port, $local_addr); 
  bind(FH, $paddr) || return undef;  # Failing to bind is fatal.

  my $sin = sockaddr_in($connectport,$addr);
  connect(FH, $sin) || return undef;
  # Set nonblocking IO on the handle to allow timeouts
  if ( $^O ne "MSWin32" ) {
    fcntl(FH, F_SETFL, O_NONBLOCK);
  }

  if (defined($callback_func)) {
    &$callback_func($self, "connect", undef, @$callback_params);
  }  

  if ($self->{header_at_once}) {
    $self->{holdback} = 1;    # http_write should buffer only, no sending yet
  }

  # Start the request (HTTP/1.1 mode)
  if ($self->{HTTP11}) {
    $self->http_write(*FH, "$method $object HTTP/1.1$CRLF");
  } else {
    $self->http_write(*FH, "$method $object HTTP/1.0$CRLF");
  }

  # Add some required headers
  # we only support a single transaction per request in this version.
  $self->add_req_header("Connection", "close");    
  if ($port != 80) {
    $self->add_req_header("Host", "$host:$port");
  } else {
    $self->add_req_header("Host", $host);
  }
  if (!defined($self->get_req_header("Accept"))) {
    $self->add_req_header("Accept", "*/*");
  }

  if ($method eq 'POST') {
    $self->http_write(*FH, "Content-Type: application/x-www-form-urlencoded$CRLF");
  }
  
  # Purge a couple others
  $self->delete_req_header("Content-Type");
  $self->delete_req_header("Content-Length");
  
  # Output headers
  foreach my $header ($self->enum_req_headers())
  {
    my $value = $self->get_req_header($header);
    $self->http_write(*FH, $self->{headermap}{$header}.": ".$value."$CRLF");
  }
  
  my $content_length;
  if (defined($self->{content}))
  {
    $content_length = length($self->{content});
  }
  if (defined($callback_func)) {
    my $ncontent_length = &$callback_func($self, "content-length", undef, @$callback_params);
    if (defined($ncontent_length)) {
      $content_length = $ncontent_length;
    }
  }  

  if ($content_length) {
    $self->http_write(*FH, "Content-Length: $content_length$CRLF");
  }
  
  if (defined($callback_func)) {
    &$callback_func($self, "done-headers", undef, @$callback_params);
  }  
  # End of headers
  $self->http_write(*FH, "$CRLF");
  
  if ($self->{header_at_once}) {
    $self->{holdback} = 0; 
    $self->http_write(*FH, ""); # pseudocall to get http_write going
  }  
  
  my $content_out = 0;
  if (defined($callback_func)) {
    while (my $content = &$callback_func($self, "content", undef, @$callback_params)) {
      $self->http_write(*FH, $content);
      $content_out++;
    }
  } 
  
  # Output content, if any
  if (!$content_out && defined($self->{content}))
  {
    $self->http_write(*FH, $self->{content});
  }
  
  if (defined($callback_func)) {
    &$callback_func($self, "content-done", undef, @$callback_params);
  }  


  # Read response from server
  my $headmode=1;
  my $chunkmode=0;
  my $chunksize=0;
  my $chunklength=0;
  my $chunk;
  my $line = 0;
  my $data;
  while ($data = $self->http_read(*FH,$headmode,$chunkmode,$chunksize))
  {
    $self->{DEBUG} && $self->DEBUG("reading: $chunkmode, $chunksize, $chunklength, $headmode, ".
        length($self->{'body'}));
    if ($self->{DEBUG}) {
      foreach my $var ("body", "request", "content", "status", "proxy",
        "proxyport", "resp-protocol", "error-message", 
        "resp-headers", "CBARGS", "HTTPReadBuffer") 
      {
        $self->DEBUG("state $var ".length($self->{$var}));
      }
    }
    $line++;
    if ($line == 1)
    {
      my ($proto,$status,$message) = split(' ', $$data, 3);
      $self->{DEBUG} && $self->DEBUG("header $$data");
      $self->{status}=$status;
      $self->{'resp-protocol'}=$proto;
      $self->{'error-message'}=$message;
      next;
    } 
    if (($headmode || $chunkmode eq "entity-header") && $$data =~ /^[\r\n]*$/)
    {
      if ($chunkmode)
      {
        $chunkmode = 0;
      }
      $headmode = 0;
      
      # Check for Transfer-Encoding
      my $te = $self->get_header("Transfer-Encoding");
      if (defined($te)) {
        my $header = join(' ',@{$te});
        if ($header =~ /chunked/i)
        {
          $chunkmode = "chunksize";
        }
      }
      next;
    }
    if ($headmode || $chunkmode eq "entity-header")
    {
      my ($var,$datastr) = $$data =~ /^([^:]*):\s*(.*)$/;
      if (defined($var))
      {
        $datastr =~s/[\r\n]$//g;
        $var = lc($var);
        $var =~ s/^(.)/&upper($1)/ge;
        $var =~ s/(-.)/&upper($1)/ge;
        my $hr = ${$self->{'resp-headers'}}{$var};
        if (!ref($hr))
        {
          $hr = [ $datastr ];
        }
        else 
        {
          push @{ $hr }, $datastr;
        }
        ${$self->{'resp-headers'}}{$var} = $hr;
      }
    } elsif ($chunkmode)
    {
      if ($chunkmode eq "chunksize")
      {
        $chunksize = $$data;
        $chunksize =~ s/^\s*|;.*$//g;
        $chunksize =~ s/\s*$//g;
        my $cshx = $chunksize;
        if (length($chunksize) > 0) {
          # read another line
          if ($chunksize !~ /^[a-f0-9]+$/i) {
            $self->{DEBUG} && $self->DEBUG("chunksize not a hex string");
          }
          $chunksize = hex($chunksize);
          $self->{DEBUG} && $self->DEBUG("chunksize was $chunksize (HEX was $cshx)");
          if ($chunksize == 0)
          {
            $chunkmode = "entity-header";
          } else {
            $chunkmode = "chunk";
            $chunklength = 0;
          }
        } else {
          $self->{DEBUG} && $self->DEBUG("chunksize empty string, checking next line!");
        }
      } elsif ($chunkmode eq "chunk")
      {
        $chunk .= $$data;
        $chunklength += length($$data);
        if ($chunklength >= $chunksize)
        {
          $chunkmode = "chunksize";
          if ($chunklength > $chunksize)
          {
            $chunk = substr($chunk,0,$chunksize);
          } 
          elsif ($chunklength == $chunksize && $chunk !~ /$CRLF$/) 
          {
            # chunk data is exactly chunksize -- need CRLF still
            $chunkmode = "ignorecrlf";
          }
          $self->add_to_body(\$chunk, $data_callback);
          $chunk="";
          $chunklength = 0;
          $chunksize = "";
        } 
      } elsif ($chunkmode eq "ignorecrlf")
      {
        $chunkmode = "chunksize";
      }
    } else {
      $self->add_to_body($data, $data_callback);
    }
  }
  if (defined($callback_func)) {
    &$callback_func($self, "done", undef, @$callback_params);
  }
  close(FH);
  return $self->{status};
}

sub add_to_body
{
  my $self = shift;
  my ($dataref, $data_callback) = @_;
  
  my $callback_func = $self->{'callback_function'};
  my $callback_params = $self->{'callback_params'};

  if (!defined($data_callback) && !defined($callback_func)) {
    $self->{DEBUG} && $self->DEBUG("no callback");
    $self->{'body'}.=$$dataref;
  } else {
    my $newdata;
    if (defined($callback_func)) {
      $newdata = &$callback_func($self, "data", $dataref, @$callback_params);
    } else {
      $newdata = &$data_callback($self, $dataref, $self->{CBARGS});
    }
    if ($self->{DEBUG}) {
      $self->DEBUG("callback got back a ".ref($newdata));
      if (ref($newdata) eq "SCALAR") {
        $self->DEBUG("callback got back ".length($$newdata)." bytes");
      }
    }
    if (defined($newdata) && ref($newdata) eq "SCALAR") {
      $self->{'body'} .= $$newdata;
    }
  }
}

sub add_req_header
{
  my $self = shift;
  my ($header, $value) = @_;
  
  my $lcheader = lc($header);
  $self->{DEBUG} && $self->DEBUG("add_req_header $header $value");
  ${$self->{headers}}{$lcheader} = $value;
  ${$self->{headermap}}{$lcheader} = $header;
}

sub get_req_header
{
  my $self = shift;
  my ($header) = @_;
  
  return $self->{headers}{lc($header)};
}

sub delete_req_header
{
  my $self = shift;
  my ($header) = @_;
  
  my $exists;
  if ($exists=defined(${$self->{headers}}{lc($header)}))
  {
    delete ${$self->{headers}}{lc($header)};
    delete ${$self->{headermap}}{lc($header)};
  }
  return $exists;
}

sub enum_req_headers
{
  my $self = shift;
  my ($header) = @_;
  
  my $exists;
  return keys %{$self->{headermap}};
}

sub body
{
  my $self = shift;
  return $self->{'body'};
}

sub status
{
  my $self = shift;
  return $self->{status};
}

sub protocol
{
  my $self = shift;
  return $self->{'resp-protocol'};
}

sub status_message
{
  my $self = shift;
  return $self->{'error-message'};
}

sub proxy
{
  my $self = shift;
  my ($value) = @_;
  
  # Parse URL 
  my ($protocol,$host,$junk,$port,$object) = 
    $value =~ m{^(\S+)://([^/:]*)(:(\d+))?(/.*)$};
  if (!$host)
  {
    ($host,$port) = $value =~ /^([^:]+):(.*)$/;
  }

  $self->{'proxy'} = $host || $value;
  $self->{'proxyport'} = $port || 80;
}

sub headers_array
{
  my $self = shift;
  
  my @array = ();
  
  foreach my $header (keys %{$self->{'resp-headers'}})
  {
    my $aref = ${$self->{'resp-headers'}}{$header};
    foreach my $value (@$aref)
    {
      push @array, "$header: $value";
    }
  }
  return @array;
}

sub headers_string
{
  my $self = shift;
  
  my $string = "";
  
  foreach my $header (keys %{$self->{'resp-headers'}})
  {
    my $aref = ${$self->{'resp-headers'}}{$header};
    foreach my $value (@$aref)
    {
      $string .= "$header: $value\n";
    }
  }
  return $string;
}

sub get_header
{
  my $self = shift;
  my $header = shift;

  return $self->{'resp-headers'}{$header};
}

sub http11_mode
{
  my $self = shift;
  my $mode = shift;

  $self->{HTTP11} = $mode;
}

sub prepare_post
{
  my $self = shift;
  my $varref = shift;
  
  my $body = "";
  while (my ($var,$value) = map { escape($_) } each %$varref)
  {
    if ($body)
    {
      $body .= "&$var=$value";
    } else {
      $body = "$var=$value";
    }
  }
  $self->{content} = $body;
  $self->{headers}{'Content-Type'} = "application/x-www-form-urlencoded"
    unless defined ($self->{headers}{'Content-Type'}) and 
    $self->{headers}{'Content-Type'};
  $self->{method} = "POST";
}

sub http_write
{
  my $self = shift;
  my ($fh,$line) = @_;

  if ($self->{holdback}) {
     $self->{HTTPWriteBuffer} .= $line;
     return;
  } else {
     if (defined $self->{HTTPWriteBuffer}) {   # copy previously buffered, if any
         $line = $self->{HTTPWriteBuffer} . $line;
     }
  }

  my $size = length($line);
  my $bytes = syswrite($fh, $line, length($line) , 0 );  # please double check new length limit
                                                         # is this ok?
  while ( ($size - $bytes) > 0) {
    $bytes += syswrite($fh, $line, length($line)-$bytes, $bytes );  # also here
  }
}
 
sub http_read
{
  my $self = shift;
  my ($fh,$headmode,$chunkmode,$chunksize) = @_;

  $self->{DEBUG} && $self->DEBUG("read handle=$fh, headm=$headmode, chunkm=$chunkmode, chunksize=$chunksize");

  my $res;
  if (($headmode == 0 && $chunkmode eq "0") || ($chunkmode eq "chunk")) {
    my $bytes_to_read = $chunkmode eq "chunk" ?
        ($chunksize < $BLOCKSIZE ? $chunksize : $BLOCKSIZE) :
        $BLOCKSIZE;
    $res = $self->http_readbytes($fh,$self->{timeout},$bytes_to_read);
  } else { 
    $res = $self->http_readline($fh,$self->{timeout});  
  }
  if ($res) {
    if ($self->{DEBUG}) {
      $self->DEBUG("read got ".length($$res)." bytes");
      my $str = $$res;
      $str =~ s{([\x00-\x1F\x7F-\xFF])}{.}g;
      $self->DEBUG("read: ".$str);
    }
  }
  return $res;
}

sub http_readline
{
  my $self = shift;
  my ($fh, $timeout) = @_;
  my $EOL = "\n";

  $self->{DEBUG} && $self->DEBUG("readline handle=$fh, timeout=$timeout");
  
  # is there a line in the buffer yet?
  while ($self->{HTTPReadBuffer} !~ /$EOL/)
  {
    # nope -- wait for incoming data
    my ($inbuf,$bits,$chars) = ("","",0);
    vec($bits,fileno($fh),1)=1;
    my $nfound = select($bits, undef, $bits, $timeout);
    if ($nfound == 0)
    {
      # Timed out
      return undef;
    } else {
      # Get the data
      $chars = sysread($fh, $inbuf, $BLOCKSIZE);
      $self->{DEBUG} && $self->DEBUG("sysread $chars bytes");
    }
    # End of stream?
    if ($chars <= 0 && !$!{EAGAIN})
    {
      last;
    }
    # tag data onto end of buffer
    $self->{HTTPReadBuffer}.=$inbuf;
  }
  # get a single line from the buffer
  my $nlat = index($self->{HTTPReadBuffer}, $EOL);
  my $newline;
  my $oldline;
  if ($nlat > -1)
  {
    $newline = substr($self->{HTTPReadBuffer},0,$nlat+1);
    $oldline = substr($self->{HTTPReadBuffer},$nlat+1);
  } else {
    $newline = substr($self->{HTTPReadBuffer},0);
    $oldline = "";
  }
  # and update the buffer
  $self->{HTTPReadBuffer}=$oldline;
  return length($newline) ? \$newline : 0;
}

sub http_readbytes
{
  my $self = shift;
  my ($fh, $timeout, $bytes) = @_;
  my $EOL = "\n";

  $self->{DEBUG} && $self->DEBUG("readbytes handle=$fh, timeout=$timeout, bytes=$bytes");
  
  # is there enough data in the buffer yet?
  while (length($self->{HTTPReadBuffer}) < $bytes)
  {
    # nope -- wait for incoming data
    my ($inbuf,$bits,$chars) = ("","",0);
    vec($bits,fileno($fh),1)=1;
    my $nfound = select($bits, undef, $bits, $timeout);
    if ($nfound == 0)
    {
      # Timed out
      return undef;
    } else {
      # Get the data
      $chars = sysread($fh, $inbuf, $BLOCKSIZE);
      $self->{DEBUG} && $self->DEBUG("sysread $chars bytes");
    }
    # End of stream?
    if ($chars <= 0 && !$!{EAGAIN})
    {
      last;
    }
    # tag data onto end of buffer
    $self->{HTTPReadBuffer}.=$inbuf;
  }
  my $newline;
  my $buflen;
  if (($buflen=length($self->{HTTPReadBuffer})) >= $bytes)
  {
    $newline = substr($self->{HTTPReadBuffer},0,$bytes+1);
    if ($bytes+1 < $buflen) {
      $self->{HTTPReadBuffer} = substr($self->{HTTPReadBuffer},$bytes+1);
    } else {
      $self->{HTTPReadBuffer} = "";
    }
  } else {
    $newline = substr($self->{HTTPReadBuffer},0);
    $self->{HTTPReadBuffer} = "";
  }
  return length($newline) ? \$newline : 0;
}

sub upper
{
  my ($str) = @_;
  if (defined($str)) {
    return uc($str);
  } else {
    return undef;
  }
}

# CPANM_EMBED_END HTTP::Lite