r4554 - in /packages/liblocale-maketext-fuzzy-perl: ./ branches/ branches/upstream/ branches/upstream/current/ branches/upstream/current/lib/ branches/upstream/current/lib/Locale/ branches/upstream/current/lib/Locale/Maketext/ branches/upstream/current/t/ tags/

ntyni-guest at users.alioth.debian.org ntyni-guest at users.alioth.debian.org
Mon Dec 4 22:38:42 CET 2006


Author: ntyni-guest
Date: Mon Dec  4 22:38:41 2006
New Revision: 4554

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=4554
Log:
[svn-inject] Installing original source of liblocale-maketext-fuzzy-perl

Added:
    packages/liblocale-maketext-fuzzy-perl/
    packages/liblocale-maketext-fuzzy-perl/branches/
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/Changes
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/MANIFEST
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/Makefile.PL
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/README
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/SIGNATURE
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/lib/
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/lib/Locale/
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/lib/Locale/Maketext/
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/lib/Locale/Maketext/Fuzzy.pm
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/t/
    packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/t/1-basic.t
    packages/liblocale-maketext-fuzzy-perl/tags/

Added: packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/Changes?rev=4554&op=file
==============================================================================
--- packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/Changes (added)
+++ packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/Changes Mon Dec  4 22:38:41 2006
@@ -1,0 +1,18 @@
+____________________________________________________________________________
+[  1124] By: autrijus                              on 2002/10/01  07:37:28
+        Log: * 0.02.
+             * no interpolation on failed matches; this makes normal strings with brackets possible.
+	   ! lib/Locale/Maketext/Fuzzy.pm t/1-basic.t
+____________________________________________________________________________
+[   602] By: autrijus                              on 2002/08/13  13:41:06
+        Log: * add manifest.
+	   + MANIFEST
+____________________________________________________________________________
+[   561] By: autrijus                              on 2002/08/02  13:24:28
+        Log: * minor reformatting
+	   ! lib/Locale/Maketext/Fuzzy.pm
+____________________________________________________________________________
+[   544] By: autrijus                              on 2002/08/02  04:24:50
+        Log: * initial checking of ::Fuzzy.
+	   + Changes Makefile.PL README lib/Locale/Maketext/Fuzzy.pm
+	   + t/1-basic.t

Added: packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/MANIFEST?rev=4554&op=file
==============================================================================
--- packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/MANIFEST (added)
+++ packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/MANIFEST Mon Dec  4 22:38:41 2006
@@ -1,0 +1,7 @@
+Changes
+MANIFEST			This list of files
+Makefile.PL
+README
+SIGNATURE
+lib/Locale/Maketext/Fuzzy.pm
+t/1-basic.t

Added: packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/Makefile.PL?rev=4554&op=file
==============================================================================
--- packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/Makefile.PL Mon Dec  4 22:38:41 2006
@@ -1,0 +1,27 @@
+#!/usr/bin/perl
+# $File: //member/autrijus/Locale-Maketext-Fuzzy/Makefile.PL $ $Author: autrijus $
+# $Revision: #1 $ $Change: 544 $ $DateTime: 2002/08/01 21:24:50 $
+
+require 5.005;
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    AUTHOR		=> 'Autrijus Tang (autrijus at autrijus.org)',
+    ABSTRACT		=> 'Maketext from already interpolated strings',
+    NAME		=> 'Locale::Maketext::Fuzzy',
+    VERSION_FROM	=> 'lib/Locale/Maketext/Fuzzy.pm', 
+    DISTNAME		=> 'Locale-Maketext-Fuzzy',
+    BINARY_LOCATION	=> 'x86/Locale-Maketext-Fuzzy.tar.gz',
+
+    PREREQ_PM		=> {
+	'Test::More'		=> '0.01',
+	'Locale::Maketext'	=> '0.01',
+    },
+
+    dist		=> {
+        COMPRESS	=> 'gzip',
+        SUFFIX		=> '.gz',
+    },
+);
+

Added: packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/README?rev=4554&op=file
==============================================================================
--- packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/README (added)
+++ packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/README Mon Dec  4 22:38:41 2006
@@ -1,0 +1,24 @@
+# $File: //member/autrijus/Locale-Maketext-Fuzzy/README $ $Author: autrijus $
+# $Revision: #1 $ $Change: 544 $ $DateTime: 2002/08/01 21:24:50 $
+
+This is the README file for Locale::Maketext::Fuzzy, a subclass of
+Locale::Maketext with additional support for localizing messages that
+already contains interpolated variables. 
+
+* Installation
+
+Locale::Maketext::Fuzzy uses the standard perl module install process:
+
+perl Makefile.PL
+make
+make test
+make install
+
+* Copyright
+
+Copyright 2002 by Autrijus Tang <autrijus at autrijus.org>.
+
+All rights reserved.  You can redistribute and/or modify
+this bundle under the same terms as Perl itself.
+
+See <http://www.perl.com/perl/misc/Artistic.html>.

Added: packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/SIGNATURE?rev=4554&op=file
==============================================================================
--- packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/SIGNATURE (added)
+++ packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/SIGNATURE Mon Dec  4 22:38:41 2006
@@ -1,0 +1,29 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.06.
+
+To verify the content in this distribution, first make sure you have
+Module::Signature installed, then type:
+
+    % cpansign -v
+
+It would check each file's integrity, as well as the signature's
+validity.  If "==> Signature verified OK! <==" is not displayed,
+the distribution may already have been compromised, and you should
+not run its Makefile.PL or Build.PL.
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+SHA1 f3aa637c4ad1fb3577ef85fa37ebe409675eb9b9 Changes
+SHA1 f9c4eb48cc9bcd77333816a889a305dbf11c1e27 MANIFEST
+SHA1 5ebebcdb55122fe1ae5e3ede248dd9cdc2b855b8 Makefile.PL
+SHA1 e865f49b37427349260d82ce3c84ec0859f9ce47 README
+SHA1 a04a489140f46cc9b74dfcec58178a1ecd881d07 lib/Locale/Maketext/Fuzzy.pm
+SHA1 c9c37ecbb7edc30c7cd0129e3b3eeeb36d9b115b t/1-basic.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.0.7 (FreeBSD)
+
+iD8DBQE9mVZBtLPdNzw1AaARAge6AJ4gkZ5D2/t18unLCiIkELgBhsexHgCfX3xM
+ddd15kdy6q6comRBao3mZwI=
+=aZIv
+-----END PGP SIGNATURE-----

Added: packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/lib/Locale/Maketext/Fuzzy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/lib/Locale/Maketext/Fuzzy.pm?rev=4554&op=file
==============================================================================
--- packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/lib/Locale/Maketext/Fuzzy.pm (added)
+++ packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/lib/Locale/Maketext/Fuzzy.pm Mon Dec  4 22:38:41 2006
@@ -1,0 +1,321 @@
+# $File: //member/autrijus/Locale-Maketext-Fuzzy/lib/Locale/Maketext/Fuzzy.pm $ $Author: autrijus $
+# $Revision: #4 $ $Change: 1124 $ $DateTime: 2002/10/01 07:37:28 $
+
+package Locale::Maketext::Fuzzy;
+$Locale::Maketext::Fuzzy::VERSION = '0.02';
+
+use strict;
+use Locale::Maketext;
+use base 'Locale::Maketext';
+
+=head1 NAME
+
+Locale::Maketext::Fuzzy - Maketext from already interpolated strings
+
+=head1 VERSION
+
+This document describes version 0.02 of Locale::Maketext::Fuzzy.
+
+=head1 SYNOPSIS
+
+    package MyApp::L10N;
+    use base 'Locale::Maketext::Fuzzy'; # instead of Locale::Maketext
+
+    package MyApp::L10N::de;
+    use base 'MyApp::L10N';
+    our %Lexicon = (
+	# Exact match should always be preferred if possible
+	"0 camels were released."
+	    => "Exact match",
+
+	# Fuzzy match candidate
+	"[quant,_1,camel was,camels were] released."
+	    => "[quant,_1,Kamel wurde,Kamele wurden] freigegeben.",
+
+	# This could also match fuzzily, but is less preferred
+	"[_2] released[_1]"
+	    => "[_1][_2] ist frei[_1]",
+    );
+
+    package main;
+    my $lh = MyApp::L10N->get_handle('de');
+
+    # All ->maketext calls below will become ->maketext_fuzzy instead
+    $lh->override_maketext(1);
+
+    # This prints "Exact match"
+    print $lh->maketext('0 camels were released.');
+
+    # "1 Kamel wurde freigegeben." -- quant() gets 1
+    print $lh->maketext('1 camel was released.');
+
+    # "2 Kamele wurden freigegeben." -- quant() gets 2
+    print $lh->maketext('2 camels were released.');
+
+    # "3 Kamele wurden freigegeben." -- parameters are ignored
+    print $lh->maketext('3 released.');
+
+    # "4 Kamele wurden freigegeben." -- normal usage
+    print $lh->maketext('[*,_1,camel was,camels were] released.', 4);
+
+    # "!Perl ist frei!" -- matches the broader one
+    # Note that the sequence ([_2] before [_1]) is preserved
+    print $lh->maketext('Perl released!');
+
+=head1 DESCRIPTION
+
+This module is a subclass of C<Locale::Maketext>, with additional
+support for localizing messages that already contains interpolated
+variables.  This is most useful when the messages are returned by
+external modules -- for example, to match C<dir: command not found>
+against C<[_1]: command not found>.
+
+Of course, this module is also useful if you're simply too lazy
+to use the
+
+    $lh->maketext("[quant,_1,file,files] deleted.", $count);
+
+syntax, but wish to write
+
+    $lh->maketext_fuzzy("$count files deleted");
+
+instead, and have the correct plural form figured out automatically.
+
+If C<maketext_fuzzy> seems too long to type for you, this module
+also provides a C<override_maketext> method to turn I<all> C<maketext>
+calls into C<maketext_fuzzy> calls.
+
+=head1 METHODS
+
+=head2 $lh->maketext_fuzzy(I<key>[, I<parameters...>]);
+
+That method takes exactly the same arguments as the C<maketext> method
+of C<Locale::Maketext>.
+
+If I<key> is found in lexicons, it is applied in the same way as
+C<maketext>.  Otherwise, it looks at all lexicon entries that could
+possibly yield I<key>, by turning C<[...]> sequences into C<(.*?)> and
+match the resulting regular expression against I<key>.
+
+Once it finds all candidate entries, the longest one replaces the
+I<key> for the real C<maketext> call.  Variables matched by its bracket
+sequences (C<$1>, C<$2>...) are placed before I<parameters>; the order
+of variables in the matched entry are correctly preserved.
+
+For example, if the matched entry in C<%Lexicon> is C<Test [_1]>,
+this call:
+
+    $fh->maketext_fuzzy("Test string", "param");
+
+is equivalent to this:
+
+    $fh->maketext("Test [_1]", "string", "param");
+
+However, most of the time you won't need to supply I<parameters> to
+a C<maketext_fuzzy> call, since all parameters are already interpolated
+into the string.
+
+=head2 $lh->override_maketext([I<flag>]);
+
+If I<flag> is true, this accessor method turns C<$lh-E<gt>maketext>
+into an alias for C<$lh-E<gt>maketext_fuzzy>, so all consecutive
+C<maketext> calls in the C<$lh>'s packages are automatically fuzzy.
+A false I<flag> restores the original behaviour.  If the flag is not
+specified, returns the current status of override; the default is
+0 (no overriding).
+
+Note that this call only modifies the symbol table of the I<language
+class> that C<$lh> belongs to, so other languages are not affected.
+If you want to override all language handles in a certain application,
+try this:
+
+    MyApp::L10N->override_maketext(1);
+
+=head1 CAVEATS
+
+=over 4
+
+=item *
+
+The "longer is better" heuristic to determine the best match is
+reasonably good, but could certainly be improved.
+
+=item *
+
+Currently, C<"[quant,_1,file] deleted"> won't match C<"3 files deleted">;
+you'll have to write C<"[quant,_1,file,files] deleted"> instead, or
+simply use C<"[_1] file deleted"> as the lexicon key and put the correct
+plural form handling into the corresponding value.
+
+=item *
+
+When used in combination with C<Locale::Maketext::Lexicon>'s C<Tie>
+backend, all keys would be iterated over each time a fuzzy match is
+performed, and may cause serious speed penalty.  Patches welcome.
+
+=back
+
+=cut
+
+sub override_maketext {
+    my ($class, $flag) = @_;
+    $class = ref($class) if ref($class);
+
+    no strict 'refs';
+
+    if ($flag) {
+	*{"$class\::maketext"} = \&maketext_fuzzy;
+    }
+    elsif (@_ >= 2) {
+	delete ${"$class\::"}{maketext};
+    }
+
+    return (defined &{"$class\::maketext"} ? 1 : 0);
+}
+
+# Global cache of entries and their regexified forms
+my %regex_cache;
+
+sub maketext_fuzzy {
+    my ($handle, $phrase) = splice(@_, 0, 2);
+
+    # An array of all lexicon hashrefs
+    my @lexicons = @{$handle->_lex_refs};
+
+    # Try exact match if possible at all.
+    foreach my $lex (@lexicons) {
+	return $handle->SUPER::maketext($phrase, @_)
+	    if exists $lex->{$phrase};
+    }
+
+    # Keys are matched entries; values are arrayrefs of extracted params
+    my %candidate;
+
+    # Fuzzy match phase 1 -- extract all candidates
+    foreach my $lex (@lexicons) {
+	# We're not interested in non-bracketed entries, so ignore them
+	foreach my $entry (grep /(?:(?<!~)(?:~~)*)\[/, keys %{$lex}) {
+	    my $re = ($regex_cache{$entry} ||= [ _regexify($entry) ]);
+	    my @vars = ($phrase =~ $re->[0]) or next;
+	    $candidate{$entry} ||= (
+		@{$re->[1]} ? [ @vars[@{$re->[1]}] ] : \@vars
+	    );
+	}
+    }
+
+    # Fail early if we cannot find anything that matches
+    return $phrase unless %candidate;
+
+    # Fuzzy match phase 2 -- select the best candidate
+    $phrase = (sort {
+	# For now, we just use a very crude heuristic: "Longer is better"
+	length($b) <=> length($a)
+	    or $b cmp $a
+    } keys %candidate)[0];
+
+    return $handle->SUPER::maketext(
+	$phrase, @{$candidate{$phrase}}, @_
+    );
+}
+
+sub _regexify {
+    my $text = quotemeta(shift);
+    my @ords;
+
+    $text =~ s{
+	(				# capture into $1...
+	    (?<!\\~)(?:\\~\\~)*		#   an even number of ~ characters
+	)				#   (to be restored back)
+	\\\[				# opening bracket
+
+	(				# capture into $2...
+	    (?:				#   any numbers of
+		[^~\]]			#     ordinary non-] characters
+		    |			#       or
+		~\\?.			#     escaped characters
+	    )*
+	)
+	\\\]				# closing bracket
+    }{
+	$1._paramify($2, \@ords)
+    }egx;
+
+    $text =~ s/\Q.*?\E$/.*/;
+    return qr/^$text$/, \@ords;
+}
+
+sub _paramify {
+    my ($text, $ordref) = @_;
+    my $out = '(.*?)';
+    my @choices = split(/\\,/, $text);
+
+    if ($choices[0] =~ /^(?:\w+|\\#|\\\*)$/) {
+	# Do away with the function name
+	shift @choices unless $choices[0] =~ /^_(?:\d+|\\\*)$/;
+
+	# Build an alternate regex to weed out vars
+	$out .= '(?:' . join(
+	    '|', sort {
+		length($b) <=> length($a)	# longest first
+	    } map {
+		/^_(?:(\d+)|\\\*)$/ ? do {
+		    push @{$ordref}, ($1 - 1) if defined $1;
+		    '';
+		} : $_	# turn _1, _2, _*... into ''
+	    } @choices
+	) . ')';
+
+	$out =~ s/\Q(?:)\E$//;
+    }
+
+    return $out;
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<Locale::Maketext>, L<Locale::Maketext::Lexicon>
+
+=head1 BACKGROUND
+
+This particular module was written to facilitate an I<auto-extraction>
+layer for Slashcode's I<Template Toolkit> provider, based on
+C<HTML::Parser> and C<Template::Parser>.  It would work like this:
+
+    Input | <B>from the [% story.dept %] dept.</B>
+    Output| <B>[%|loc( story.dept )%]from the [_1] dept.[%END%]</B>
+
+Now, this layer suffers from the same linguistic problems as an
+ordinary C<Msgcat> or C<Gettext> framework does -- what if we want
+to make ordinates from C<[% story.dept %]> (i.e. C<from the 3rd dept.>),
+or expand the C<dept.> to C<department> / C<departments>?
+
+The same problem occurred in RT's web interface, where it had to
+localize messages returned by external modules, which may already
+contain interpolated variables, e.g. C<"Successfully deleted 7
+ticket(s) in 'c:\temp'.">.
+
+Since I didn't have the time to refactor C<DBI> and C<DBI::SearchBuilder>,
+I devised a C<loc_match> method to pre-process their messages into one
+of the I<candidate strings>, then applied the matched string to C<maketext>.
+
+Afterwards, I realized that instead of preparing a set of candidate
+strings, I could actually use the original I<lexicon file> (i.e. PO files
+via C<Locale::Maketext::Lexicon>) to match against.  This is how
+C<Locale::Maketext::Fuzzy> was born.
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2002 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or 
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut

Added: packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/t/1-basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/t/1-basic.t?rev=4554&op=file
==============================================================================
--- packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/t/1-basic.t (added)
+++ packages/liblocale-maketext-fuzzy-perl/branches/upstream/current/t/1-basic.t Mon Dec  4 22:38:41 2006
@@ -1,0 +1,88 @@
+#!/usr/bin/perl -w
+# $File: //member/autrijus/Locale-Maketext-Fuzzy/t/1-basic.t $ $Author: autrijus $
+# $Revision: #2 $ $Change: 1124 $ $DateTime: 2002/10/01 07:37:28 $
+
+use strict;
+use Test::More tests => 15;
+
+package MyApp::L10N;
+use Test::More;
+use Locale::Maketext::Fuzzy;
+use_ok(base => 'Locale::Maketext::Fuzzy');
+
+package MyApp::L10N::de;
+use vars qw/@ISA %Lexicon/;
+
+ at ISA = 'MyApp::L10N';
+%Lexicon = (
+    # Exact match should always be preferred if possible
+    "0 camels were released."
+	=> "Exact match",
+    # Fuzzy match candidate
+    "[*,_1,camel was,camels were] released."
+	=> "[quant,_1,Kamel wurde,Kamele wurden] freigegeben.",
+    # This could also match fuzzily, but is less preferred
+    "[_2] released[_1]"
+	=> "[_1][_2] ist frei[_1]",
+);
+
+package main;
+
+################################################################
+
+ok(my $lh = MyApp::L10N->get_handle('de'), 'get_handle');
+
+is($lh->override_maketext, 0,		'override_maketext() is initially 0');
+is($lh->override_maketext(0), 0,	'override_maketext(0)');
+is($lh->override_maketext(1), 1,	'override_maketext(1)');
+is($lh->override_maketext(undef), 0,	'override_maketext(undef) is 0');
+is($lh->override_maketext(-1), 1,	'override_maketext(-1) is 1');
+is($lh->override_maketext, 1,		'override_maketext() is now 1');
+
+################################################################
+
+is(
+    $lh->maketext('0 camels were released.'),
+    'Exact match',
+    'exact match',
+);
+
+is(
+    $lh->maketext('1 camel was released.'),
+    '1 Kamel wurde freigegeben.',
+    'fuzzy match - singular',
+);
+
+is(
+    $lh->maketext('2 camels were released.'),
+    '2 Kamele wurden freigegeben.',
+    'fuzzy match - plural',
+);
+
+is(
+    $lh->maketext('3 released.'),
+    '3 Kamele wurden freigegeben.',
+    'fuzzy match - ignore parameters',
+);
+
+is(
+    $lh->maketext('[*,_1,camel was,camels were] released.', 4),
+    '4 Kamele wurden freigegeben.',
+    'exact match on the bracketed entry',
+);
+
+is(
+    $lh->maketext('[Perl] released!'),
+    '![Perl] ist frei!',
+    'fuzzy match on the broader candidate',
+);
+
+is(
+    eval { $lh->maketext('Square [bracket]!') },
+    'Square [bracket]!',
+    'no interpolation on failed matches',
+);
+
+################################################################
+
+1;




More information about the Pkg-perl-cvs-commits mailing list