view release on metacpan or  search on metacpan

lib/App/Greple/xlate.pm  view on Meta::CPAN

        s/( +)$/"␣" x length($1)/mge;
        print STDERR $_;
    }
}

sub clone_context {
    my $ctx = shift;
    return {
        new_texts    => [ @{$ctx->{new_texts} // []} ],
        source_before => $ctx->{source_before},
        source_after  => $ctx->{source_after},
        hits_before   => [ map [ @$_ ], @{$ctx->{hits_before} // []} ],
        hits_after    => [ map [ @$_ ], @{$ctx->{hits_after}  // []} ],
        old_pairs     => [ map [ @$_ ], @{$ctx->{old_pairs}   // []} ],
    };
}

sub change_span {
    my($old, $new) = @_;
    my @old = split //, $old;
    my @new = split //, $new;
    my $prefix = 0;
    $prefix++ while $prefix < @old && $prefix < @new
        && $old[$prefix] eq $new[$prefix];
    my $suffix = 0;
    $suffix++ while $suffix < @old - $prefix
        && $suffix < @new - $prefix
        && $old[-1 - $suffix] eq $new[-1 - $suffix];
    my $old_len = @old - $prefix - $suffix;
    my $new_len = @new - $prefix - $suffix;
    my $old_change = $old_len
        ? join('', @old[$prefix .. $prefix + $old_len - 1]) : '';
    my $new_change = $new_len
        ? join('', @new[$prefix .. $prefix + $new_len - 1]) : '';
    ($prefix, $old_change, $new_change);
}

sub review_quote {
    local $_ = shift // '';
    s/\\/\\\\/g;
    s/\n/\\n/g;
    s/\t/\\t/g;
    s/"/\\"/g;
    qq{"$_"};
}

sub review_change {
    my($old_source, $new_source, $old_translation, $new_translation) = @_;
    print STDERR "[xlate.pm] Review:\n";
    for my $change (
        [ source => change_span($old_source, $new_source) ],
        [ target => change_span($old_translation, $new_translation) ],
    ) {
        my($label, $offset, $old, $new) = @$change;
        printf STDERR "  %s \@%d: %s -> %s\n",
            $label, $offset, review_quote($old), review_quote($new);
    }
}

sub cache_update {
    binmode STDERR, ':encoding(utf8)';

    my $region = ref $_[0] eq 'HASH' ? shift : { texts => [ @_ ] };
    my @from = @{$region->{texts}};
    my @pristine = @from;
    my $context = $region->{context};

    if ($context) {
        my $refs = @{$context->{hits_before} // []}
                 + @{$context->{hits_after} // []};
        my $olds = @{$context->{old_pairs} // []};
        _progress({label => "Context"},
                  sprintf("%d reference pair(s), %d previous pair(s)",
                          $refs, $olds));
    }
    if ($dryrun) {
        my @preview = @from;
        if ($anonobj) {
            $anonobj->mask(@preview);
            $anonobj->reset;
        }
        if ($maskobj) {
            $maskobj->mask(@preview);
            $maskobj->reset;
        }
        _progress({label => "From"}, @preview);
        # Populate cache with original text so callback can fetch it
        @cache{@{$region->{texts}}} = @from;
        return @from;
    }
    my @result = eval {
        my $masked_context = $context;
        if ($anonobj) {
            $anonobj->mask(@from);
            if ($context) {
                $masked_context = clone_context($context);
                $anonobj->mask_reference(@{$masked_context->{new_texts}});
                $anonobj->mask_reference(
                    $masked_context->{source_before},
                    $masked_context->{source_after});
                for my $pairs (@{$masked_context}{qw(hits_before hits_after old_pairs)}) {
                    $anonobj->mask_reference(@$_) for @$pairs;
                }
            }
        }
        $maskobj->mask(@from) if $maskobj;
        # Show the payload as it will be transmitted, consistent with
        # the dryrun preview and the --xlate-mask display.
        _progress({label => "From"}, @from);
        warn Dumper $masked_context if $context and opt('debug');
        my @chop = grep { $from[$_] =~ s/(?<!\n)\z/\n/ } keys @from;
        my @to = do {
            local $call_context = $masked_context;
            map { s/ +$//mgr } &XLATE(@from);
        };
        chop @to[@chop];
        $maskobj->unmask(@to)->reset if $maskobj;
        if ($anonobj) {
            $anonobj->unmask(@to);
            $anonobj->reset;
        }