1 files changed, 62 insertions, 9 deletions

diff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pm b/dist/Locale-Maketext/lib/Locale/Maketext.pm
index 24c31ea9d6..f213c7439e 100644
--- a/dist/Locale-Maketext/lib/Locale/Maketext.pm
+++ b/dist/Locale-Maketext/lib/Locale/Maketext.pm
@@ -1,4 +1,3 @@
-
 package Locale::Maketext;
 use strict;
 use vars qw( @ISA $VERSION $MATCH_SUPERS $USING_LANGUAGE_TAGS
@@ -138,6 +137,56 @@ sub fail_with { # an actual attribute method!
 
 #--------------------------------------------------------------------------
 
+sub blacklist {
+    my ( $handle, @methods ) = @_;
+
+    unless ( defined $handle->{'blacklist'} ) {
+        no strict 'refs';
+
+        # Don't let people call methods they're not supposed to from maketext.
+        # Explicitly exclude all methods in this package that start with an
+        # underscore on principle.
+        $handle->{'blacklist'} = {
+            map { $_ => 1 } (
+                qw/
+                  blacklist
+                  encoding
+                  fail_with
+                  failure_handler_auto
+                  fallback_language_classes
+                  fallback_languages
+                  get_handle
+                  init
+                  language_tag
+                  maketext
+                  new
+                  whitelist
+                  /, grep { /^_/ } keys %{ __PACKAGE__ . "::" }
+            ),
+        };
+    }
+
+    if ( scalar @methods ) {
+        $handle->{'blacklist'} = { %{ $handle->{'blacklist'} }, map { $_ => 1 } @methods };
+    }
+
+    delete $handle->{'_external_lex_cache'};
+    return;
+}
+
+sub whitelist {
+    my ( $handle, @methods ) = @_;
+    if ( scalar @methods ) {
+        $handle->{'whitelist'} = {} unless defined $handle->{'whitelist'};
+        $handle->{'whitelist'} = { %{ $handle->{'whitelist'} }, map { $_ => 1 } @methods };
+    }
+
+    delete $handle->{'_external_lex_cache'};
+    return;
+}
+
+#--------------------------------------------------------------------------
+
 sub failure_handler_auto {
     # Meant to be used like:
     #  $handle->fail_with('failure_handler_auto')
@@ -179,6 +228,7 @@ sub new {
     # Nothing fancy!
     my $class = ref($_[0]) || $_[0];
     my $handle = bless {}, $class;
+    $handle->blacklist;
     $handle->init;
     return $handle;
 }
@@ -508,7 +558,7 @@ sub _compile {
     # on strings that don't need compiling.
     return \"$string_to_compile" if($string_to_compile !~ m/[\[~\]]/ms); # return a string ref if chars [~] are not in the string
 
-    my $target = ref($_[0]) || $_[0];
+    my $handle = $_[0];
 
     my(@code);
     my(@c) = (''); # "chunks" -- scratch.
@@ -540,10 +590,10 @@ sub _compile {
                 #  preceding literal.
                 if($in_group) {
                     if($1 eq '') {
-                        $target->_die_pointing($string_to_compile, 'Unterminated bracket group');
+                        $handle->_die_pointing($string_to_compile, 'Unterminated bracket group');
                     }
                     else {
-                        $target->_die_pointing($string_to_compile, 'You can\'t nest bracket groups');
+                        $handle->_die_pointing($string_to_compile, 'You can\'t nest bracket groups');
                     }
                 }
                 else {
@@ -627,13 +677,15 @@ sub _compile {
                         push @code, ' (';
                     }
                     elsif($m =~ /^\w+$/s
-                        # exclude anything fancy, especially fully-qualified module names
+                        && !$handle->{'blacklist'}{$m}
+                        && ( !defined $handle->{'whitelist'} || $handle->{'whitelist'}{$m} )
+                        # exclude anything fancy and restrict to the whitelist/blacklist.
                     ) {
                         push @code, ' $_[0]->' . $m . '(';
                     }
                     else {
                         # TODO: implement something?  or just too icky to consider?
-                        $target->_die_pointing(
+                        $handle->_die_pointing(
                             $string_to_compile,
                             "Can't use \"$m\" as a method name in bracket group",
                             2 + length($c[-1])
@@ -675,7 +727,7 @@ sub _compile {
                     push @c, '';
                 }
                 else {
-                    $target->_die_pointing($string_to_compile, q{Unbalanced ']'});
+                    $handle->_die_pointing($string_to_compile, q{Unbalanced ']'});
                 }
 
             }
@@ -760,8 +812,9 @@ sub _compile {
 
 sub _die_pointing {
     # This is used by _compile to throw a fatal error
-    my $target = shift; # class name
-    # ...leaving $_[0] the error-causing text, and $_[1] the error message
+    my $target = shift;
+    $target = ref($target) || $target; # class name
+                                       # ...leaving $_[0] the error-causing text, and $_[1] the error message
 
     my $i = index($_[0], "\n");