开源软件构建与测试

_service:tar_scm:perl-Locale-Maketext.spec Changed

_service Changed

_service:tar_scm:Locale-Maketext-1.29.tar.gz/ChangeLog -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/ChangeLog Changed

_service:tar_scm:Locale-Maketext-1.29.tar.gz/MANIFEST -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/MANIFEST Changed

_service:tar_scm:Locale-Maketext-1.29.tar.gz/META.json -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/META.json Changed

_service:tar_scm:Locale-Maketext-1.29.tar.gz/META.yml -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/META.yml Changed

_service:tar_scm:Locale-Maketext-1.29.tar.gz/Makefile.PL -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/Makefile.PL Changed

_service:tar_scm:Locale-Maketext-1.29.tar.gz/lib/Locale/Maketext.pm -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/lib/Locale/Maketext.pm Changed

@@ -25,7 +25,7 @@
 }
 
 
-our $VERSION = '1.29';
+our $VERSION = '1.33';
 our @ISA = ();
 
 our $MATCH_SUPERS = 1;
@@ -136,19 +136,20 @@
 
 #--------------------------------------------------------------------------
 
-sub blacklist {
-    my ( $handle, @methods ) = @_;
+sub _exclude {
+    my ( $handle, @methods  ) = @_;
 
-    unless ( defined $handle->{'blacklist'} ) {
+    unless ( defined $handle->{'denylist'} ) {
         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'} = {
+        $handle->{'denylist'} = {
             map { $_ => 1 } (
                 qw/
                   blacklist
+                  denylist
                   encoding
                   fail_with
                   failure_handler_auto
@@ -160,30 +161,55 @@
                   maketext
                   new
                   whitelist
+                  allowlist
                   /, grep { /^_/ } keys %{ __PACKAGE__ . "::" }
             ),
         };
     }
 
     if ( scalar @methods ) {
-        $handle->{'blacklist'} = { %{ $handle->{'blacklist'} }, map { $_ => 1 } @methods };
+        $handle->{'denylist'} = { %{ $handle->{'denylist'} }, map { $_ => 1 } @methods };
     }
 
     delete $handle->{'_external_lex_cache'};
     return;
 }
 
-sub whitelist {
+sub blacklist {
+    my ( $handle, @methods  ) = @_;
+    _exclude ( $handle, @methods );
+    return;
+}
+
+sub denylist {
+    my ( $handle, @methods  ) = @_;
+    _exclude ( $handle, @methods );
+    return;
+}
+
+sub _include {
     my ( $handle, @methods ) = @_;
     if ( scalar @methods ) {
-        $handle->{'whitelist'} = {} unless defined $handle->{'whitelist'};
-        $handle->{'whitelist'} = { %{ $handle->{'whitelist'} }, map { $_ => 1 } @methods };
+        $handle->{'allowlist'} = {} unless defined $handle->{'allowlist'};
+        $handle->{'allowlist'} = { %{ $handle->{'allowlist'} }, map { $_ => 1 } @methods };
     }
 
     delete $handle->{'_external_lex_cache'};
     return;
 }
 
+sub whitelist {
+    my ( $handle, @methods  ) = @_;
+    _include ( $handle, @methods );
+    return;
+}
+
+sub allowlist {
+    my ( $handle, @methods  ) = @_;
+    _include ( $handle, @methods );
+    return;
+}
+
 #--------------------------------------------------------------------------
 
 sub failure_handler_auto {
@@ -228,6 +254,7 @@
     my $class = ref($_0) || $_0;
     my $handle = bless {}, $class;
     $handle->blacklist;
+    $handle->denylist;
     $handle->init;
     return $handle;
 }
@@ -679,8 +706,10 @@
                     }
                     elsif($m =~ /^\w+$/s
                         && !$handle->{'blacklist'}{$m}
+                        && !$handle->{'denylist'}{$m}
                         && ( !defined $handle->{'whitelist'} || $handle->{'whitelist'}{$m} )
-                        # exclude anything fancy and restrict to the whitelist/blacklist.
+                        && ( !defined $handle->{'allowlist'} || $handle->{'allowlist'}{$m} )
+                        # exclude anything fancy and restrict to the allowlist/denylist (and historical whitelist/blacklist).
                     ) {
                         push @code, ' $_0->' . $m . '(';
                     }

_service:tar_scm:Locale-Maketext-1.29.tar.gz/lib/Locale/Maketext.pod -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/lib/Locale/Maketext.pod Changed

@@ -45,7 +45,7 @@
 The project class (with a name like "TkBocciBall::Localize",
 which you then use in your module) is in turn the base class
 for all the "language classes" for your project
-(with names "TkBocciBall::Localize::it", 
+(with names "TkBocciBall::Localize::it",
 "TkBocciBall::Localize::en",
 "TkBocciBall::Localize::fr", etc.).
 
@@ -122,9 +122,9 @@
 for those exact terms, it then tries "superordinate" language classes.
 So if no "en-US" class (i.e., YourProjClass::en_us)
 was found, nor classes for anything else in that list, we then try
-its superordinate, "en" (i.e., YourProjClass::en), and so on thru 
+its superordinate, "en" (i.e., YourProjClass::en), and so on thru
 the other language-tags in the given list: "es".
-(The other language-tags in our example list: 
+(The other language-tags in our example list:
 happen to have no superordinates.)
 
 If none of those language-tags leads to loadable classes, we then
@@ -307,9 +307,9 @@
 These two methods are discussed in the section "Controlling
 Lookup Failure".
 
-=item $lh->blacklist(@list)
+=item $lh->denylist(@list) <or> $lh->blacklist(@list)
 
-=item $lh->whitelist(@list)
+=item $lh->allowlist(@list) <or> $lh->whitelist(@list)
 
 These methods are discussed in the section "Bracket Notation
 Security".
@@ -331,7 +331,7 @@
 =item $language->quant($number, $singular, $plural, $negative)
 
 This is generally meant to be called from inside Bracket Notation
-(which is discussed later), as in 
+(which is discussed later), as in
 
      "Your search matched quant,_1,document!"
 
@@ -482,8 +482,8 @@
     'en-US', 'fr', 'kon', 'i-klingon', 'i-klingon-romanized'
   );
 
-will try loading the classes 
-YourProjClass::en_us (note lowercase!), YourProjClass::fr, 
+will try loading the classes
+YourProjClass::en_us (note lowercase!), YourProjClass::fr,
 YourProjClass::kon,
 YourProjClass::i_klingon
 and YourProjClass::i_klingon_romanized.  (And it'll stop at the
@@ -875,17 +875,17 @@
 design makes it vulnerable to format string attacks whenever it is
 used to process strings provided by untrusted users.
 
-Locale::Maketext does support blacklist and whitelist functionality
+Locale::Maketext does support denylist and allowlist functionality
 to limit which methods may be called as bracket notation methods.
 
-By default, Locale::Maketext blacklists all methods in the
+By default, Locale::Maketext denies all methods in the
 Locale::Maketext namespace that begin with the '_' character,
 and all methods which include Perl's namespace separator characters.
 
-The default blacklist for Locale::Maketext also prevents use of the
+The default denylist for Locale::Maketext also prevents use of the
 following methods in bracket notation:
 
-  blacklist
+  denylist
   encoding
   fail_with
   failure_handler_auto
@@ -896,44 +896,56 @@
   language_tag
   maketext
   new
+  allowlist
   whitelist
+  blacklist
 
-This list can be extended by either blacklisting additional "known bad"
-methods, or whitelisting only "known good" methods.
+This list can be extended by either deny-listing additional "known bad"
+methods, or allow-listing only "known good" methods.
 
 To prevent specific methods from being called in bracket notation, use
-the blacklist() method:
+the denylist() method:
 
   my $lh = MyProgram::L10N->get_handle();
-  $lh->blacklist(qw{my_internal_method my_other_method});
+  $lh->denylist(qw{my_internal_method my_other_method});
   $lh->maketext('my_internal_method'); # dies
 
 To limit the allowed bracked notation methods to a specific list, use the
-whitelist() method:
+allowlist() method:
 
   my $lh = MyProgram::L10N->get_handle();
-  $lh->whitelist('numerate', 'numf');
+  $lh->allowlist('numerate', 'numf');
   $lh->maketext('_1 numerate, _1,shoe,shoes', 12); # works
   $lh->maketext('my_internal_method'); # dies
 
-The blacklist() and whitelist() methods extend their internal lists
-whenever they are called. To reset the blacklist or whitelist, create
+The denylist() and allowlist() methods extend their internal lists
+whenever they are called. To reset the denylist or allowlist, create
 a new maketext object.
 
   my $lh = MyProgram::L10N->get_handle();
-  $lh->blacklist('numerate');
-  $lh->blacklist('numf');
+  $lh->denylist('numerate');
+  $lh->denylist('numf');
   $lh->maketext('_1 numerate,_1,shoe,shoes', 12); # dies
 
 For lexicons that use an internal cache, translations which have already
 been cached in their compiled form are not affected by subsequent changes
-to the whitelist or blacklist settings. Lexicons that use an external
-cache will have their cache cleared whenever the whitelist of blacklist
-setings change.  The difference between the two types of caching is explained
+to the allowlist or denylist settings. Lexicons that use an external
+cache will have their cache cleared whenever the allowlist or denylist
+settings change.  The difference between the two types of caching is explained
 in the "Readonly Lexicons" section.
 
-Methods disallowed by the blacklist cannot be permitted by the
-whitelist.
+Methods disallowed by the denylist cannot be permitted by the
+allowlist.
+
+NOTE: denylist() is the preferred method name to use instead of the
+historical and non-inclusive method blacklist(). blacklist() may be
+removed in a future release of this package and so it's use should be
+removed from usage.
+
+NOTE: allowlist() is the preferred method name to use instead of the
+historical and non-inclusive method whitelist(). whitelist() may be
+removed in a future release of this package and so it's use should be
+removed from usage.
 
 =head1 AUTO LEXICONS
 
@@ -981,7 +993,7 @@
   }
 
 Now, right after you've just written the above lines, you'd
-normally have to go open the file 
+normally have to go open the file
 ThisProject/I18N/en.pm, and immediately add an entry:
 
   "Couldn't find file \"_1\"!\n"
@@ -1212,7 +1224,7 @@
 
 =item *
 
-Go and write your program.  Everywhere in your program where 
+Go and write your program.  Everywhere in your program where
 you would say:
 
   print "Foobar $thing stuff\n";
@@ -1256,7 +1268,7 @@
 
 =item *
 
-You may at this point want to consider whether your base class 
+You may at this point want to consider whether your base class
 (Projname::L10N), from which all lexicons inherit from (Projname::L10N::en,
 Projname::L10N::es, etc.), should be an _AUTO lexicon.  It may be true
 that in theory, all needed messages will be in each language class;
@@ -1375,7 +1387,7 @@
 L<Locale::Maketext::TPJ13|Locale::Maketext::TPJ13> -- my I<The Perl
 Journal> article about Maketext.  It explains many important concepts
 underlying Locale::Maketext's design, and some insight into why
-Maketext is better than the plain old approach of having 
+Maketext is better than the plain old approach of having
 message catalogs that are just databases of sprintf formats.
 
 L<File::Findgrep|File::Findgrep> is a sample application/module

_service:tar_scm:Locale-Maketext-1.29.tar.gz/lib/Locale/Maketext/Cookbook.pod -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/lib/Locale/Maketext/Cookbook.pod Changed

@@ -18,7 +18,7 @@
 It may be common (for example at your main lexicon) that
 the hash keys and values coincide. Like that
 
-    q{Hello, tell me your name} 
+    q{Hello, tell me your name}
       => q{Hello, tell me your name}
 
 It would be nice to just write:
@@ -27,10 +27,10 @@
 
 and have this magically inflated to the first form.
 Among the advantages of such representation, that would
-lead to  
-smaller files, less prone to mistyping or mispasting, 
-and handy to someone translating it which can simply 
-copy the main lexicon and enter the translation 
+lead to 
+smaller files, less prone to mistyping or mispasting,
+and handy to someone translating it which can simply
+copy the main lexicon and enter the translation
 instead of having to remove the value first.
 
 That can be achieved by overriding C<init>
@@ -70,25 +70,25 @@
 
 I<After CPAN RT #36136 (L<https://rt.cpan.org/Ticket/Display.html?id=36136>)>
 
-The documentation of L<Locale::Maketext> advises that 
+The documentation of L<Locale::Maketext> advises that
 the standard bracket method C<numf> is limited and that
 you must override that for better results. It even
 suggests the use of L<Number::Format>.
 
 One such defect of standard C<numf> is to not be
 able to use a certain decimal precision.
-For example, 
+For example,
 
     $lh->maketext('pi is numf,_1', 355/113);
 
 outputs
 
-    pi is 3.14159292035398 
+    pi is 3.14159292035398
 
-Since pi ≈ 355/116 is only accurate 
+Since pi ≈ 355/116 is only accurate
 to 6 decimal places, you would want to say:
 
-    $lh->maketext('pi is numf,_1,6', 355/113); 
+    $lh->maketext('pi is numf,_1,6', 355/113);
 
 and get "pi is 3.141592".
 
@@ -132,14 +132,14 @@
 
     use base qw(Wuu);
 
-and then 
+and then
 
     my $lh = Wuu->get_handle('pt');
     $lh->maketext('A numf,_1,3 km de distância', 1550.2222);
 
 would return "A 1.550,222 km de distância".
 
-Notice that the standard utility methods of 
+Notice that the standard utility methods of
 C<Locale::Maketext> are irremediably limited
 because they could not aim to do everything
 that could be expected from them in different languages,

_service:tar_scm:Locale-Maketext-1.29.tar.gz/lib/Locale/Maketext/TPJ13.pod -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/lib/Locale/Maketext/TPJ13.pod Changed

@@ -237,7 +237,7 @@
 
 =over
 
-"It is more complicated than you think." 
+"It is more complicated than you think."
 
 -- The Eighth Networking Truth, from RFC 1925
 
@@ -460,13 +460,13 @@
 write only once the hairy code that, given a numeric value, would
 return some specification of which case and number a given quantified
 noun should use.  But suppose that you discover, while localizing an
-interface for, say, Ukranian (a Slavic language related to Russian,
+interface for, say, Ukrainian (a Slavic language related to Russian,
 spoken by several million people, many of whom would be relieved to
 find that your Web site's or software's interface is available in
-their language), that the rules in Ukranian are the same as in Russian
+their language), that the rules in Ukrainian are the same as in Russian
 for quantification, and probably for many other grammatical functions.
 While there may well be no phrases in common between Russian and
-Ukranian, you could still choose to have the Ukranian module inherit
+Ukrainian, you could still choose to have the Ukrainian module inherit
 from the Russian module, just for the sake of inheriting all the
 various grammatical methods.  Or, probably better organizationally,
 you could move those functions to a module called C<_E_Slavic> or

_service:tar_scm:Locale-Maketext-1.29.tar.gz/t/30_eval_dollar_at.t -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/t/30_eval_dollar_at.t Changed

_service:tar_scm:Locale-Maketext-1.29.tar.gz/t/40_super.t -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/t/40_super.t Changed

_service:tar_scm:Locale-Maketext-1.29.tar.gz/t/50_super.t -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/t/50_super.t Changed

_service:tar_scm:Locale-Maketext-1.29.tar.gz/t/70_fail_auto.t -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/t/70_fail_auto.t Changed

_service:tar_scm:Locale-Maketext-1.29.tar.gz/t/92_blacklist.t -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/t/92_blacklist.t Changed

@@ -48,46 +48,46 @@
 # get_handle blocked by default
 $res = eval { $lh->maketext('get_handle,en') };
 is( $res, undef, 'no return value from blocked expansion' );
-like( $@, qr/Can't use .* as a method name/, 'get_handle blocked in bracket notation by default blacklist' );
+like( $@, qr/Can't use .* as a method name/, 'get_handle blocked in bracket notation by default denylist' );
 
 # _ambient_langprefs blocked by default
 $res = eval { $lh->maketext('_ambient_langprefs') };
 is( $res, undef, 'no return value from blocked expansion' );
-like( $@, qr/Can't use .* as a method name/, '_ambient_langprefs blocked in bracket notation by default blacklist' );
+like( $@, qr/Can't use .* as a method name/, '_ambient_langprefs blocked in bracket notation by default denylist' );
 
 # _internal_method not blocked by default
 $res = eval { $lh->maketext('_internal_method') };
-is( $res, "_internal_method_response", '_internal_method allowed in bracket notation by default blacklist' );
-is( $@, '', 'no exception thrown by use of _internal_method under default blacklist' );
+is( $res, "_internal_method_response", '_internal_method allowed in bracket notation by default denylist' );
+is( $@, '', 'no exception thrown by use of _internal_method under default denylist' );
 
 # sprintf not blocked by default
 $res = eval { $lh->maketext('sprintf,%s,hello') };
-is( $res, "hello", 'sprintf allowed in bracket notation by default blacklist' );
-is( $@,   '',      'no exception thrown by use of sprintf under default blacklist' );
+is( $res, "hello", 'sprintf allowed in bracket notation by default denylist' );
+is( $@,   '',      'no exception thrown by use of sprintf under default denylist' );
 
-# blacklisting sprintf and numerate
+# denylisting sprintf and numerate
 $lh->blacklist( 'sprintf', 'numerate' );
 
-# sprintf blocked by custom blacklist
+# sprintf blocked by custom denylist
 $res = eval { $lh->maketext('sprintf,%s,hello') };
 is( $res, undef, 'no return value from blocked expansion' );
-like( $@, qr/Can't use .* as a method name/, 'sprintf blocked in bracket notation by custom blacklist' );
+like( $@, qr/Can't use .* as a method name/, 'sprintf blocked in bracket notation by custom denylist' );
 
-# blacklisting numf and _internal_method
+# denylisting numf and _internal_method
 $lh->blacklist('numf');
 $lh->blacklist('_internal_method');
 
-# sprintf blocked by custom blacklist
+# sprintf blocked by custom denylist
 $res = eval { $lh->maketext('sprintf,%s,hello') };
 is( $res, undef, 'no return value from blocked expansion' );
-like( $@, qr/Can't use .* as a method name/, 'sprintf blocked in bracket notation by custom blacklist after extension of blacklist' );
+like( $@, qr/Can't use .* as a method name/, 'sprintf blocked in bracket notation by custom denylist after extension of denylist' );
 
-# _internal_method blocked by custom blacklist
+# _internal_method blocked by custom denylist
 $res = eval { $lh->maketext('_internal_method') };
 is( $res, undef, 'no return value from blocked expansion' );
-like( $@, qr/Can't use .* as a method name/, 'sprintf blocked in bracket notation by custom blacklist after extension of blacklist' );
+like( $@, qr/Can't use .* as a method name/, 'sprintf blocked in bracket notation by custom denylist after extension of denylist' );
 
-# custom_handler not in default or custom blacklist
+# custom_handler not in default or custom denylist
 $res = eval { $lh->maketext('custom_handler') };
-is( $res, "custom_handler_response", 'custom_handler allowed in bracket notation by default and custom blacklists' );
-is( $@, '', 'no exception thrown by use of custom_handler under default and custom blacklists' );
+is( $res, "custom_handler_response", 'custom_handler allowed in bracket notation by default and custom denylist' );
+is( $@, '', 'no exception thrown by use of custom_handler under default and custom denylist' );

_service:tar_scm:Locale-Maketext-1.29.tar.gz/t/93_whitelist.t -> _service:tar_scm:Locale-Maketext-1.33.tar.gz/t/93_whitelist.t Changed

@@ -47,50 +47,50 @@
 
 # _internal_method not blocked by default
 $res = eval { $lh->maketext('_internal_method') };
-is( $res, "_internal_method_response", '_internal_method allowed when no whitelist defined' );
-is( $@, '', 'no exception thrown by use of _internal_method without whitelist setting' );
+is( $res, "_internal_method_response", '_internal_method allowed when no allowlist defined' );
+is( $@, '', 'no exception thrown by use of _internal_method without allowlist setting' );
 
-# whitelisting sprintf
+# allowlisting sprintf
 $lh->whitelist('sprintf');
 
-# _internal_method blocked by whitelist
+# _internal_method blocked by allowlist
 $res = eval { $lh->maketext('_internal_method') };
 is( $res, undef, 'no return value from blocked expansion' );
-like( $@, qr/Can't use .* as a method name/, '_internal_method blocked in bracket notation by whitelist' );
+like( $@, qr/Can't use .* as a method name/, '_internal_method blocked in bracket notation by allowlist' );
 
-# sprintf allowed by whitelist
+# sprintf allowed by allowlist
 $res = eval { $lh->maketext('sprintf,%s,hello') };
-is( $res, "hello", 'sprintf allowed in bracket notation by whitelist' );
-is( $@,   '',      'no exception thrown by use of sprintf with whitelist' );
+is( $res, "hello", 'sprintf allowed in bracket notation by allowlist' );
+is( $@,   '',      'no exception thrown by use of sprintf with allowlist' );
 
-# custom_handler blocked by whitelist
+# custom_handler blocked by allowlist
 $res = eval { $lh->maketext('custom_handler') };
 is( $res, undef, 'no return value from blocked expansion' );
-like( $@, qr/Can't use .* as a method name/, 'custom_handler blocked in bracket notation by whitelist' );
+like( $@, qr/Can't use .* as a method name/, 'custom_handler blocked in bracket notation by allowlist' );
 
-# adding custom_handler to whitelist
+# adding custom_handler to allowlist
 $lh->whitelist('custom_handler');
 
-# sprintf still allowed by whitelist
+# sprintf still allowed by allowlist
 $res = eval { $lh->maketext('sprintf,%s,hello') };
-is( $res, "hello", 'sprintf allowed in bracket notation by whitelist' );
-is( $@,   '',      'no exception thrown by use of sprintf with whitelist' );
+is( $res, "hello", 'sprintf allowed in bracket notation by allowlist' );
+is( $@,   '',      'no exception thrown by use of sprintf with allowlist' );
 
-# custom_handler allowed by whitelist
+# custom_handler allowed by allowlist
 $res = eval { $lh->maketext('custom_handler') };
-is( $res, "custom_handler_response", 'custom_handler allowed in bracket notation by whitelist' );
-is( $@, '', 'no exception thrown by use of custom_handler with whitelist' );
+is( $res, "custom_handler_response", 'custom_handler allowed in bracket notation by allowlist' );
+is( $@, '', 'no exception thrown by use of custom_handler with allowlist' );
 
-# _internal_method blocked by whitelist
+# _internal_method blocked by allowlist
 $res = eval { $lh->maketext('_internal_method') };
 is( $res, undef, 'no return value from blocked expansion' );
-like( $@, qr/Can't use .* as a method name/, '_internal_method blocked in bracket notation by whitelist' );
+like( $@, qr/Can't use .* as a method name/, '_internal_method blocked in bracket notation by allowlist' );
 
-# adding fail_with to whitelist
+# adding fail_with to allowlist
 $lh->whitelist('fail_with');
 
 # fail_with still blocked by blacklist
 $res = eval { $lh->maketext('fail_with,xyzzy') };
 is( $res, undef, 'no return value from blocked expansion' );
-like( $@, qr/Can't use .* as a method name/, 'fail_with blocked in bracket notation by blacklist even when whitelisted' );
+like( $@, qr/Can't use .* as a method name/, 'fail_with blocked in bracket notation by blacklist even when allowlisted' );

_service:tar_scm:Locale-Maketext-1.33.tar.gz/t/94_denylist.t Added

@@ -0,0 +1,93 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use warnings;
+use Test::More tests => 17;
+
+BEGIN {
+    use_ok("Locale::Maketext");
+}
+
+{
+
+    package MyTestLocale;
+    no warnings 'once';
+
+    @MyTestLocale::ISA     = qw(Locale::Maketext);
+    %MyTestLocale::Lexicon = ();
+}
+
+{
+
+    package MyTestLocale::en;
+    no warnings 'once';
+
+    @MyTestLocale::en::ISA = qw(MyTestLocale);
+
+    %MyTestLocale::en::Lexicon = ( '_AUTO' => 1 );
+
+    sub custom_handler {
+        return "custom_handler_response";
+    }
+
+    sub _internal_method {
+        return "_internal_method_response";
+    }
+
+    sub new {
+        my ( $class, @args ) = @_;
+        my $lh = $class->SUPER::new(@args);
+        $lh->{use_external_lex_cache} = 1;
+        return $lh;
+    }
+}
+
+my $lh = MyTestLocale->get_handle('en');
+my $res;
+
+# get_handle blocked by default
+$res = eval { $lh->maketext('get_handle,en') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, 'get_handle blocked in bracket notation by default denylist' );
+
+# _ambient_langprefs blocked by default
+$res = eval { $lh->maketext('_ambient_langprefs') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, '_ambient_langprefs blocked in bracket notation by default denylist' );
+
+# _internal_method not blocked by default
+$res = eval { $lh->maketext('_internal_method') };
+is( $res, "_internal_method_response", '_internal_method allowed in bracket notation by default denylist' );
+is( $@, '', 'no exception thrown by use of _internal_method under default denylist' );
+
+# sprintf not blocked by default
+$res = eval { $lh->maketext('sprintf,%s,hello') };
+is( $res, "hello", 'sprintf allowed in bracket notation by default denylist' );
+is( $@,   '',      'no exception thrown by use of sprintf under default denylist' );
+
+# denylisting sprintf and numerate
+$lh->denylist( 'sprintf', 'numerate' );
+
+# sprintf blocked by custom denylist
+$res = eval { $lh->maketext('sprintf,%s,hello') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, 'sprintf blocked in bracket notation by custom denylist' );
+
+# denylisting numf and _internal_method
+$lh->denylist('numf');
+$lh->denylist('_internal_method');
+
+# sprintf blocked by custom denylist
+$res = eval { $lh->maketext('sprintf,%s,hello') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, 'sprintf blocked in bracket notation by custom denylist after extension of denylist' );
+
+# _internal_method blocked by custom denylist
+$res = eval { $lh->maketext('_internal_method') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, 'sprintf blocked in bracket notation by custom denylist after extension of denylist' );
+
+# custom_handler not in default or custom denylist
+$res = eval { $lh->maketext('custom_handler') };
+is( $res, "custom_handler_response", 'custom_handler allowed in bracket notation by default and custom denylist' );
+is( $@, '', 'no exception thrown by use of custom_handler under default and custom denylist' );

_service:tar_scm:Locale-Maketext-1.33.tar.gz/t/95_allowlist.t Added

@@ -0,0 +1,96 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use warnings;
+use Test::More tests => 17;
+
+BEGIN {
+    use_ok("Locale::Maketext");
+}
+
+{
+
+    package MyTestLocale;
+    no warnings 'once';
+
+    @MyTestLocale::ISA     = qw(Locale::Maketext);
+    %MyTestLocale::Lexicon = ();
+}
+
+{
+
+    package MyTestLocale::en;
+    no warnings 'once';
+
+    @MyTestLocale::en::ISA = qw(MyTestLocale);
+
+    %MyTestLocale::en::Lexicon = ( '_AUTO' => 1 );
+
+    sub custom_handler {
+        return "custom_handler_response";
+    }
+
+    sub _internal_method {
+        return "_internal_method_response";
+    }
+
+    sub new {
+        my ( $class, @args ) = @_;
+        my $lh = $class->SUPER::new(@args);
+        $lh->{use_external_lex_cache} = 1;
+        return $lh;
+    }
+}
+
+my $lh = MyTestLocale->get_handle('en');
+my $res;
+
+# _internal_method not blocked by default
+$res = eval { $lh->maketext('_internal_method') };
+is( $res, "_internal_method_response", '_internal_method allowed when no allowlist defined' );
+is( $@, '', 'no exception thrown by use of _internal_method without allowlist setting' );
+
+# allowlisting sprintf
+$lh->allowlist('sprintf');
+
+# _internal_method blocked by allowlist
+$res = eval { $lh->maketext('_internal_method') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, '_internal_method blocked in bracket notation by allowlist' );
+
+# sprintf allowed by allowlist
+$res = eval { $lh->maketext('sprintf,%s,hello') };
+is( $res, "hello", 'sprintf allowed in bracket notation by allowlist' );
+is( $@,   '',      'no exception thrown by use of sprintf with allowlist' );
+
+# custom_handler blocked by allowlist
+$res = eval { $lh->maketext('custom_handler') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, 'custom_handler blocked in bracket notation by allowlist' );
+
+# adding custom_handler to allowlist
+$lh->allowlist('custom_handler');
+
+# sprintf still allowed by allowlist
+$res = eval { $lh->maketext('sprintf,%s,hello') };
+is( $res, "hello", 'sprintf allowed in bracket notation by allowlist' );
+is( $@,   '',      'no exception thrown by use of sprintf with allowlist' );
+
+# custom_handler allowed by allowlist
+$res = eval { $lh->maketext('custom_handler') };
+is( $res, "custom_handler_response", 'custom_handler allowed in bracket notation by allowlist' );
+is( $@, '', 'no exception thrown by use of custom_handler with allowlist' );
+
+# _internal_method blocked by allowlist
+$res = eval { $lh->maketext('_internal_method') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, '_internal_method blocked in bracket notation by allowlist' );
+
+# adding fail_with to allowlist
+$lh->allowlist('fail_with');
+
+# fail_with still blocked by denylist
+$res = eval { $lh->maketext('fail_with,xyzzy') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, 'fail_with blocked in bracket notation by denylist even when allowlisted' );
+

Changes of Revision 3