summaryrefslogtreecommitdiff
path: root/lib/LangFile.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/LangFile.pm')
-rw-r--r--lib/LangFile.pm145
1 files changed, 145 insertions, 0 deletions
diff --git a/lib/LangFile.pm b/lib/LangFile.pm
new file mode 100644
index 00000000..e81f7f7a
--- /dev/null
+++ b/lib/LangFile.pm
@@ -0,0 +1,145 @@
+
+
+package LangFile;
+
+use strict;
+use warnings;
+use Fcntl qw(LOCK_SH LOCK_EX SEEK_SET);
+
+
+sub new {
+ my($class, $action, $file) = @_;
+ open my $F, $action eq 'read' ? '<:utf8' : '>:utf8', $file or die "Opening $file: $!";
+ flock($F, $action eq 'read' ? LOCK_SH : LOCK_EX) or die "Locking $file: $!";
+ seek($F, 0, SEEK_SET) or die "Seeking $file: $!";
+ return bless {
+ act => $action,
+ FH => $F,
+ # status vars for reading
+ intro => 1,
+ last => [],
+ }, $class;
+}
+
+
+sub read {
+ my $self = shift;
+ my $FH = $self->{FH};
+ my @lines;
+ my $state = '';
+ my($lang, $sync);
+
+ while((my $l = shift(@{$self->{last}}) || <$FH>)) {
+ $l =~ s/[\r\n\t\s]+$//;
+
+ # header
+ if($self->{intro}) {
+ push @lines, $l;
+ next if $l ne '/intro';
+ $self->{intro} = 0;
+ return [ 'space', @lines ];
+ }
+
+ # key
+ if(!$state && $l =~ /^:(.+)$/) {
+ return [ 'key', $1 ];
+ }
+
+ # space
+ if((!$state || $state eq 'space') && ($l =~ /^#/ || $l eq '')) {
+ $state = 'space';
+ push @lines, $l;
+ } elsif($state eq 'space') {
+ push @{$self->{last}}, "$l\n";
+ return [ 'space', @lines ];
+ }
+
+ # tl
+ if(!$state && $l =~ /^([a-z_-]{2})([ *]):(?: (.+)|)$/) {
+ $lang = $1;
+ $sync = $2 eq '*' ? 0 : 1;
+ push @lines, $3||'';
+ $state = 'tl';
+ } elsif($state eq 'tl' && $l =~ /^\s{5}(.+)$/) {
+ push @lines, $1;
+ } elsif($state eq 'tl' && $l eq '') {
+ push @lines, $l;
+ } elsif($state eq 'tl') {
+ my $trans = join "\n", @lines;
+ push @{$self->{last}}, "\n" while $trans =~ s/\n$//;
+ push @{$self->{last}}, $l;
+ return [ 'tl', $lang, $sync, $trans ];
+ }
+
+ die "Don\'t know what to do with \"$l\"" if !$state;
+ }
+ if($state eq 'space') {
+ return [ 'space', @lines ];
+ }
+ if($state eq 'tl') {
+ my $trans = join "\n", @lines;
+ push @{$self->{last}}, "\n" while $trans =~ s/\n$//;
+ return [ 'tl', $lang, $sync, $trans ];
+ }
+ return undef;
+}
+
+
+sub write {
+ my($self, @line) = @_;
+ my $FH = $self->{FH};
+
+ my $t = shift @line;
+
+ if($t eq 'space') {
+ print $FH "$_\n" for @line;
+ }
+
+ if($t eq 'key') {
+ print $FH ":$line[0]\n";
+ }
+
+ if($t eq 'tl') {
+ my($lang, $sync, $text) = @line;
+ $text =~ s/\n([^\n])/\n $1/g;
+ $text = " $text" if $text ne '';
+ printf $FH "%s%s:%s\n", $lang, $sync ? ' ' : '*', $text;
+ }
+}
+
+
+sub close {
+ my $self = shift;
+ close $self->{FH};
+}
+
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+LangFile - Simple object oriented interface for the parsing and creation of lang.txt
+
+=head1 USAGE
+
+ use LangFile;
+ my $read = LangFile->new(read => "data/lang.txt");
+ my $write = LangFile->new(write => "lang-copy.txt");
+
+ while((my $line = $read->read())) {
+ # $line is an arrayref in one of the following formats:
+ # [ 'space', @lines ]
+ # unparsed lines, like the header, newlines and comments
+ # [ 'key', $key ]
+ # key line, $key is key name
+ # [ 'tl', $lang, $sync, $text ]
+ # translation line(s), $lang = language tag, $sync = 1/0, $text = translation (can include newlines)
+ # $line is undef on EOF, $read->next() die()s on a parsing error
+
+ # create an identical copy of $read in $write
+ $write->write(@$line);
+ }
+ $write->close;
+