diff options
Diffstat (limited to 'lib/LangFile.pm')
-rw-r--r-- | lib/LangFile.pm | 145 |
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; + |