From 4e49d099cbdcd1e77e509b8bf5c5c6eab40d08fe Mon Sep 17 00:00:00 2001
From: Kang-min Liu <gugod@gugod.org>
Date: Thu, 28 Nov 2013 07:32:38 +0100
Subject: [PATCH] allow some external control of which HTTP UA program to use,
 with this global variable: $App::perlbrew::HTTP_USER_AGENT_PROGRAM

The value can only be one of the know program names.
---
 lib/App/perlbrew.pm      | 30 +++++++++++++++++++-----------
 t/http-program-control.t | 23 +++++++++++++++++++++++
 2 files changed, 42 insertions(+), 11 deletions(-)
 create mode 100644 t/http-program-control.t

diff --git a/lib/App/perlbrew.pm b/lib/App/perlbrew.pm
index 18ea5991..fcb81ef8 100644
--- a/lib/App/perlbrew.pm
+++ b/lib/App/perlbrew.pm
@@ -126,21 +126,29 @@ sub files_are_the_same {
         }
     );
 
+    our $HTTP_USER_AGENT_PROGRAM;
     sub http_user_agent_program {
-        my $program;
-        for my $p (keys %commands) {
-            my $code = system("$p $commands{$p}->{test}") >> 8;
-            if ($code != 127) {
-                $program = $p;
-                last;
+        $HTTP_USER_AGENT_PROGRAM ||= do {
+            my $program;
+
+            for my $p (keys %commands) {
+                my $code = system("$p $commands{$p}->{test}") >> 8;
+                if ($code != 127) {
+                    $program = $p;
+                    last;
+                }
             }
-        }
 
-        unless($program) {
-            die "[ERROR] Cannot find a proper http user agent program. Please install curl or wget.\n";
-        }
+            unless($program) {
+                die "[ERROR] Cannot find a proper http user agent program. Please install curl or wget.\n";
+            }
+
+            $program;
+        };
+
+        die "[ERROR] Unrecognized http user agent program: $HTTP_USER_AGENT_PROGRAM. It can only be one of: ".join(",", keys %commands)."\n" unless $commands{$HTTP_USER_AGENT_PROGRAM};
 
-        return $program;
+        return $HTTP_USER_AGENT_PROGRAM;
     }
 
     sub http_user_agent_command {
diff --git a/t/http-program-control.t b/t/http-program-control.t
new file mode 100644
index 00000000..01937669
--- /dev/null
+++ b/t/http-program-control.t
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use FindBin;
+use lib $FindBin::Bin;
+use App::perlbrew;
+require 'test_helpers.pl';
+
+use Test::More;
+use Test::Exception;
+
+for (qw(curl wget fetch)) {
+    $App::perlbrew::HTTP_USER_AGENT_PROGRAM = "curl";
+    is App::perlbrew::http_user_agent_program(), "curl";
+}
+
+$App::perlbrew::HTTP_USER_AGENT_PROGRAM = "something-that-is-not-recognized";
+dies_ok {
+    App::perlbrew::http_user_agent_program();
+} "should die when asked to use unrecognized http UA program";
+
+done_testing;