* Move files to trunk

7 files changed, 1546 insertions, 0 deletions

diff --git a/lib/Locale/Maketext/Extract.pm b/lib/Locale/Maketext/Extract.pm
new file mode 100644
index 0000000..abb3904
--- /dev/null
+++ b/lib/Locale/Maketext/Extract.pm
@@ -0,0 +1,502 @@
+package Locale::Maketext::Extract;
+$Locale::Maketext::Extract::VERSION = '0.07';
+
+use strict;
+
+=head1 NAME
+
+Locale::Maketext::Extract - Extract translatable strings from source
+
+=head1 SYNOPSIS
+
+    my $Ext = Locale::Maketext::Extract->new;
+    $Ext->read_po('messages.po');
+    $Ext->extract_file($_) for <*.pl>;
+    $Ext->compile;
+    $Ext->write_po('messages.po');
+
+=head1 DESCRIPTION
+
+This module can extract translatable strings from files, and write
+them back to PO files.  It can also parse existing PO files and merge
+their contents with newly extracted strings.
+
+A command-line utility, L<xgettext.pl>, is installed with this module
+as well.
+
+Following formats of input files are supported:
+
+=over 4
+
+=item Perl source files
+
+Valid localization function names are: C<translate>, C<maketext>,
+C<gettext>, C<loc>, C<x>, C<_> and C<__>.
+
+=item HTML::Mason
+
+Strings inside C<E<lt>&|/lE<gt>I<...>E<lt>/&E<gt>> and
+C<E<lt>&|/locE<gt>I<...>E<lt>/&E<gt>> are extracted.
+
+=item Template Toolkit
+
+Strings inside C<[%|l%]...[%END%]> or C<[%|loc%]...[%END%]>
+are extracted.
+
+=item Text::Template
+
+Sentences between C<STARTxxx> and C<ENDxxx> are extracted individually.
+
+=item Generic Template
+
+Strings inside {{...}} are extracted.
+
+=back
+
+=head1 METHODS
+
+=head2 Constructor
+
+    new
+
+=cut
+
+sub new {
+    my $class = shift;
+    bless({ header => '', entries => {}, lexicon => {}, @_ }, $class);
+}
+
+=head2 Accessors
+
+    header, set_header
+    lexicon, set_lexicon, msgstr, set_msgstr
+    entries, set_entries, entry, add_entry, del_entry
+    clear
+
+=cut
+
+sub header { $_[0]{header} || _default_header() };
+sub set_header { $_[0]{header} = $_[1] };
+
+sub lexicon { $_[0]{lexicon} }
+sub set_lexicon { $_[0]{lexicon} = $_[1] || {}; delete $_[0]{lexicon}{''}; }
+
+sub msgstr { $_[0]{lexicon}{$_[1]} }
+sub set_msgstr { $_[0]{lexicon}{$_[1]} = $_[2] }
+
+sub entries { $_[0]{entries} }
+sub set_entries { $_[0]{entries} = $_[1] || {} }
+
+sub entry { @{$_[0]->entries->{$_[1]} || [] } }
+sub add_entry { push @{$_[0]->entries->{$_[1]}}, $_[2] }
+sub del_entry { delete $_[0]->entries->{$_[1]} }
+
+sub clear {
+    $_[0]->set_header;
+    $_[0]->set_lexicon;
+    $_[0]->set_entries;
+}
+
+=head2 PO File manipulation
+
+    read_po
+    write_po
+
+=cut
+
+sub read_po {
+    my ($self, $file, $verbatim) = @_;
+    my $header = '';
+
+    local *LEXICON;
+    open LEXICON, $file or die $!;
+    while (<LEXICON>) {
+        (1 .. /^$/) or last;
+        $header .= $_;
+    }
+    1 while chomp $header;
+
+    $self->set_header("$header\n");
+
+    require Locale::Maketext::Lexicon::Gettext;
+    my $lexicon = Locale::Maketext::Lexicon::Gettext->parse(<LEXICON>);
+
+    $self->set_lexicon(
+        $verbatim ? { map _to_gettext($_), %$lexicon } : $lexicon
+    );
+    close LEXICON;
+}
+
+sub write_po {
+    my ($self, $file, $add_format) = @_;
+
+    local *LEXICON;
+    open LEXICON, ">$file" or die "Can't write to $file$!\n";
+
+    print LEXICON $self->header;
+
+    my $sorter = {};
+
+    foreach my $msgid ($self->msgids) {
+        $sorter->{$self->msg_positions($msgid)} = $msgid;
+    }
+
+    foreach my $name (sort keys %$sorter) {
+        my $msgid = $sorter->{$name};
+        $self->normalize_space($msgid);
+        print LEXICON "\n#--------------------\n";
+        print LEXICON $self->msg_positions($msgid);
+        print LEXICON $self->msg_variables($msgid);
+        print LEXICON $self->msg_format($msgid) if $add_format;
+        print LEXICON $self->msg_out($msgid);
+    }
+}
+
+=head2 Extraction
+
+    extract
+    extract_file
+
+=cut
+
+use constant NUL  => 0;
+use constant BEG  => 1;
+use constant PAR  => 2;
+use constant QUO1 => 3;
+use constant QUO2 => 4;
+use constant QUO3 => 5;
+sub extract {
+    my $self = shift;
+    my $file = shift;
+    local $_ = shift;
+
+    my $entries = $self->entries;
+    my $line = 1; pos($_) = 0;
+
+    # Text::Template
+    if (/^STARTTEXT$/m and /^ENDTEXT$/m) {
+        require HTML::Parser;
+        require Lingua::EN::Sentence;
+
+        {
+            package MyParser;
+            @MyParser::ISA = 'HTML::Parser';
+            *{'text'} = sub {
+                my ($self, $str, $is_cdata) = @_;
+                my $sentences = Lingua::EN::Sentence::get_sentences($str) or return;
+                $str =~ s/\n/ /g; $str =~ s/^\s+//; $str =~ s/\s+$//;
+                $self->add_entry($str => [$file, $line]);
+            };
+        }
+
+        my $p = MyParser->new;
+        while (m/\G((.*?)^(?:START|END)[A-Z]+$)/smg) {
+            my ($str) = ($2);
+            $line += ( () = ($1 =~ /\n/g) ); # cryptocontext!
+            $p->parse($str); $p->eof;
+        }
+        $_ = '';
+    }
+
+    # HTML::Mason
+    $line = 1; pos($_) = 0;
+    while (m!\G(.*?<&\|/l(?:oc)?(.*?)&>(.*?)</&>)!sg) {
+        my ($vars, $str) = ($2, $3);
+        $line += ( () = ($1 =~ /\n/g) ); # cryptocontext!
+        $self->add_entry($str, [ $file, $line, $vars ]);
+    }
+
+    # Template Toolkit
+    $line = 1; pos($_) = 0;
+    while (m!\G(.*?\[%\s*\|l(?:oc)?(.*?)\s*%\](.*?)\[%\s*END\s*%\])!sg) {
+        my ($vars, $str) = ($2, $3);
+        $line += ( () = ($1 =~ /\n/g) ); # cryptocontext!
+        $vars =~ s/^\s*\(//;
+        $vars =~ s/\)\s*$//;
+        $self->add_entry($str, [ $file, $line, $vars ]);
+    }
+
+    # Generic Template:
+    $line = 1; pos($_) = 0;
+    while (m/\G(.*?(?<!\{)\{\{(?!\{)(.*?)\}\})/sg) {
+        my ($vars, $str) = ('', $2);
+        $line += ( () = ($1 =~ /\n/g) ); # cryptocontext!
+        $self->add_entry($str, [ $file, $line, $vars ]);
+    }
+
+    my $quoted = '(\')([^\\\']*(?:\\.[^\\\']*)*)(\')|(\")([^\\\"]*(?:\\.[^\\\"]*)*)(\")';
+
+    # Comment-based mark: "..." # loc
+    $line = 1; pos($_) = 0;
+    while (m/\G(.*?($quoted)[\}\)\],]*\s*\#\s*loc\s*$)/smog) {
+        my $str = substr($2, 1, -1);
+        $line += ( () = ( $1 =~ /\n/g ) );    # cryptocontext!
+        $str  =~ s/\\(["'])/$1/g;
+        $self->add_entry($str, [ $file, $line, '' ]);
+    }
+
+    # Comment-based pair mark: "..." => "..." # loc_pair
+    $line = 1; pos($_) = 0;
+    while (m/\G(.*?(\w+)\s*=>\s*($quoted)[\}\)\],]*\s*\#\s*loc_pair\s*$)/smg) {
+        my $key = $2;
+        my $val = substr($3, 1, -1);
+        $line += ( () = ( $1 =~ /\n/g ) );    # cryptocontext!
+        $key  =~ s/\\(["'])/$1/g;
+        $val  =~ s/\\(["'])/$1/g;
+        $self->add_entry($key, [ $file, $line, '' ]);
+        $self->add_entry($val, [ $file, $line, '' ]);
+    }
+
+    # Perl code:
+    my ($state,$str,$vars,$quo)=(0);
+    pos($_) = 0;
+    my $orig = 1 + (() = ((my $__ = $_) =~ /\n/g));
+
+    PARSER: {
+        $_ = substr($_, pos($_)) if (pos($_));
+        my $line = $orig - (() = ((my $__ = $_) =~ /\n/g));
+
+        # maketext or loc or _
+        $state == NUL && m/\b(translate|maketext|gettext|__?|loc|x)/gc
+                      && do { $state = BEG; redo };
+        $state == BEG && m/^([\s\t\n]*)/gc && redo;
+
+        # begin ()
+        $state == BEG && m/^([\S\(])\s*/gc
+                      && do { $state = ( ($1 eq '(') ? PAR : NUL); redo };
+
+        # begin or end of string
+        $state == PAR  && m/^(\')/gc      && do { $state = $quo = QUO1;   redo };
+        $state == QUO1 && m/^([^\']+)/gc  && do { $str  .= $1;            redo };
+        $state == QUO1 && m/^\'/gc        && do { $state = PAR;           redo };
+
+        $state == PAR  && m/^\"/gc        && do { $state = $quo = QUO2;   redo };
+        $state == QUO2 && m/^([^\"]+)/gc  && do { $str  .= $1;            redo };
+        $state == QUO2 && m/^\"/gc        && do { $state = PAR;           redo };
+
+        $state == PAR  && m/^\`/gc        && do { $state = $quo = QUO3;   redo };
+        $state == QUO3 && m/^([^\`]*)/gc  && do { $str  .= $1;            redo };
+        $state == QUO3 && m/^\`/gc        && do { $state = PAR;           redo };
+
+        # end ()
+        $state == PAR && m/^\s*[\)]/gc && do {
+            $state = NUL;
+            $vars =~ s/[\n\r]//g if ($vars);
+            if ($quo == QUO1) {
+                $str =~ s/\\([\\'])/$1/g; # normalize q strings
+            }
+            else {
+                $str =~ s/(\\(?:[0x]..|c?.))/"qq($1)"/eeg; # normalize qq / qx strings
+            }
+            push @{$entries->{$str}}, [ $file, $line - (() = $str =~ /\n/g), $vars] if ($str);
+            undef $str; undef $vars;
+            redo;
+        };
+
+        # a line of vars
+        $state == PAR && m/^([^\)]*)/gc && do { $vars .= "$1\n"; redo };
+    }
+}
+
+sub extract_file {
+    my ($self, $file) = @_;
+
+    local($/, *FH);
+    open FH, $file or die $!;
+    $self->extract($file => scalar <FH>);
+    close FH;
+}
+
+=head2 Compilation
+
+    compile
+    normalize_space
+
+=cut
+
+sub compile {
+    my ($self, $verbatim) = @_;
+    my $entries = $self->entries;
+    my $lexicon = $self->lexicon;
+
+    foreach my $str (sort keys %$entries) {
+        my $ostr    = $str;
+        my $entry   = $entries->{$str};
+        my $lexi    = $lexicon->{$ostr};
+
+        $str  = _to_gettext($str, $verbatim);
+        $lexi = _to_gettext($lexi, $verbatim);
+
+        $lexicon->{$str} ||= '';
+        next if $ostr eq $str;
+
+        $lexicon->{$str} ||= $lexi;
+        delete $entries->{$ostr}; delete $lexicon->{$ostr};
+        $entries->{$str} = $entry;
+    }
+
+    return %$lexicon;
+}
+
+my %Escapes = map {("\\$_" => eval("qq(\\$_)"))} qw(t r f b a e);
+sub normalize_space {
+    my ($self, $msgid) = @_;
+    my $nospace = $msgid;
+    $nospace =~ s/ +$//;
+
+    return unless (!$self->has_msgid($msgid) and $self->has_msgid($nospace));
+
+    $self->set_msgstr(
+        $msgid => $self->msgstr($nospace) .
+                    (' ' x (length($msgid) - length($nospace)))
+    );
+}
+
+=head2 Lexicon accessors
+
+    msgids, has_msgid,
+    msgstr, set_msgstr
+    msg_positions, msg_variables, msg_format, msg_out
+
+=cut
+
+sub msgids {
+    sort keys %{$_[0]{lexicon}}
+}
+sub has_msgid { length $_[0]->msgstr($_[1]) }
+
+sub msg_positions {
+    my ($self, $msgid) = @_;
+    my %files = (map { ( " $_->[0]:$_->[1]" => 1 ) } $self->entry($msgid));
+    return join('', '#:', sort(keys %files), "\n");
+}
+
+sub msg_variables {
+    my ($self, $msgid) = @_;
+    my $out = '';
+
+    my %seen;
+    foreach my $entry ( grep { $_->[2] } $self->entry($msgid) ) {
+        my ($file, $line, $var) = @$entry;
+        $var =~ s/^\s*,\s*//; $var =~ s/\s*$//;
+        $out .= "#. ($var)\n" unless !length($var) or $seen{$var}++;
+    }
+
+    return $out;
+}
+
+sub msg_format {
+    my ($self, $msgid) = @_;
+    return "#, perl-maketext-format\n" if $msgid =~ /%(?:\d|\w+\([^\)]*\))/;
+    return '';
+}
+
+sub msg_out {
+    my ($self, $msgid) = @_;
+
+    return "msgid "  . _format($msgid) .
+           "msgstr " . _format($self->msgstr($msgid));
+}
+
+=head2 Internal utilities
+
+    _default_header
+    _to_gettext
+    _escape
+    _format
+
+=cut
+
+sub _default_header {
+    return << '.';
+# SOME DESCRIPTIVE TITLE.
+# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER
+# This file is distributed under the same license as the PACKAGE package.
+# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
+#
+#, fuzzy
+msgid ""
+msgstr ""
+"Project-Id-Version: PACKAGE VERSION\n"
+"POT-Creation-Date: YEAR-MO-DA HO:MI+ZONE\n"
+"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
+"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
+"Language-Team: LANGUAGE <LL@li.org>\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=CHARSET\n"
+"Content-Transfer-Encoding: 8bit\n"
+.
+}
+
+sub _to_gettext {
+    my ($text, $verbatim) = @_;
+    return '' unless defined $text;
+
+    $text =~ s/\\/\\\\/g;
+    $text =~ s/\"/\\"/g;
+
+    while (my ($char, $esc) = each %Escapes) {
+        $text =~ s/$esc/$char/g;
+    }
+    return $text if $verbatim;
+
+    $text =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
+    $text =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/$1%$2("""$3""")/g;
+    $text = join('', map {
+        /^""".*"""$/ ? _escape(substr($_, 3, -3)) : $_
+    } split(/(""".*?""")/, $text));
+
+    $text =~ s/~([\~\[\]])/$1/g;
+    return $text;
+}
+
+sub _escape {
+    my $text = shift;
+    $text =~ s/\b_(\d+)/%$1/g;
+    return $text;
+}
+
+sub _format {
+    my $str = shift;
+    $str =~ s/\\/\\\\/g;
+    $str =~ s/"/\\"/g;
+    return "\"$str\"\n" unless $str =~ /\n/;
+    my $multi_line = ($str =~ /\n(?!\z)/);
+    $str =~ s/\n/\\n"\n"/g;
+    if ($str =~ /\n"$/) {
+        chop $str;
+    }
+    else {
+        $str .= "\"\n";
+    }
+    return $multi_line ? qq(""\n"$str) : qq("$str);
+}
+
+1;
+
+=head1 ACKNOWLEDGMENTS
+
+Thanks to Jesse Vincent for contributing to an early version of this
+module.
+
+Also to Alain Barbet, who effectively re-wrote the source parser with a
+flex-like algorithm.
+
+=head1 SEE ALSO
+
+L<xgettext.pl>, L<Locale::Maketext>, L<Locale::Maketext::Lexicon>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2003, 2004 by Autrijus Tang E<lt>autrijus@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
diff --git a/lib/Locale/Maketext/Extract/Run.pm b/lib/Locale/Maketext/Extract/Run.pm
new file mode 100644
index 0000000..f3ddd62
--- /dev/null
+++ b/lib/Locale/Maketext/Extract/Run.pm
@@ -0,0 +1,83 @@
+package Locale::Maketext::Extract::Run;
+
+use strict;
+use vars qw( @ISA @EXPORT_OK );
+
+use Cwd;
+use File::Find;
+use Getopt::Long;
+use Locale::Maketext::Extract;
+use Exporter;
+
+@ISA = 'Exporter';
+@EXPORT_OK = 'xgettext';
+
+sub xgettext { __PACKAGE__->run(@_) }
+
+sub run {
+    my $self = shift;
+    local @ARGV = @_;
+
+    my %opts;
+    Getopt::Long::Configure("no_ignore_case");
+    Getopt::Long::GetOptions( \%opts,
+        'f|files-from:s@',
+        'D|directory:s@',
+        'u|unescaped',
+        'g|gnu-gettext',
+        'o|output:s@',
+        'd|default-domain:s',
+        'p|output-dir:s@',
+        'h|help',
+    ) or help();
+    help() if $opts{h};
+
+    my @po = @{$opts{o} || [($opts{d}||'messages').'.po']};
+
+    foreach my $file (@{$opts{f}||[]}) {
+        open FILE, $file or die "Cannot open $file: $!";
+        while (<FILE>) {
+            push @ARGV, $_ if -r and !-d;
+        }
+    }
+
+    foreach my $dir (@{$opts{D}||[]}) {
+        File::Find::find( {
+            wanted      => sub {
+                return if
+                    ( -d ) ||
+                    ( $File::Find::dir =~ 'lib/blib|lib/t/autogen|var|m4|local' ) ||
+                    ( /\.po$|\.bak$|~|,D|,B$/i ) ||
+                    ( /^[\.#]/ );
+                push @ARGV, $File::Find::name;
+            },
+            follow      => 1,
+        }, $dir );
+    }
+
+    @ARGV = ('-') unless @ARGV;
+    s!^.[/\\]!! for @ARGV;
+
+    my $cwd = getcwd();
+
+    foreach my $dir (@{$opts{p}||['.']}) {
+        foreach my $po (@po) {
+            my $Ext = Locale::Maketext::Extract->new;
+            $Ext->read_po($po, $opts{u}) if -r $po;
+            $Ext->extract_file($_) for grep !/\.po$/i, @ARGV;
+            $Ext->compile($opts{u}) or next;
+
+            chdir $dir;
+            $Ext->write_po($po, $opts{g});
+            chdir $cwd;
+        }
+    }
+}
+
+sub help {
+    local $SIG{__WARN__} = sub {};
+    { exec "perldoc $0"; }
+    { exec "pod2text $0"; }
+}
+
+1;
diff --git a/lib/Locale/Maketext/Lexicon.pm b/lib/Locale/Maketext/Lexicon.pm
new file mode 100644
index 0000000..024e29d
--- /dev/null
+++ b/lib/Locale/Maketext/Lexicon.pm
@@ -0,0 +1,461 @@
+package Locale::Maketext::Lexicon;
+$Locale::Maketext::Lexicon::VERSION = '0.45';
+
+use strict;
+
+=head1 NAME
+
+Locale::Maketext::Lexicon - Use other catalog formats in Maketext
+
+=head1 VERSION
+
+This document describes version 0.45 of Locale::Maketext::Lexicon,
+released October 26, 2004.
+
+=head1 SYNOPSIS
+
+As part of a localization class, automatically glob for available
+lexicons:
+
+    package Hello::L10N;
+    use base 'Locale::Maketext';
+    use Locale::Maketext::Lexicon {
+        '*' => [Gettext => '/usr/local/share/locale/*/LC_MESSAGES/hello.mo'],
+        _decode => 1,   # decode lexicon entries into utf8-strings
+    };
+
+Explicitly specify languages, during compile- or run-time:
+
+    package Hello::L10N;
+    use base 'Locale::Maketext';
+    use Locale::Maketext::Lexicon {
+        de => [Gettext => 'hello_de.po'],
+        fr => [
+            Gettext => 'hello_fr.po',
+            Gettext => 'local/hello/fr.po',
+        ],
+    };
+    # ... incrementally add new lexicons
+    Locale::Maketext::Lexicon->import({
+        de => [Gettext => 'local/hello/de.po'],
+    })
+
+Alternatively, as part of a localization subclass:
+
+    package Hello::L10N::de;
+    use base 'Hello::L10N';
+    use Locale::Maketext::Lexicon (Gettext => \*DATA);
+    __DATA__
+    # Some sample data
+    msgid ""
+    msgstr ""
+    "Project-Id-Version: Hello 1.3.22.1\n"
+    "MIME-Version: 1.0\n"
+    "Content-Type: text/plain; charset=iso8859-1\n"
+    "Content-Transfer-Encoding: 8bit\n"
+
+    #: Hello.pm:10
+    msgid "Hello, World!"
+    msgstr "Hallo, Welt!"
+
+    #: Hello.pm:11
+    msgid "You have %quant(%1,piece) of mail."
+    msgstr "Sie haben %quant(%1,Poststueck,Poststuecken)."
+
+=head1 DESCRIPTION
+
+This module provides lexicon-handling modules to read from other
+localization formats, such as I<Gettext>, I<Msgcat>, and so on.
+
+If you are unfamiliar with the concept of lexicon modules, please
+consult L<Locale::Maketext> and L<http://www.autrijus.org/webl10n/>
+first.
+
+A command-line utility L<xgettext.pl> is also installed with this
+module, for extracting translatable strings from source files.
+
+=head2 The C<import> function
+
+The C<import()> function accepts two forms of arguments:
+
+=over 4
+
+=item (I<format> => I<source> ... )
+
+This form takes any number of argument pairs (usually one);
+I<source> may be a file name, a filehandle, or an array reference.
+
+For each such pair, it pass the contents specified by the second
+argument to B<Locale::Maketext::Lexicon::I<format>>->parse as a
+plain list, and export its return value as the C<%Lexicon> hash
+in the calling package.
+
+In the case that there are multiple such pairs, the lexicon
+defined by latter ones overrides earlier ones.
+
+=item { I<language> => [ I<format>, I<source> ... ] ... }
+
+This form accepts a hash reference.  It will export a C<%Lexicon>
+into the subclasses specified by each I<language>, using the process
+described above.  It is designed to alleviate the need to set up a
+separate subclass for each localized language, and just use the catalog
+files.
+
+This module will convert the I<language> arguments into lowercase,
+and replace all C<-> with C<_>, so C<zh_TW> and C<zh-tw> will both
+map to the C<zh_tw> subclass.
+
+If I<language> begins with C<_>, it is taken as an option that
+controls how lexicons are parsed.  See L</Options> for a list
+of available options.
+
+The C<*> is a special I<language>; it must be used in conjunction
+with a filename that also contains C<*>; all matched files with
+a valid language code in the place of C<*> will be automatically
+prepared as a lexicon subclass.  If there is multiple C<*> in
+the filename, the last one is used as the language name.
+
+=back
+
+=head2 Options
+
+=over 4
+
+=item C<_decode>
+
+If set to a true value, source entries will be converted into
+utf8-strings (available in Perl 5.6.1 or later).  This feature
+needs the B<Encode> or B<Encode::compat> module.
+
+Currently, only the C<Gettext> backend supports this option.
+
+=item C<_encoding>
+
+This option only has effect when C<_decode> is set to true.
+It specifies an encoding to store lexicon entries, instead of
+utf8-strings.
+
+If C<_encoding> is set to C<locale>, the encoding from the
+current locale setting is used.
+
+=head2 Subclassing format handlers
+
+If you wish to override how sources specified in different data types
+are handled, please use a subclass that overrides C<lexicon_get_I<TYPE>>.
+
+XXX: not documented well enough yet.  Patches welcome.
+
+=head1 NOTES
+
+If you want to implement a new C<Lexicon::*> backend module, please note
+that C<parse()> takes an array containing the B<source strings> from the
+specified filehandle or filename, which are I<not> C<chomp>ed.  Although
+if the source is an array reference, its elements will probably not contain
+any newline characters anyway.
+
+The C<parse()> function should return a hash reference, which will be
+assigned to the I<typeglob> (C<*Lexicon>) of the language module.  All
+it amounts to is that if the returned reference points to a tied hash,
+the C<%Lexicon> will be aliased to the same tied hash if it was not
+initialized previously.
+
+=cut
+
+our %Opts;
+sub option { shift if ref($_[0]); $Opts{lc $_[0]} }
+sub set_option { shift if ref($_[0]); $Opts{lc $_[0]} = $_[1] }
+
+sub encoding {
+    my $encoding = option(@_, 'encoding') or return;
+    return $encoding unless lc($encoding) eq 'locale';
+
+    no warnings 'uninitialized';
+    my ($country_language, $locale_encoding);
+
+    local $@;
+    eval {
+        require I18N::Langinfo;
+        $locale_encoding = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
+    } or eval {
+        require Win32::Console;
+        $locale_encoding = 'cp'.Win32::Console::OutputCP();
+    };
+    if (!$locale_encoding) {
+        foreach my $key (qw( LANGUAGE LC_ALL LC_MESSAGES LANG )) {
+            $ENV{$key} =~ /^([^.]+)\.([^.:]+)/ or next;
+            ($country_language, $locale_encoding) = ($1, $2);
+            last;
+        }
+    }
+    if (defined $locale_encoding &&
+        lc($locale_encoding) eq 'euc' &&
+        defined $country_language) {
+        if ($country_language =~ /^ja_JP|japan(?:ese)?$/i) {
+            $locale_encoding = 'euc-jp';
+        } elsif ($country_language =~ /^ko_KR|korean?$/i) {
+            $locale_encoding = 'euc-kr';
+        } elsif ($country_language =~ /^zh_CN|chin(?:a|ese)?$/i) {
+            $locale_encoding = 'euc-cn';
+        } elsif ($country_language =~ /^zh_TW|taiwan(?:ese)?$/i) {
+            $locale_encoding = 'euc-tw';
+        }
+    }
+
+    return $locale_encoding;
+}
+
+sub import {
+    my $class = shift;
+    return unless @_;
+
+    my %entries;
+    if (UNIVERSAL::isa($_[0], 'HASH')) {
+        # a hashref with $lang as keys, [$format, $src ...] as values
+        %entries = %{$_[0]};
+    }
+    elsif (@_ % 2) {
+        %entries = ( '' => [ @_ ] );
+    }
+
+    # expand the wildcard entry
+    if (my $wild_entry = delete $entries{'*'}) {
+        while (my ($format, $src) = splice(@$wild_entry, 0, 2)) {
+            next if ref($src); # XXX: implement globbing for the 'Tie' backend
+
+            my $pattern = quotemeta($src);
+            $pattern =~ s/\\\*(?=[^*]+$)/\([-\\w]+\)/g or next;
+            $pattern =~ s/\\\*/.*?/g;
+            $pattern =~ s/\\\?/./g;
+            $pattern =~ s/\\\[/[/g;
+            $pattern =~ s/\\\]/]/g;
+            $pattern =~ s[\\\{(.*?)\\\\}][
+                '(?:'.join('|', split(/,/, $1)).')'
+            ]eg;
+
+            require File::Glob;
+            foreach my $file (File::Glob::bsd_glob($src)) {
+                $file =~ /$pattern/ or next;
+                push @{$entries{$1}}, ($format => $file) if $1;
+            }
+            delete $entries{$1}
+                unless !defined($1)
+                    or exists $entries{$1} and @{$entries{$1}};
+        }
+    }
+
+    %Opts = ();
+    foreach my $key (grep /^_/, keys %entries) {
+        set_option(lc(substr($key, 1)) => delete($entries{$key}));
+    }
+    my $OptsRef = { %Opts };
+
+    while (my ($lang, $entry) = each %entries) {
+        my $export = caller;
+
+        if (length $lang) {
+            # normalize language tag to Maketext's subclass convention
+            $lang = lc($lang);
+            $lang =~ s/-/_/g;
+            $export .= "::$lang";
+        }
+
+        my @pairs = @{$entry||[]} or die "no format specified";
+
+        while (my ($format, $src) = splice(@pairs, 0, 2)) {
+            if (defined($src) and !ref($src) and $src =~ /\*/) {
+                unshift(@pairs, $format => $_) for File::Glob::bsd_glob($src);
+                next;
+            }
+
+            my @content = $class->lexicon_get($src, scalar caller, $lang);
+
+            no strict 'refs';
+            eval "use $class\::$format; 1" or die $@;
+
+            if (defined %{"$export\::Lexicon"}) {
+                if (ref(tied %{"$export\::Lexicon"}) eq __PACKAGE__) {
+                    tied(%{"$export\::Lexicon"})->_force;
+                }
+                # be very careful not to pollute the possibly tied lexicon
+                *{"$export\::Lexicon"} = {
+                    %{"$export\::Lexicon"},
+                    %{"$class\::$format"->parse(@content)},
+                };
+            }
+            else {
+                my $promise;
+                tie %{"$export\::Lexicon"}, __PACKAGE__, {
+                    Opts => $OptsRef,
+                    Export => "$export\::Lexicon",
+                    Class => "$class\::$format",
+                    Content => \@content,
+                };
+            }
+
+            push(@{"$export\::ISA"}, scalar caller) if length $lang;
+        }
+    }
+}
+
+sub TIEHASH {
+    my ($class, $args) = @_;
+    return bless($args, $class);
+
+}
+
+{
+    no strict 'refs';
+    sub _force {
+        my $args = shift;
+        if (!$args->{Done}++) {
+            local *Opts = $args->{Opts};
+            *{$args->{Export}} = $args->{Class}->parse(@{$args->{Content}});
+        }
+        return \%{$args->{Export}};
+    }
+    sub FETCH { _force($_[0])->{$_[1]} }
+    sub EXISTS { exists _force($_[0])->{$_[1]} }
+    sub DELETE { delete _force($_[0])->{$_[1]} }
+    sub SCALAR { scalar %{_force($_[0])} }
+    sub STORE { _force($_[0])->{$_[1]} = $_[2] }
+    sub CLEAR { %{_force($_[0])->{$_[1]}} = () }
+    sub NEXTKEY { each %{_force($_[0])} }
+    sub FIRSTKEY {
+        my $hash = _force($_[0]);
+        my $a = scalar keys %$hash;
+        each %$hash;
+    }
+}
+
+sub lexicon_get {
+    my ($class, $src, $caller, $lang) = @_;
+    return unless defined $src;
+
+    foreach my $type (qw(ARRAY HASH SCALAR GLOB), ref($src)) {
+        next unless UNIVERSAL::isa($src, $type);
+
+        my $method = 'lexicon_get_' . lc($type);
+        die "cannot handle source $type for $src: no $method defined"
+            unless $class->can($method);
+
+        return $class->$method($src, $caller, $lang);
+    }
+
+    # default handler
+    return $class->lexicon_get_($src, $caller, $lang);
+}
+
+# for scalarrefs and arrayrefs we just dereference the $src
+sub lexicon_get_scalar { ${$_[1]} }
+sub lexicon_get_array  { @{$_[1]} }
+
+sub lexicon_get_hash   {
+    my ($class, $src, $caller, $lang) = @_;
+    return map { $_ => $src->{$_} } sort keys %$src;
+}
+
+sub lexicon_get_glob   {
+    my ($class, $src, $caller, $lang) = @_;
+
+    no strict 'refs';
+
+    # be extra magical and check for DATA section
+    if (eof($src) and $src eq \*{"$caller\::DATA"} or $src eq \*{"main\::DATA"}) {
+        # okay, the *DATA isn't initiated yet. let's read.
+        #
+        require FileHandle;
+        my $fh = FileHandle->new;
+        my $package = ( ($src eq \*{"main\::DATA"}) ? 'main' : $caller );
+
+        if ( $package eq 'main' and -e $0 ) {
+            $fh->open($0) or die "Can't open $0: $!";
+        }
+        else {
+            my $level = 1;
+            while ( my ($pkg, $filename) = caller($level++) ) {
+                next unless $pkg eq $package;
+                next unless -e $filename;
+                next;
+
+                $fh->open($filename) or die "Can't open $filename: $!";
+                last;
+            }
+        }
+
+        while (<$fh>) {
+            # okay, this isn't foolproof, but good enough
+            last if /^__DATA__$/;
+        }
+
+        return <$fh>;
+    }
+
+    # fh containing the lines
+    my $pos = tell($src);
+    my @lines = <$src>;
+    seek($src, $pos, 0);
+    return @lines;
+}
+
+# assume filename - search path, open and return its contents
+sub lexicon_get_ {
+    my ($class, $src, $caller, $lang) = @_;
+
+    require FileHandle;
+    require File::Spec;
+
+    my $fh = FileHandle->new;
+    my @path = split('::', $caller);
+    push @path, $lang if length $lang;
+
+    $src = (grep { -e } map {
+        my @subpath = @path[0..$_];
+        map { File::Spec->catfile($_, @subpath, $src) } @INC;
+    } -1 .. $#path)[-1] unless -e $src;
+
+    die "cannot find $_[1] (called by $_[2]) in \@INC" unless -e $src;
+    $fh->open($src) or die $!;
+    binmode($fh);
+    return <$fh>;
+}
+
+1;
+
+=head1 ACKNOWLEDGMENTS
+
+Thanks to Jesse Vincent for suggesting this module to be written.
+
+Thanks also to Sean M. Burke for coming up with B<Locale::Maketext>
+in the first place, and encouraging me to experiment with alternative
+Lexicon syntaxes.
+
+Thanks also to Yi Ma Mao for providing the MO file parsing subroutine,
+as well as inspiring me to implement file globbing and transcoding
+support.
+
+See the F<AUTHORS> file in the distribution for a list of people who
+have sent helpful patches, ideas or comments.
+
+=head1 SEE ALSO
+
+L<xgettext.pl> for extracting translatable strings from common template
+systems and perl source files.
+
+L<Locale::Maketext>, L<Locale::Maketext::Lexicon::Auto>,
+L<Locale::Maketext::Lexicon::Gettext>, L<Locale::Maketext::Lexicon::Msgcat>,
+L<Locale::Maketext::Lexicon::Tie>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2003, 2004 by Autrijus Tang E<lt>autrijus@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
diff --git a/lib/Locale/Maketext/Lexicon/Auto.pm b/lib/Locale/Maketext/Lexicon/Auto.pm
new file mode 100644
index 0000000..658b458
--- /dev/null
+++ b/lib/Locale/Maketext/Lexicon/Auto.pm
@@ -0,0 +1,59 @@
+package Locale::Maketext::Lexicon::Auto;
+$Locale::Maketext::Lexicon::Auto::VERSION = '0.02';
+
+use strict;
+
+=head1 NAME
+
+Locale::Maketext::Lexicon::Auto - Auto fallback lexicon for Maketext
+
+=head1 SYNOPSIS
+
+    package Hello::L10N;
+    use base 'Locale::Maketext';
+    use Locale::Maketext::Lexicon {
+        en => ['Auto'],
+        # ... other languages
+    };
+
+=head1 DESCRIPTION
+
+This module builds a simple Lexicon hash that contains nothing but
+C<( '_AUTO' =E<gt> 1)>, which tells C<Locale::Maketext> that no
+localizing is needed -- just use the lookup key as the returned string.
+
+It is especially useful if you're starting to prototype a program, and
+do not want to deal with the localization files yet.
+
+=head1 CAVEATS
+
+If the key to C<-E<gt>maketext> begins with a C<_>, C<Locale::Maketext>
+will still throw an exception.  See L<Locale::Maketext/CONTROLLING LOOKUP
+FAILURE> for how to prevent it.
+
+=cut
+
+sub parse {
+    return { _AUTO => 1 };
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<Locale::Maketext>, L<Locale::Maketext::Lexicon>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2003, 2004 by Autrijus Tang E<lt>autrijus@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
diff --git a/lib/Locale/Maketext/Lexicon/Gettext.pm b/lib/Locale/Maketext/Lexicon/Gettext.pm
new file mode 100644
index 0000000..634b514
--- /dev/null
+++ b/lib/Locale/Maketext/Lexicon/Gettext.pm
@@ -0,0 +1,251 @@
+package Locale::Maketext::Lexicon::Gettext;
+$Locale::Maketext::Lexicon::Gettext::VERSION = '0.13';
+
+use strict;
+
+=head1 NAME
+
+Locale::Maketext::Lexicon::Gettext - PO and MO file parser for Maketext
+
+=head1 SYNOPSIS
+
+Called via B<Locale::Maketext::Lexicon>:
+
+    package Hello::L10N;
+    use base 'Locale::Maketext';
+    use Locale::Maketext::Lexicon {
+        de => [Gettext => 'hello/de.mo'],
+    };
+
+Directly calling C<parse()>:
+
+    use Locale::Maketext::Lexicon::Gettext;
+    my %Lexicon = %{ Locale::Maketext::Lexicon::Gettext->parse(<DATA>) };
+    __DATA__
+    #: Hello.pm:10
+    msgid "Hello, World!"
+    msgstr "Hallo, Welt!"
+
+    #: Hello.pm:11
+    msgid "You have %quant(%1,piece) of mail."
+    msgstr "Sie haben %quant(%1,Poststueck,Poststuecken)."
+
+=head1 DESCRIPTION
+
+This module implements a perl-based C<Gettext> parser for
+B<Locale::Maketext>. It transforms all C<%1>, C<%2>, <%*>... sequences
+to C<[_1]>, C<[_2]>, C<[_*]>, and so on.  It accepts either plain PO
+file, or a MO file which will be handled with a pure-perl parser
+adapted from Imacat's C<Locale::Maketext::Gettext>.
+
+Since version 0.03, this module also looks for C<%I<function>(I<args...>)>
+in the lexicon strings, and transform it to C<[I<function>,I<args...>]>.
+Any C<%1>, C<%2>... sequences inside the I<args> will have their percent
+signs (C<%>) replaced by underscores (C<_>).
+
+The name of I<function> above should begin with a letter or underscore,
+followed by any number of alphanumeric characters and/or underscores.
+As an exception, the function name may also consist of a single asterisk
+(C<*>) or pound sign (C<#>), which are C<Locale::Maketext>'s shorthands
+for C<quant> and C<numf>, respectively.
+
+As an additional feature, this module also parses MIME-header style
+metadata specified in the null msgstr (C<"">), and add them to the
+C<%Lexicon> with a C<__> prefix.  For example, the example above will
+set C<__Content-Type> to C<text/plain; charset=iso8859-1>, without
+the newline or the colon.
+
+Any normal entry that duplicates a metadata entry takes precedence.
+Hence, a C<msgid "__Content-Type"> line occurs anywhere should override
+the above value.
+
+=head1 NOTES
+
+When parsing PO files, fuzzy entries (entries marked with C<#, fuzzy>)
+are silently ignored.  If you wish to use fuzzy entries, specify a true
+value to the C<_use_fuzzy> option: 
+
+    use Locale::Maketext::Lexicon {
+        de => [Gettext => 'hello/de.mo'],
+        _use_fuzzy => 1,
+    };
+
+=cut
+
+my ($InputEncoding, $OutputEncoding, $DoEncoding);
+
+sub input_encoding { $InputEncoding };
+sub output_encoding { $OutputEncoding };
+
+sub parse {
+    my $self = shift;
+    my (%var, $key, @ret);
+    my @metadata;
+
+    $InputEncoding = $OutputEncoding = $DoEncoding = undef;
+
+    use Carp;
+    Carp::cluck "Undefined source called\n" unless defined $_[0];
+
+    # Check for magic string of MO files
+    return parse_mo(join('', @_))
+        if ($_[0] =~ /^\x95\x04\x12\xde/ or $_[0] =~ /^\xde\x12\x04\x95/);
+
+    local $^W;  # no 'uninitialized' warnings, please.
+
+    require Locale::Maketext::Lexicon;
+    my $UseFuzzy = Locale::Maketext::Lexicon::option('use_fuzzy');
+
+    # Parse PO files
+    foreach (@_) {
+        s/[\015\012]*\z//; # fix CRLF issues
+
+        /^(msgid|msgstr) +"(.*)" *$/    ? do {  # leading strings
+            $var{$1} = $2;
+            $key = $1;
+        } :
+
+        /^"(.*)" *$/                    ? do {  # continued strings
+            $var{$key} .= $1;
+        } :
+
+        /^#, +(.*) *$/                  ? do {  # control variables
+            $var{$_} = 1 for split(/,\s+/, $1);
+        } :
+
+        /^ *$/ && %var                  ? do {  # interpolate string escapes
+            push @ret, (map transform($_), @var{'msgid', 'msgstr'})
+                if length $var{msgstr} and !$var{fuzzy} or $UseFuzzy;
+            push @metadata, parse_metadata($var{msgstr})
+                if $var{msgid} eq '';
+            %var = ();
+        } : ();
+    }
+
+    push @ret, map { transform($_) } @var{'msgid', 'msgstr'}
+        if length $var{msgstr};
+    push @metadata, parse_metadata($var{msgstr})
+        if $var{msgid} eq '';
+
+    return {@metadata, @ret};
+}
+
+sub parse_metadata {
+    return map {
+        (/^([^\x00-\x1f\x80-\xff :=]+):\s*(.*)$/) ?
+            ($1 eq 'Content-Type') ? do {
+                my $enc = $2;
+                if ($enc =~ /\bcharset=\s*([-\w]+)/i) {
+                    $InputEncoding = $1 || '';
+                    $OutputEncoding = Locale::Maketext::Lexicon::encoding() || '';
+                    $InputEncoding = 'utf8' if $InputEncoding =~ /^utf-?8$/i;
+                    $OutputEncoding = 'utf8' if $OutputEncoding =~ /^utf-?8$/i;
+                    if ( Locale::Maketext::Lexicon::option('decode') and
+                        (!$OutputEncoding or $InputEncoding ne $OutputEncoding)) {
+                        require Encode::compat if $] < 5.007001;
+                        require Encode;
+                        $DoEncoding = 1;
+                    }
+                }
+                ("__Content-Type", $enc);
+            } : ("__$1", $2)
+        : ();
+    } split(/\r*\n+\r*/, transform(pop));
+}
+
+sub transform {
+    my $str = shift;
+
+    if ($DoEncoding and $InputEncoding) {
+        $str = ($InputEncoding eq 'utf8')
+            ? Encode::decode_utf8($str)
+            : Encode::decode($InputEncoding, $str)
+    }
+
+    $str =~ s/\\([0x]..|c?.)/qq{"\\$1"}/eeg;
+
+    if ($DoEncoding and $OutputEncoding) {
+        $str = ($OutputEncoding eq 'utf8')
+            ? Encode::encode_utf8($str)
+            : Encode::encode($OutputEncoding, $str)
+    }
+
+    $str =~ s/([~\[\]])/~$1/g;
+    $str =~ s/(?<![%\\])%([A-Za-z#*]\w*)\(([^\)]*)\)/[$1,~~~$2~~~]/g;
+    $str = join('', map {
+        /^~~~.*~~~$/ ? unescape(substr($_, 3, -3)) : $_
+    } split(/(~~~.*?~~~)/, $str));
+    $str =~ s/(?<![%\\])%(\d+|\*)/\[_$1]/g;
+
+    return $str;
+}
+
+sub unescape {
+    join(',', map {
+        /^%(?:\d+|\*)$/ ? ("_" . substr($_, 1)) : $_
+    } split(/,/, $_[0]));
+}
+
+# This subroutine was derived from Locale::Maketext::Gettext::readmo()
+# under the Perl License; the original author is Yi Ma Mao (IMACAT).
+sub parse_mo {
+    my $content = shift;
+    my $tmpl = (substr($content, 0, 4) eq "\xde\x12\x04\x95") ? 'V' : 'N';
+    
+    # Check the MO format revision number
+    # There is only one revision now: revision 0.
+    return if unpack($tmpl, substr($content, 4, 4)) > 0;
+    
+    my ($num, $offo, $offt);
+    # Number of strings
+    $num = unpack $tmpl, substr($content, 8, 4);
+    # Offset to the beginning of the original strings
+    $offo = unpack $tmpl, substr($content, 12, 4);
+    # Offset to the beginning of the translated strings
+    $offt = unpack $tmpl, substr($content, 16, 4);
+
+    my (@metadata, @ret);
+    for (0 .. $num - 1) {
+        my ($len, $off, $stro, $strt);
+        # The first word is the length of the string
+        $len = unpack $tmpl, substr($content, $offo+$_*8, 4);
+        # The second word is the offset of the string
+        $off = unpack $tmpl, substr($content, $offo+$_*8+4, 4);
+        # Original string
+        $stro = substr($content, $off, $len);
+        
+        # The first word is the length of the string
+        $len = unpack $tmpl, substr($content, $offt+$_*8, 4);
+        # The second word is the offset of the string
+        $off = unpack $tmpl, substr($content, $offt+$_*8+4, 4);
+        # Translated string
+        $strt = substr($content, $off, $len);
+        
+        # Hash it
+        push @metadata, parse_metadata($strt) if $stro eq '';
+        push @ret, (map transform($_), $stro, $strt) if length $strt;
+    }
+    
+    return {@metadata, @ret};
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<Locale::Maketext>, L<Locale::Maketext::Lexicon>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2003, 2004 by Autrijus Tang E<lt>autrijus@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
diff --git a/lib/Locale/Maketext/Lexicon/Msgcat.pm b/lib/Locale/Maketext/Lexicon/Msgcat.pm
new file mode 100644
index 0000000..5dac84f
--- /dev/null
+++ b/lib/Locale/Maketext/Lexicon/Msgcat.pm
@@ -0,0 +1,123 @@
+package Locale::Maketext::Lexicon::Msgcat;
+$Locale::Maketext::Lexicon::Msgcat::VERSION = '0.02';
+
+use strict;
+
+=head1 NAME
+
+Locale::Maketext::Lexicon::Msgcat - Msgcat catalog parser Maketext
+
+=head1 SYNOPSIS
+
+    package Hello::L10N;
+    use base 'Locale::Maketext';
+    use Locale::Maketext::Lexicon {
+        en => ['Msgcat', 'en_US/hello.pl.m'],
+    };
+
+    package main;
+    my $lh = Hello::L10N->get_handle('en');
+    print $lh->maketext(1,2);   # set 1, msg 2
+    print $lh->maketext("1,2"); # same thing
+
+=head1 DESCRIPTION
+
+This module parses one or more Msgcat catalogs in plain text format,
+and returns a Lexicon hash, which may be looked up either with a
+two-argument form (C<$set_id, $msg_id>) or as a single string
+(C<"$set_id,$msg_id">).
+
+=head1 NOTES
+
+All special characters (C<[>, C<]> and C<~>) in catalogs will be
+escaped so they lose their magic meanings.  That means C<-E<gt>maketext>
+calls to this lexicon will I<not> take any additional arguments.
+
+=cut
+
+sub parse {
+    my $set = 0;
+    my $msg = undef;
+    my ($qr, $qq, $qc)  = (qr//, '', '');
+    my @out;
+
+    # Set up the msgcat handler
+    { no strict 'refs';
+      *{Locale::Maketext::msgcat} = \&_msgcat; }
+
+    # Parse *.m files; Locale::Msgcat objects and *.cat are not yet supported.
+    foreach (@_) {
+        s/[\015\012]*\z//; # fix CRLF issues
+
+        /^\$set (\d+)/                          ? do {  # set_id
+            $set = int($1);
+            push @out, $1, "[msgcat,$1,_1]";
+        } :
+
+        /^\$quote (.)/                          ? do {  # quote character
+            $qc = $1;
+            $qq = quotemeta($1);
+            $qr = qr/$qq?/;
+        } :
+
+        /^(\d+) ($qr)(.*?)\2(\\?)$/                     ? do {  # msg_id and msg_str
+            local $^W;
+            push @out, "$set,".int($1);
+            if ($4) {
+                $msg = $3;
+            }
+            else {
+                push @out, unescape($qq, $qc, $3);
+                undef $msg;
+            }
+        } : 
+
+        (defined $msg and /^($qr)(.*?)\1(\\?)$/)        ? do {  # continued string
+            local $^W;
+            if ($3) {
+                $msg .= $2;
+            }
+            else {
+                push @out, unescape($qq, $qc, $msg . $2);
+                undef $msg;
+            }
+        } : ();
+    }
+
+    push @out, '' if defined $msg;
+
+    return { @out };
+}
+
+sub _msgcat {
+    my ($self, $set_id, $msg_id, @args) = @_;
+    return $self->maketext(int($set_id).','.int($msg_id), @args)
+}
+
+sub unescape {
+    my ($qq, $qc, $str) = @_;
+    $str =~ s/(\\([ntvbrf\\$qq]))/($2 eq $qc) ? $qc : eval qq("$1")/e;
+    $str =~ s/([\~\[\]])/~$1/g;
+    return $str;
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<Locale::Maketext>, L<Locale::Maketext::Lexicon>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2003, 2004 by Autrijus Tang E<lt>autrijus@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
diff --git a/lib/Locale/Maketext/Lexicon/Tie.pm b/lib/Locale/Maketext/Lexicon/Tie.pm
new file mode 100644
index 0000000..238c8a9
--- /dev/null
+++ b/lib/Locale/Maketext/Lexicon/Tie.pm
@@ -0,0 +1,67 @@
+package Locale::Maketext::Lexicon::Tie;
+$Locale::Maketext::Lexicon::Tie::VERSION = '0.03';
+
+use strict;
+use Symbol ();
+
+=head1 NAME
+
+Locale::Maketext::Lexicon::Tie - Use tied hashes as lexicons for Maketext
+
+=head1 SYNOPSIS
+
+    package Hello::L10N;
+    use base 'Locale::Maketext';
+    use Locale::Maketext::Lexicon {
+        en => [ Tie => [ DB_File => 'en.db' ] ],
+    };
+
+=head1 DESCRIPTION
+
+This module lets you easily C<tie> the C<%Lexicon> hash to a database
+or other data sources.  It takes an array reference of arguments, and
+passes them directly to C<tie()>.
+
+Entries will then be fetched whenever it is used; this module does not
+cache them.
+
+=cut
+
+sub parse {
+    my $self = shift;
+    my $mod  = shift;
+    my $sym  = Symbol::gensym();
+
+    # Load the target module into memory
+    {
+        no strict 'refs';
+        eval "use $mod; 1" or die $@ unless defined %{"$mod\::"};
+    }
+
+    # Perform the actual tie 
+    tie %{*$sym}, $mod, @_;
+
+    # Returns the GLOB reference, so %Lexicon will be tied too
+    return $sym;
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<Locale::Maketext>, L<Locale::Maketext::Lexicon>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2003, 2004 by Autrijus Tang E<lt>autrijus@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