lib/CPAN/lib/Locale/Maketext/Lexicon/Msgcat.pm
changeset 0 414e01d06fd5
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     1 package Locale::Maketext::Lexicon::Msgcat;
       
     2 $Locale::Maketext::Lexicon::Msgcat::VERSION = '0.02';
       
     3 
       
     4 use strict;
       
     5 
       
     6 =head1 NAME
       
     7 
       
     8 Locale::Maketext::Lexicon::Msgcat - Msgcat catalog parser Maketext
       
     9 
       
    10 =head1 SYNOPSIS
       
    11 
       
    12     package Hello::I18N;
       
    13     use base 'Locale::Maketext';
       
    14     use Locale::Maketext::Lexicon {
       
    15         en => ['Msgcat', 'en_US/hello.pl.m'],
       
    16     };
       
    17 
       
    18     package main;
       
    19     my $lh = Hello::I18N->get_handle('en');
       
    20     print $lh->maketext(1,2);   # set 1, msg 2
       
    21     print $lh->maketext("1,2"); # same thing
       
    22 
       
    23 =head1 DESCRIPTION
       
    24 
       
    25 This module parses one or more Msgcat catalogs in plain text format,
       
    26 and returns a Lexicon hash, which may be looked up either with a
       
    27 two-argument form (C<$set_id, $msg_id>) or as a single string
       
    28 (C<"$set_id,$msg_id">).
       
    29 
       
    30 =head1 NOTES
       
    31 
       
    32 All special characters (C<[>, C<]> and C<~>) in catalogs will be
       
    33 escaped so they lose their magic meanings.  That means C<-E<gt>maketext>
       
    34 calls to this lexicon will I<not> take any additional arguments.
       
    35 
       
    36 =cut
       
    37 
       
    38 sub parse {
       
    39     my $set = 0;
       
    40     my $msg = undef;
       
    41     my ($qr, $qq, $qc)  = (qr//, '', '');
       
    42     my @out;
       
    43 
       
    44     # Set up the msgcat handler
       
    45     { no strict 'refs';
       
    46       *{Locale::Maketext::msgcat} = \&_msgcat; }
       
    47 
       
    48     # Parse *.m files; Locale::Msgcat objects and *.cat are not yet supported.
       
    49     foreach (@_) {
       
    50         s/[\015\012]*\z//; # fix CRLF issues
       
    51 
       
    52         /^\$set (\d+)/                          ? do {  # set_id
       
    53             $set = int($1);
       
    54             push @out, $1, "[msgcat,$1,_1]";
       
    55         } :
       
    56 
       
    57         /^\$quote (.)/                          ? do {  # quote character
       
    58             $qc = $1;
       
    59             $qq = quotemeta($1);
       
    60             $qr = qr/$qq?/;
       
    61         } :
       
    62 
       
    63         /^(\d+) ($qr)(.*?)\2(\\?)$/                     ? do {  # msg_id and msg_str
       
    64             local $^W;
       
    65             push @out, "$set,".int($1);
       
    66             if ($4) {
       
    67                 $msg = $3;
       
    68             }
       
    69             else {
       
    70                 push @out, unescape($qq, $qc, $3);
       
    71                 undef $msg;
       
    72             }
       
    73         } : 
       
    74 
       
    75         (defined $msg and /^($qr)(.*?)\1(\\?)$/)        ? do {  # continued string
       
    76             local $^W;
       
    77             if ($3) {
       
    78                 $msg .= $2;
       
    79             }
       
    80             else {
       
    81                 push @out, unescape($qq, $qc, $msg . $2);
       
    82                 undef $msg;
       
    83             }
       
    84         } : ();
       
    85     }
       
    86 
       
    87     push @out, '' if defined $msg;
       
    88 
       
    89     return { @out };
       
    90 }
       
    91 
       
    92 sub _msgcat {
       
    93     my ($self, $set_id, $msg_id, @args) = @_;
       
    94     return $self->maketext(int($set_id).','.int($msg_id), @args)
       
    95 }
       
    96 
       
    97 sub unescape {
       
    98     my ($qq, $qc, $str) = @_;
       
    99     $str =~ s/(\\([ntvbrf\\$qq]))/($2 eq $qc) ? $qc : eval qq("$1")/e;
       
   100     $str =~ s/([\~\[\]])/~$1/g;
       
   101     return $str;
       
   102 }
       
   103 
       
   104 1;
       
   105 
       
   106 =head1 SEE ALSO
       
   107 
       
   108 L<Locale::Maketext>, L<Locale::Maketext::Lexicon>
       
   109 
       
   110 =head1 AUTHORS
       
   111 
       
   112 Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
       
   113 
       
   114 =head1 COPYRIGHT
       
   115 
       
   116 Copyright 2002, 2003, 2004 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.
       
   117 
       
   118 This program is free software; you can redistribute it and/or 
       
   119 modify it under the same terms as Perl itself.
       
   120 
       
   121 See L<http://www.perl.com/perl/misc/Artistic.html>
       
   122 
       
   123 =cut