diff options
author | Steve Peters <steve@fisharerojo.org> | 2008-05-29 13:45:43 +0000 |
---|---|---|
committer | Steve Peters <steve@fisharerojo.org> | 2008-05-29 13:45:43 +0000 |
commit | ad56049d11be2db6103b693e8b968b200a8d43bd (patch) | |
tree | d20dd3cb0f0c31331388625dbac1fa8ff5ae7767 /lib/Locale | |
parent | 2c476adc76fa529470c25a2721f54d8be0fabb12 (diff) | |
download | perl-ad56049d11be2db6103b693e8b968b200a8d43bd.tar.gz |
Upgrade to Locale-Maketext-1.13
p4raw-id: //depot/perl@33948
Diffstat (limited to 'lib/Locale')
-rw-r--r-- | lib/Locale/Maketext.pm | 54 | ||||
-rw-r--r-- | lib/Locale/Maketext/Guts.pm | 8 | ||||
-rw-r--r-- | lib/Locale/Maketext/GutsLoader.pm | 8 |
3 files changed, 37 insertions, 33 deletions
diff --git a/lib/Locale/Maketext.pm b/lib/Locale/Maketext.pm index c8ee463d37..eda9e97b1b 100644 --- a/lib/Locale/Maketext.pm +++ b/lib/Locale/Maketext.pm @@ -10,7 +10,7 @@ use I18N::LangTags 0.30 (); BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } } # define the constant 'DEBUG' at compile-time -$VERSION = '1.12'; +$VERSION = '1.13'; @ISA = (); $MATCH_SUPERS = 1; @@ -189,9 +189,9 @@ sub maketext { foreach my $h_r ( @{ $isa_scan{ref($handle) || $handle} || $handle->_lex_refs } ) { - DEBUG and print "* Looking up \"$phrase\" in $h_r\n"; + DEBUG and warn "* Looking up \"$phrase\" in $h_r\n"; if(exists $h_r->{$phrase}) { - DEBUG and print " Found \"$phrase\" in $h_r\n"; + DEBUG and warn " Found \"$phrase\" in $h_r\n"; unless(ref($value = $h_r->{$phrase})) { # Nonref means it's not yet compiled. Compile and replace. $value = $h_r->{$phrase} = $handle->_compile($value); @@ -200,7 +200,7 @@ sub maketext { } elsif($phrase !~ m/^_/s and $h_r->{'_AUTO'}) { # it's an auto lex, and this is an autoable key! - DEBUG and print " Automaking \"$phrase\" into $h_r\n"; + DEBUG and warn " Automaking \"$phrase\" into $h_r\n"; $value = $h_r->{$phrase} = $handle->_compile($phrase); last; @@ -210,9 +210,9 @@ sub maketext { } unless(defined($value)) { - DEBUG and print "! Lookup of \"$phrase\" in/under ", ref($handle) || $handle, " fails.\n"; + DEBUG and warn "! Lookup of \"$phrase\" in/under ", ref($handle) || $handle, " fails.\n"; if(ref($handle) and $handle->{'fail'}) { - DEBUG and print "WARNING0: maketext fails looking for <$phrase>\n"; + DEBUG and warn "WARNING0: maketext fails looking for <$phrase>\n"; my $fail; if(ref($fail = $handle->{'fail'}) eq 'CODE') { # it's a sub reference return &{$fail}($handle, $phrase, @_); @@ -264,7 +264,7 @@ sub get_handle { # This is a constructor and, yes, it CAN FAIL. # Complain if they use __PACKAGE__ as a project base class? if( @languages ) { - DEBUG and print 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; + DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; if($USING_LANGUAGE_TAGS) { # An explicit language-list was given! @languages = map {; $_, I18N::LangTags::alternate_language_tags($_) } @@ -274,7 +274,7 @@ sub get_handle { # This is a constructor and, yes, it CAN FAIL. # If it's a locale ID, try converting to a lg tag (untainted), # otherwise nix it. @languages; - DEBUG and print 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; + DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; } } else { @@ -302,19 +302,19 @@ sub _langtag_munging { # We have all these DEBUG statements because otherwise it's hard as hell # to diagnose ifwhen something goes wrong. - DEBUG and print 'Lgs1: ', map("<$_>", @languages), "\n"; + DEBUG and warn 'Lgs1: ', map("<$_>", @languages), "\n"; if($USING_LANGUAGE_TAGS) { - DEBUG and print 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; + DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; @languages = $base_class->_add_supers( @languages ); push @languages, I18N::LangTags::panic_languages(@languages); - DEBUG and print "After adding panic languages:\n", + DEBUG and warn "After adding panic languages:\n", ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; push @languages, $base_class->fallback_languages; # You are free to override fallback_languages to return empty-list! - DEBUG and print 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; + DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; @languages = # final bit of processing to turn them into classname things map { @@ -324,21 +324,21 @@ sub _langtag_munging { $it; } @languages ; - DEBUG and print "Nearing end of munging:\n", + DEBUG and warn "Nearing end of munging:\n", ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; } else { - DEBUG and print "Bypassing language-tags.\n", + DEBUG and warn "Bypassing language-tags.\n", ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; } - DEBUG and print "Before adding fallback classes:\n", + DEBUG and warn "Before adding fallback classes:\n", ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; push @languages, $base_class->fallback_language_classes; # You are free to override that to return whatever. - DEBUG and print "Finally:\n", + DEBUG and warn "Finally:\n", ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; return @languages; @@ -358,23 +358,23 @@ sub _add_supers { if (!$MATCH_SUPERS) { # Nothing - DEBUG and print "Bypassing any super-matching.\n", + DEBUG and warn "Bypassing any super-matching.\n", ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; } elsif( $MATCH_SUPERS_TIGHTLY ) { - DEBUG and print "Before adding new supers tightly:\n", + DEBUG and warn "Before adding new supers tightly:\n", ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; @languages = I18N::LangTags::implicate_supers( @languages ); - DEBUG and print "After adding new supers tightly:\n", + DEBUG and warn "After adding new supers tightly:\n", ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; } else { - DEBUG and print "Before adding supers to end:\n", + DEBUG and warn "Before adding supers to end:\n", ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; @languages = I18N::LangTags::implicate_supers_strictly( @languages ); - DEBUG and print "After adding supers to end:\n", + DEBUG and warn "After adding supers to end:\n", ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n"; } @@ -405,17 +405,17 @@ sub _try_use { # Basically a wrapper around "require Modulename" # weird case: we never use'd it, but there it is! } - DEBUG and print " About to use $module ...\n"; + DEBUG and warn " About to use $module ...\n"; { local $SIG{'__DIE__'}; eval "require $module"; # used to be "use $module", but no point in that. } if($@) { - DEBUG and print "Error using $module \: $@\n"; + DEBUG and warn "Error using $module \: $@\n"; return $tried{$module} = 0; } else { - DEBUG and print " OK, $module is used\n"; + DEBUG and warn " OK, $module is used\n"; return $tried{$module} = 1; } } @@ -427,7 +427,7 @@ sub _lex_refs { # report the lexicon references for this handle's class no strict 'refs'; no warnings 'once'; my $class = ref($_[0]) || $_[0]; - DEBUG and print "Lex refs lookup on $class\n"; + DEBUG and warn "Lex refs lookup on $class\n"; return $isa_scan{$class} if exists $isa_scan{$class}; # memoization! my @lex_refs; @@ -435,14 +435,14 @@ sub _lex_refs { # report the lexicon references for this handle's class if( defined( *{$class . '::Lexicon'}{'HASH'} )) { push @lex_refs, *{$class . '::Lexicon'}{'HASH'}; - DEBUG and print '%' . $class . '::Lexicon contains ', + DEBUG and warn '%' . $class . '::Lexicon contains ', scalar(keys %{$class . '::Lexicon'}), " entries\n"; } # Implements depth(height?)-first recursive searching of superclasses. # In hindsight, I suppose I could have just used Class::ISA! foreach my $superclass (@{$class . '::ISA'}) { - DEBUG and print " Super-class search into $superclass\n"; + DEBUG and warn " Super-class search into $superclass\n"; next if $seen_r->{$superclass}++; push @lex_refs, @{&_lex_refs($superclass, $seen_r)}; # call myself } diff --git a/lib/Locale/Maketext/Guts.pm b/lib/Locale/Maketext/Guts.pm index 132987fa4c..9af292c61c 100644 --- a/lib/Locale/Maketext/Guts.pm +++ b/lib/Locale/Maketext/Guts.pm @@ -1,5 +1,7 @@ package Locale::Maketext::Guts; +$VERSION = '1.13'; + BEGIN { # Just so we're nice and define SOMETHING in "our" package. *zorp = sub { return scalar @_ } unless defined &zorp; @@ -259,9 +261,9 @@ sub _compile { } die q{Last chunk isn't null??} if @c and length $c[-1]; # sanity - DEBUG and print scalar(@c), " chunks under closure\n"; + DEBUG and warn scalar(@c), " chunks under closure\n"; if(@code == 0) { # not possible? - DEBUG and print "Empty code\n"; + DEBUG and warn "Empty code\n"; return \''; } elsif(@code > 1) { # most cases, presumably! @@ -270,7 +272,7 @@ sub _compile { unshift @code, "use strict; sub {\n"; push @code, "}\n"; - DEBUG and print @code; + DEBUG and warn @code; my $sub = eval(join '', @code); die "$@ while evalling" . join('', @code) if $@; # Should be impossible. return $sub; diff --git a/lib/Locale/Maketext/GutsLoader.pm b/lib/Locale/Maketext/GutsLoader.pm index 67566ea630..daa9840260 100644 --- a/lib/Locale/Maketext/GutsLoader.pm +++ b/lib/Locale/Maketext/GutsLoader.pm @@ -1,5 +1,7 @@ package Locale::Maketext::GutsLoader; +$VERSION = '1.13'; + use strict; sub zorp { return scalar @_ } @@ -16,7 +18,7 @@ BEGIN { # $Locale::Maketext::GUTSPATH = ''; -Locale::Maketext::DEBUG and print "Requiring Locale::Maketext::Guts...\n"; +Locale::Maketext::DEBUG and warn "Requiring Locale::Maketext::Guts...\n"; eval 'require Locale::Maketext::Guts'; if ($@) { @@ -38,10 +40,10 @@ if ($@) { } eval $source; die "Can't compile $path\n...The error I got was:\n$@\nAborting" if $@; - Locale::Maketext::DEBUG and print "Non-utf8'd Locale::Maketext::Guts fine\n"; + Locale::Maketext::DEBUG and warn "Non-utf8'd Locale::Maketext::Guts fine\n"; } else { - Locale::Maketext::DEBUG and print "Loaded Locale::Maketext::Guts fine\n"; + Locale::Maketext::DEBUG and warn "Loaded Locale::Maketext::Guts fine\n"; } 1; |