dir2lang

#!/usr/local/bin/perl
=head1 NAME

dir2lang - Convert SIWECOS translations to be used by the application

=head1 SYNOPSIS

B<dir2lang> [B<-v>] [B<--dryrun>] [SCANNER…]

B<dir2wiki> B<--help>|B<--man>

=head1 Description

dir2lang will take all SIWECOS translations found and copy them into PHP files.

If scanner names are given on the commandline, just the texts from those are taken.

=cut
use strict;
use warnings;
use FindBin qw($Bin $Script);
use Getopt::Long qw(:config no_ignore_case);
use Pod::Usage;
use lib "$Bin/lib";
use MediaWiki::API;
use Config::Simplest;
use File::Basename;
use File::Path qw(make_path);
use SIWECOS::Text::Scanner;

my $WARNCOLOR="\e[\$7;31;48m";
my $COLOROFF="\e[0m";

my $EXT='.wiki';
$|= 1;

my $settings= get_config("$Bin/wiki.conf", qw(WIKI API));
my $config= get_config("$Bin/siwecos.conf");

=head1 options

=over 4

=cut

my $dryrun = 0;
=item B<--dryrun>

=item B<-d>

Just test the translations.

=cut

my $test = '';
=item B<--test> DIRNAME

=item B<-t> DIRNAME

Like B<--dryrun> but create the files in DIRNAME.

=cut

my $verbose= 0;

=item B<-v>

Verbose output.

=cut

help() unless GetOptions(
    'v+'         => \$verbose,
    'dryrun'     => \$dryrun,
    'test=s'     => \$test,
    'h|help'     => \&help,
    'm|man'      => \&man,
);

=item B<--help>

short help page

=item B<--man>

show man page

=back

=cut

sub help { pod2usage(-verbose=>1); }
sub man  { pod2usage(-verbose=>2); }

# Location and names of some directories / files
# $Bin = absolute path of this script
# $Script = filename of this script
my $TRANSLATIONS= "$Bin/texts";
my $LANGUAGE_DIR=  $config->{LANGUAGE_DIR}       || "$Bin/lang";
my $WIKI_LINK=     $config->{TARGET_WIKI_LINK}   || "siwecos_wiki";
my $WIKI_EXTERN=   $config->{TARGET_EXTERN_LINK} || "siwecos_extern";
my $TEMPLATEFILE= "$Bin/$Script.txt";
my $SCANNER_NAME= 'SCANNER_NAME';

# Expected purposes
my $DESCRIPTION  = 'Description';
my $HEADLINE     = 'Headline';
my $LINK         = 'Link';
my $ERROR_TEXT   = 'Negative';
my $SUCCESS_TEXT = 'Positive';
my $TIPP         = 'Solution_Tips';

my %PREPARE = (
    $DESCRIPTION  => \&parse_wiki,
    $HEADLINE     => \&oneline_wiki,
    $LINK         => \&wikilink,
    $ERROR_TEXT   => \&oneline_wiki,
    $SUCCESS_TEXT => \&oneline_wiki,
    $TIPP         => \&parse_wiki,
);
my @PURPOSES= sort keys %PREPARE;
# Prepare some output stuff
# Sequence of textnames in output
my @SEQUENCE = (
    $HEADLINE,
    $SUCCESS_TEXT,
    $ERROR_TEXT,
    $DESCRIPTION,
    $TIPP,
    $LINK,
);
my $fill= maxlen( @SEQUENCE);   # number of spaces to use to align values vertically

# First prepare the template
open my $template, '<', $TEMPLATEFILE
    or die "Cannot read template $TEMPLATEFILE: $!\n";
my @template= <$template>;
close $template;

die "Cannot access directory $TRANSLATIONS\n"
    unless -x $TRANSLATIONS and -r $TRANSLATIONS;

my $lang_dir= $test || $LANGUAGE_DIR;
if ( not -d $lang_dir ) {
    make_path($lang_dir)
        or die "Can't create $lang_dir: $!\n";
}
die "Can't write to $lang_dir.\n"
    unless -w $lang_dir;

my $specific= '*';
if (@ARGV) {
    $specific= '{' . join(",", splice(@ARGV)) . '}';
}

my @scanners;
my $all_okay= 1;
my %languages;
foreach my $dir (glob("$TRANSLATIONS/$specific")) {
    print "$dir\n";
    my $scanner= SIWECOS::Text::Scanner->read($dir);
    if ($scanner) {
        $all_okay&&= $scanner->validate == 0;
        push @scanners, $scanner;
        ++$languages{$_} foreach ($scanner->languages)
    } else {
        warn "${WARNCOLOR}Issues with $dir$COLOROFF\n";
        $all_okay= undef;
    }
}

die "Please fix issues first.\n" unless $all_okay;

my $mw = MediaWiki::API->new({
    api_url => $settings->{API},
});

my $standard_prepare= $PREPARE{$HEADLINE};
my $warning= 0;
foreach my $scanner (@scanners) {
    my %missing_language;
    @missing_language{keys %languages}= ();
    delete @missing_language{ $scanner->languages};
    my $scanner_name= $scanner->id;
    foreach my $lang (keys %languages) {
        if (exists $missing_language{$lang}) {
            print "\rScanner $scanner_name: No translation for $lang\n";
            next;
        }
        print "\rScanner $scanner_name, $lang\n" if $verbose;
        my $output= '';
        # go through the template, line by line
        foreach (@template) {
            # Until the placeholder /* DATA HERE */ is found
            if( m#^(\s*)/\*\s*DATA\s*HERE\s*\*/\s*#)  {
                my $err= 0;
                # Remember the indent
                my $indent= $1;
                # SCANNER_NAME COMES FIRST!
                my $textname= $scanner_name;
                $output.= "$indent// These are the $lang texts for $scanner_name\n";
                my $translations= $scanner->name;
                if (defined $translations) {
                    my $text= $translations->text($lang);
                    if( $standard_prepare ){
                        ($text, $err)= $standard_prepare->($mw, $text, "Name of $scanner_name", $lang);
                    }
                    $output.= qq:${indent}'${SCANNER_NAME}' => '$text',\n\n:;
                    $warning+= $err;
                }
                # Texts for Tests
                if (defined $scanner->tests) {
                    foreach my $testname (sort keys %{$scanner->tests}) {
                        my $test= $scanner->test($testname);
                        $output.= "$indent// Test: $testname\n";
                        foreach my $topic (@SEQUENCE) {
                            my $text= $test->topic($topic)->text($lang);
                            my $prepare= $PREPARE{$topic};
                            if( $prepare ){
                                ($text, $err)= $prepare->($mw, $text, "$scanner_name: $testname: $topic", $lang);
                            }
                            my $suffix= uc $topic;
                            my $fillstring= ' ' x ($fill - length $suffix);
                            $output.= qq:$indent'${testname}_$suffix'$fillstring => '$text',\n:;
                            $warning+= $err;
                        }
                        $output.= "\n";
                    }
                }
                # Texts for results
                my $all_results= $scanner->results;
                if (defined $all_results) {
                    $output.= "$indent// Result texts follow\n";
                    my @resultnames= sort keys %{$all_results->results};
                    my $maxlen= maxlen (@resultnames);
                    foreach my $textname (@resultnames) {
                        my $text= $all_results->result($textname)->text($lang);
                        if( $standard_prepare ){
                            ($text, $err)= $standard_prepare->($mw, $text, "$scanner_name: Resulttext $textname", $lang);
                        }
                        my $fillstring= ' ' x ($maxlen - length $textname);
                        $output.= qq:$indent'$textname'$fillstring => '$text',\n:;
                        $warning+= $err;
                    }
                }
            } else {
                # Print an unmodified template line
                $output.= $_;
            }
        }
        if (not $dryrun) {
            if (not -d "$lang_dir/$lang") {
                make_path("$lang_dir/$lang") or
                    die "Cannot create $lang_dir/$lang: $!\n";
            }
            my $outfilename= "$lang_dir/$lang/$scanner_name.php";
            print "Writing $outfilename\n" if $verbose;
            open my $out, '>:utf8', $outfilename
                or die "Failed to create $outfilename: $!\n";
            print $out $output;
            close $out unless $dryrun;
        }
    }
}

$mw->logout();
print $/ unless $verbose;

# done
exit $warning;

sub maxlen {
    my $fill= 0;
    foreach ( @_ ) {
        my $l= length $_;
        $fill= $l if $l > $fill;
    }
    return $fill;
}

sub parse_wiki {
    my($mw, $text, $location, $lang)= @_;
    my $warning= 0;
    local($_)= $text;
    if (defined $_) {
        if (/\[|''/) {
            s#^(\s*):(?=\w)#$1<nowiki>:</nowiki>#mg;
            print "Parsing $location\n" if $verbose;
            my $result= $mw->api({
                action => 'parse',
                format => 'json',
                title => 'none',
                text => $_,
                prop => 'text|links|externallinks',
                disablelimitreport => 'true',
            });
            if( not $result ) {
                die $mw->{error}->{details}. ' ('. $mw->{error}->{code} . ')';
            }
            $_= $result->{parse}->{text}->{'*'};
            foreach my $link (@{$result->{parse}->{links}}) {
                my $printable_link= $link->{'*'};
                my $linktext= quotemeta($printable_link);
                if (not exists $link->{exists}) {
                    warn "${WARNCOLOR}Missing link: $printable_link in $location ($lang).$COLOROFF\n";
                    ++$warning;
                }
                s#(<a\b[^>]+\b)(href=")/wiki(/[^>"]+"[^>]+\btitle="$linktext")#"$1target=\x22$WIKI_LINK\x22 $2".$settings->{WIKI}.$3#ge;
            }
            foreach my $link (@{$result->{parse}->{externallinks}}) {
                my $linktext= quotemeta $link;
                s#(<a\b[^>]*href="$linktext"[^>]*>)#replace_target($1, $WIKI_EXTERN)#ge;
            }
        } else {
            print "Noparse $location\n" if $verbose;
            s/\s+$//s;
            s#\s\s+# </p><p>#sg;
            $_= "<p>$_ </p>";
        }
        s/\\/\\\\/sg;
        s/\n/ /sg;
        s/\r//sg;
        s/'/\\'/sg;
        s/\s+$//s;
    } else {
        warn "${WARNCOLOR}No text in $location.$COLOROFF\n";
        ++$warning;
    }
    return ($_, $warning);
}

sub oneline_wiki {
    local($_);
    my($warning);
    ($_, $warning)= parse_wiki(@_);
    if (defined $_) {
        s#</?p>##sg;
        s/&#160;/ /sg;
        s/\s+$//s;
    }
    return ($_, $warning);
}

sub oneline {
    my($mw, $text, $location, $lang)= @_;
    local($_)= $text;
    s/[\r\n]+/ /sg;
    s/&#160;/ /sg;
    s/\s+$//s;
    return ($_, 0);
}

sub wikilink {
    my($mw, $text, $location, $lang)= @_;
    my $warning= 0;
    for ($text) {
        s/^[\s\012\015]+|[\s\012\015]+$//sg;
        if (/[\015\012]/) {
            die "Links must be single lines.\n"
               . "   Check $location\n";
        }
        if (/[\x00-\x1f]/) {
            die "Illegal characters in link.\n"
            . "   Check $location\n";
        }
    }
    my $pagename= $text."/".uc($lang);
    print "Lookup  $pagename\n" if $verbose;
    my $page= my $ref = eval {
        $mw->get_page( { title => $pagename } );
    };
    if ($@) {
        warn "${WARNCOLOR}Error   $@$COLOROFF\n";
        warn "${WARNCOLOR}Page    $pagename$COLOROFF\n" unless $verbose;
        warn "${WARNCOLOR}Check   $location$COLOROFF\n";
        ++$warning;
    } elsif (exists $page->{missing}) {
        warn "${WARNCOLOR}New     $pagename$COLOROFF\n";
        ++$warning;
    }
    return ($settings->{WIKI}."/".$pagename, $warning);
}

sub replace_target {
    my($a, $target)= @_;
    $a=~ s/(?<=\btarget=)(["'']).*?\1/$1$target$1/g;
    return $a;
}

__DATA__


# We need to use the wiki now
my $done= 0;
my $standard_prepare= $PREPARE{$HEADLINE};
foreach my $scanner (@scanners) {


sub update_percent {
    my($done, $max)= @_;
    ++$$done;
    printf "\r%5.1f%% ", $$done*100/$max;
}

sub maxlen {
    my $fill= 0;
    foreach ( @_ ) {
        my $l= length $_;
        $fill= $l if $l > $fill;
    }
    return $fill;
}

sub read_text {
    my($path)= @_;
    return "Missing $path" unless -d $path;
    return "Can't read $path" unless -r $path;
    my $result;
    foreach my $file (glob("$path/??$EXT")) {
        my $lang= lc basename $file, $EXT;
        ++$LANGUAGES{$lang};
        $result||= {};
        $result->{$lang}{location}= $file;
        open my $in, '<:utf8', $file
            or return "Can't read $file";
        $result->{$lang}{text}= do { local $/; <$in>; };
        close $in;
        for ($result->{$lang}) {
            s/[\012\015]+$//s;
            s/[ \t]+$//gm;
        }
    }
    return $result || "No translations in $path";
}