lib/CPAN/lib/Locale/Maketext/Lexicon/Msgcat.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
permissions -rw-r--r--
RELEASE 4.2.0 freetown
     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