[Bast-commits] r6654 - in local-lib/1.000/trunk: . lib/local xt

[grink at dev.catalyst.perl.org]

Author: grink
Date: 2009-06-12 23:54:57 +0000 (Fri, 12 Jun 2009)
New Revision: 6654

Added:
   local-lib/1.000/trunk/xt/
   local-lib/1.000/trunk/xt/subroutine-in-inc.t
Modified:
   local-lib/1.000/trunk/Changes
   local-lib/1.000/trunk/lib/local/lib.pm
Log:
Fixed up INC untaint procedure to skip/ignore CODE, ARRAY, blessed entries.
Include test in xt/ for the above



Modified: local-lib/1.000/trunk/Changes
===================================================================
--- local-lib/1.000/trunk/Changes	2009-06-12 17:20:17 UTC (rev 6653)
+++ local-lib/1.000/trunk/Changes	2009-06-12 23:54:57 UTC (rev 6654)
@@ -1,5 +1,8 @@
 Revision history for local::lib
 
+        - Fixed up INC untaint procedure to skip/ignore CODE, ARRAY, blessed entries.
+        - Include test in xt/ for the above
+
         - Put PERL5LIB first, so it'll be favored over privlibexp and
           archlibexp when self contained.
         - Automatically untaint @INC

Modified: local-lib/1.000/trunk/lib/local/lib.pm
===================================================================
--- local-lib/1.000/trunk/lib/local/lib.pm	2009-06-12 17:20:17 UTC (rev 6653)
+++ local-lib/1.000/trunk/lib/local/lib.pm	2009-06-12 23:54:57 UTC (rev 6654)
@@ -50,7 +50,10 @@
       die "unrecognized import argument: $flag";
   }
 
-  m/(.*)/ and $_ = $1 for @INC; # Untaint @INC
+  for (@INC) { # Untaint @INC
+    next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
+    m/(.*)/ and $_ = $1;
+  }
 }
 
 sub pipeline;

Added: local-lib/1.000/trunk/xt/subroutine-in-inc.t
===================================================================
--- local-lib/1.000/trunk/xt/subroutine-in-inc.t	                        (rev 0)
+++ local-lib/1.000/trunk/xt/subroutine-in-inc.t	2009-06-12 23:54:57 UTC (rev 6654)
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+
+plan qw/no_plan/;
+
+use File::Spec;
+use Cwd;
+use File::Temp qw/ tempdir /;
+my $dir = tempdir( DIR => Cwd::abs_path('t'), CLEANUP => 1 );
+my $base;
+
+sub CODE_in_INC() {
+    return scalar grep { ref eq 'CODE' } @INC;
+}
+
+BEGIN {
+    $base = CODE_in_INC;
+    unshift @INC, sub { };
+    splice @INC, 3, 1, sub { };
+    push @INC, sub { };
+}
+
+use local::lib( $dir );
+
+is( CODE_in_INC, $base + 3 );