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.
gugod · Nov 28, 2013 · 4e49d09 · 4e49d09
1 parent 91e5ea7
commit 4e49d09
Show file tree

Hide file tree

Showing 2 changed files with 42 additions and 11 deletions.
diff --git 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
@@ -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;