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