package MGH_Biostat::TravEpi::SimpleRulesBase::Translator::LangFile; use Exporter 'import'; our @EXPORT_OK = qw(read_lang_file write_lang_file read_lang_file_ro read_lang_files_ro); use Modern::Perl '2012'; use experimental 'switch'; use File::Slurp qw(slurp write_file); use Set::Tiny qw(set); use Carp; # read a "lang" file sub read_lang_file { my ($file) = @_; my $data = { '_order' => [], '_stanzas' => {}, }; my @stanzas; { local $/ = ''; @stanzas = slurp( $file, { binmode => ':encoding(UTF-8)', err_mode => 'quiet' } ); } foreach my $s (@stanzas) { my $temp = { name => '', date => {}, pt => {}, tags => set(), source => '', transl => '' }; my @lines = split /\n/, $s; for (@lines) { when (m/^#: (.+)$/) { # line prefixed with '#: ' sets the name $temp->{'name'} = $1; } when (m/^#d (.+?)\|(.+)$/) { # line prefixed with '#d ' is a previous version of the string $temp->{'date'}{$1} = $2; } when (m/^#t (.+?)\|(.+)$/) { # line prefixed with '#t ' are a previous translation $temp->{'pt'}{$1} = $2; } when (m/^#g (.*)$/) { # line prefixed with '#g ' contains tags separated by spaces my $tags = $1; my @tags = split /\s+/, $tags; $temp->{'tags'} = set(@tags); } when (m/^source: (.+)$/) { $temp->{'source'} = $1; } when (m/^transl: (.+)$/) { $temp->{'transl'} = $1; } when (m/^invald: (.+)$/) { $temp->{'invald'} = $1; } } push @{ $data->{'_order'} }, $temp->{'name'}; $data->{'_stanzas'}{ $temp->{'name'} } = $temp; } return $data; } # read a "lang" file, and return a simple key -> translation hash sub read_lang_file_ro { my ($file) = @_; my $data = read_lang_file($file); my $out = {}; foreach my $key ( @{ $data->{'_order'} } ) { my $s = $data->{'_stanzas'}{$key}; if ( !defined( $s->{'transl'} ) or ( $s->{'transl'} eq '' ) ) { warn("No translation for key '$key' in file '$file'\n"); } $out->{$key} = $s->{'transl'} || $s->{'source'} || '!! No translation available'; } return $out; } # given an array of lang files, read all of them into a hash sub read_lang_files_ro { my %files = @_; my $out = {}; foreach my $key ( keys %files ) { $out->{$key} = read_lang_file_ro( $files{$key} ); } return $out; } # save the data to the file sub write_lang_file { my ( $file, $data ) = @_; croak("Not a valid lang file data structure") unless exists( $data->{'_order'} ); croak("Not a valid lang file data structure") unless exists( $data->{'_stanzas'} ); my @stanzas; foreach my $name ( @{ $data->{'_order'} } ) { push @stanzas, _build_stanza( $data->{'_stanzas'}{$name} ); } write_file( $file, { binmode => ':encoding(UTF-8)' }, join( "\n\n" => @stanzas ) . "\n\n" ); } # build the text representation of a stanza sub _build_stanza { my ($s) = @_; my @text; # put the name it push @text, '#: ' . $s->{'name'}; # put the dated versions foreach my $d ( sort keys %{ $s->{'date'} } ) { push @text, '#d ' . $d . '|' . $s->{'date'}{$d}; } foreach my $d ( sort keys %{ $s->{'pt'} } ) { push @text, '#t ' . $d . '|' . $s->{'pt'}{$d}; } # put the tags if ( $s->{'tags'}->size() ) { push @text, '#g ' . join( " " => sort @{ $s->{'tags'}->members() } ); } # put the source push @text, 'source: ' . $s->{'source'}; # put the translation push @text, 'transl: ' . $s->{'transl'}; # if there is an invalidated string, put that if ( $s->{'invald'} ) { push @text, 'invald: ' . $s->{'invald'}; } return join( "\n" => @text ); } 1;