#!/usr/bin/env perl use Modern::Perl '2012'; use Getopt::Long; use POSIX qw(strftime); use File::Slurp qw(slurp write_file); use Data::Dump qw(pp); use Set::Tiny qw(set); my $in_file = ''; my $out_dir = ''; my $lang = ''; my $type = ''; GetOptions( 'in|file=s' => \$in_file, 'out|dir|po|pos=s' => \$out_dir, 'lang=s' => \$lang, 'type|class=s' => \$type ); die("No input file\n") unless $in_file; die("No output directory\n") unless $out_dir; die("No language\n") unless $lang; die("No class specified\n") unless $type; my $po_file = $out_dir . '/' . $type . '.' . $lang . '.lang'; # get a string for the current time my $now = strftime( '%F %R', localtime() ); my $empty = { 'name' => '', 'now' => '', 'date' => {}, 'tags' => set(), 'curr' => '', 'tran' => '' }; # open the input file and extract the strings, keeping track of the order my @text_order; my %text; { my $text = slurp( $in_file, { binmode => ':encoding(UTF-8)' } ); my @strings = ( $text =~ m[(<!-- S=.+? -->.+?<!-- /S -->)]msg ); foreach my $s (@strings) { my ( $key, $msg ) = ( $s =~ m[^<!-- S=(.+?) -->(.+?)<!-- /S -->$] ); if (defined($text{$key})) { die("Duplicate key '$key' for input file $in_file\n"); } push @text_order, $key; $text{$key} = { 'name' => $key, 'now' => $now, 'tags' => set(), 'curr' => $msg, 'tran' => '', 'type' => $type }; } } # open the language file and extract the stanzas my @stanzas_order; my %stanzas; { my @stanzas; { local $/ = ''; @stanzas = slurp( $po_file, { binmode => ':encoding(UTF-8)', err_mode => 'quiet' } ); } foreach my $s (@stanzas) { my $temp = { 'name' => '', 'date' => {}, 'tags' => set(), 'curr' => '', 'tran' => '', 'type' => '' }; my @lines = split /\n/, $s; foreach my $l (@lines) { if ( $l =~ m/^#: (.+)$/ ) { $temp->{'name'} = $1; } elsif ($l =~ m/^#c (.+?)/) { $temp->{'type'} = $1; elsif ( $l =~ m/^#d (.+?)\|(.+)$/ ) { $temp->{'date'}{$1} = $2; } elsif ( $l =~ m/^#t (.*)$/ ) { my $tags = $1; my @tags = split( /\s/, $tags ); $temp->{'tags'} = set(@tags); } elsif ( $l =~ m/^source: (.+)$/ ) { $temp->{'curr'} = $1; } elsif ( $l =~ m/^transl: (.*)$/ ) { $temp->{'tran'} = $1; } elsif ( $l =~ m/^invald: (.+)$/ ) { $temp->{'inval'} = $1; } } push @stanzas_order, $temp->{'name'}; $stanzas{ $temp->{'name'} } = $temp; } } # generate the output stanzas my @output; foreach my $k (@text_order) { if ( !exists( $stanzas{$k} ) ) { $stanzas{$k} = $empty; } my $temp = build_new_stanza( $text{$k}, $stanzas{$k} ); push @output, $temp; } foreach my $s (@stanzas_order) { if ( !exists( $text{$s} ) ) { # @TODO handle deleted stanzas } } write_file( $po_file, { binmode => ':encoding(UTF-8)' }, join( "\n\n" => @output ) . "\n\n" ); sub build_new_stanza { my ( $t, $s ) = @_; # test to see if the string text has changed my $changed = ( $t->{'curr'} ne $s->{'curr'} ); my $temp = ''; # put the name in $temp .= '#: ' . $t->{'name'} . "\n"; # put the type $temp .= '#c ' . $t->{'type'} . "\n"; # put the dated versions foreach my $d ( sort keys %{ $s->{'date'} } ) { $temp .= '#d ' . $d . '|' . $s->{'date'}{$d} . "\n"; } # if the message has changed, add the new dated version if ($changed) { $temp .= '#d ' . $now . '|' . $t->{'curr'} . "\n"; } # add the tags line my $tags = $s->{'tags'}; if ( $tags->size() ) { $temp .= '#t ' . join( " " => sort @{ $tags->members() } ) . "\n"; } # add the source line $temp .= 'source: ' . $t->{'curr'} . "\n"; # add the translation line or the invalidated line if ($changed) { $temp .= 'transl: ' . "\n"; if ( $s->{'tran'} ) { $temp .= 'invald: ' . ( $s->{'tran'} || $s->{'inval'} || '' ) . "\n"; } } else { $temp .= 'transl: ' . $s->{'tran'} . "\n"; } return $temp; } __END__ my $new_keys = set(@text_order); my $old_keys = set(@stanzas_order); say "new keys: " . $new_keys->difference($old_keys)->as_string();