← Back to branch summary

~kosova/+junk/tuxfamily-twiki

« back to all changes in this revision

Viewing changes to foswiki/lib/CPAN/lib/Locale/Maketext/Lexicon/Msgcat.pm

  • Committer: James Michael DuPont
  • Date: 2009-07-18 19:58:49 UTC
  • Revision ID: jamesmikedupont@gmail.com-20090718195849-vgbmaht2ys791uo2
added foswiki

Show diffs side-by-side

added added

removed removed

Lines of Context:
foswiki/lib/CPAN/lib/Locale/Maketext/Lexicon/Msgcat.pm
 
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