lib/CPAN/lib/Locale/Maketext/Lexicon/Msgcat.pm
changeset 0 414e01d06fd5
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/lib/CPAN/lib/Locale/Maketext/Lexicon/Msgcat.pm	Sat Jan 26 15:50:53 2008 +0100
     1.3 @@ -0,0 +1,123 @@
     1.4 +package Locale::Maketext::Lexicon::Msgcat;
     1.5 +$Locale::Maketext::Lexicon::Msgcat::VERSION = '0.02';
     1.6 +
     1.7 +use strict;
     1.8 +
     1.9 +=head1 NAME
    1.10 +
    1.11 +Locale::Maketext::Lexicon::Msgcat - Msgcat catalog parser Maketext
    1.12 +
    1.13 +=head1 SYNOPSIS
    1.14 +
    1.15 +    package Hello::I18N;
    1.16 +    use base 'Locale::Maketext';
    1.17 +    use Locale::Maketext::Lexicon {
    1.18 +        en => ['Msgcat', 'en_US/hello.pl.m'],
    1.19 +    };
    1.20 +
    1.21 +    package main;
    1.22 +    my $lh = Hello::I18N->get_handle('en');
    1.23 +    print $lh->maketext(1,2);   # set 1, msg 2
    1.24 +    print $lh->maketext("1,2"); # same thing
    1.25 +
    1.26 +=head1 DESCRIPTION
    1.27 +
    1.28 +This module parses one or more Msgcat catalogs in plain text format,
    1.29 +and returns a Lexicon hash, which may be looked up either with a
    1.30 +two-argument form (C<$set_id, $msg_id>) or as a single string
    1.31 +(C<"$set_id,$msg_id">).
    1.32 +
    1.33 +=head1 NOTES
    1.34 +
    1.35 +All special characters (C<[>, C<]> and C<~>) in catalogs will be
    1.36 +escaped so they lose their magic meanings.  That means C<-E<gt>maketext>
    1.37 +calls to this lexicon will I<not> take any additional arguments.
    1.38 +
    1.39 +=cut
    1.40 +
    1.41 +sub parse {
    1.42 +    my $set = 0;
    1.43 +    my $msg = undef;
    1.44 +    my ($qr, $qq, $qc)  = (qr//, '', '');
    1.45 +    my @out;
    1.46 +
    1.47 +    # Set up the msgcat handler
    1.48 +    { no strict 'refs';
    1.49 +      *{Locale::Maketext::msgcat} = \&_msgcat; }
    1.50 +
    1.51 +    # Parse *.m files; Locale::Msgcat objects and *.cat are not yet supported.
    1.52 +    foreach (@_) {
    1.53 +        s/[\015\012]*\z//; # fix CRLF issues
    1.54 +
    1.55 +        /^\$set (\d+)/                          ? do {  # set_id
    1.56 +            $set = int($1);
    1.57 +            push @out, $1, "[msgcat,$1,_1]";
    1.58 +        } :
    1.59 +
    1.60 +        /^\$quote (.)/                          ? do {  # quote character
    1.61 +            $qc = $1;
    1.62 +            $qq = quotemeta($1);
    1.63 +            $qr = qr/$qq?/;
    1.64 +        } :
    1.65 +
    1.66 +        /^(\d+) ($qr)(.*?)\2(\\?)$/                     ? do {  # msg_id and msg_str
    1.67 +            local $^W;
    1.68 +            push @out, "$set,".int($1);
    1.69 +            if ($4) {
    1.70 +                $msg = $3;
    1.71 +            }
    1.72 +            else {
    1.73 +                push @out, unescape($qq, $qc, $3);
    1.74 +                undef $msg;
    1.75 +            }
    1.76 +        } : 
    1.77 +
    1.78 +        (defined $msg and /^($qr)(.*?)\1(\\?)$/)        ? do {  # continued string
    1.79 +            local $^W;
    1.80 +            if ($3) {
    1.81 +                $msg .= $2;
    1.82 +            }
    1.83 +            else {
    1.84 +                push @out, unescape($qq, $qc, $msg . $2);
    1.85 +                undef $msg;
    1.86 +            }
    1.87 +        } : ();
    1.88 +    }
    1.89 +
    1.90 +    push @out, '' if defined $msg;
    1.91 +
    1.92 +    return { @out };
    1.93 +}
    1.94 +
    1.95 +sub _msgcat {
    1.96 +    my ($self, $set_id, $msg_id, @args) = @_;
    1.97 +    return $self->maketext(int($set_id).','.int($msg_id), @args)
    1.98 +}
    1.99 +
   1.100 +sub unescape {
   1.101 +    my ($qq, $qc, $str) = @_;
   1.102 +    $str =~ s/(\\([ntvbrf\\$qq]))/($2 eq $qc) ? $qc : eval qq("$1")/e;
   1.103 +    $str =~ s/([\~\[\]])/~$1/g;
   1.104 +    return $str;
   1.105 +}
   1.106 +
   1.107 +1;
   1.108 +
   1.109 +=head1 SEE ALSO
   1.110 +
   1.111 +L<Locale::Maketext>, L<Locale::Maketext::Lexicon>
   1.112 +
   1.113 +=head1 AUTHORS
   1.114 +
   1.115 +Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
   1.116 +
   1.117 +=head1 COPYRIGHT
   1.118 +
   1.119 +Copyright 2002, 2003, 2004 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.
   1.120 +
   1.121 +This program is free software; you can redistribute it and/or 
   1.122 +modify it under the same terms as Perl itself.
   1.123 +
   1.124 +See L<http://www.perl.com/perl/misc/Artistic.html>
   1.125 +
   1.126 +=cut