# remove from a TMX file TUs with specific terminology 
sub remove_match_terms_tu_node {
  my($tmx, $terms, $is_source, $is_target) = @_;

  my @tus = ();
  @tus = @{$tmx->{tmx}->[0]->{body}->[0]->{tu}} if(defined $tmx->{tmx}
+->[0]->{body}->[0]->{tu});
  return($tmx) if(@tus <=0);

  my %removed = ();
  if(defined $is_source) {
    my $lang = $terms->{source}->{srclang};
    my @phrases = @{$terms->{source}->{entry}};

    foreach my $tu(@tus) {
      next if(!defined $tu->{tuid});
      next if(!defined $tu->{tuv});

      my $id = $tu->{tuid};

      if(defined $tu->{tuv}->[0]->{'xml:lang'}
 && lc($tu->{tuv}->[0]->{'xml:lang'}) eq lc($lang)) {
        if(defined $tu->{tuv}->[0]->{seg}->[0]) {
          my $seg = $tu->{tuv}->[0]->{seg}->[0];

          foreach my $p(@phrases) {
            if(lc($p) eq lc($seg)) {
              $removed{$id} = 1; last;
            }
          }
        }

      }
    }

  }
  elsif(defined $is_target) {
    my $lang = $terms->{target}->{tgtlang};
    my @phrases = @{$terms->{target}->{entry}};

    foreach my $tu(@tus) {
      next if(!defined $tu->{tuid});
      next if(!defined $tu->{tuv});
      next if(@{$tu->{tuv}} < 2);

      my $id = $tu->{tuid};

      my $match=0;
      for(my $i=1; $i<@{$tu->{tuv}}; $i++) {
        if(defined $tu->{tuv}->[$i]->{'xml:lang'}
 && lc($tu->{tuv}->[$i]->{'xml:lang'}) eq lc($lang)) {
          if(defined $tu->{tuv}->[$i]->{seg}->[0]) {
            my $seg = $tu->{tuv}->[$i]->{seg}->[0];

            foreach my $p(@phrases) {
              if(lc($p) eq lc($seg)) {
                $removed{$id} = 1; $match=1; last;
              }
            }
          }
        }

        last if($match);
      }
    }
  }

  print "Matching remove_match_terms_tu_node nodes: ", join(',', sort{
+$a<=>$b} keys %removed), "\n" if($debug);

  my @newtus = ();
  foreach my $tu(@tus) {
    next if(!defined $tu->{tuid});

    push(@newtus, $tu) if(!defined $removed{$tu->{tuid}});
  }

  $tmx->{tmx}->[0]->{body}->[0]->{tu} = \@newtus;

  return($tmx);
}

# save tmx file
sub save_tmx_file {
  my($ref, $tmx_file) = @_;

  my $xml;
  eval {
    open my $fh, '>:encoding(utf8)', $tmx_file or die "open($tmx_file)
+: $!\n";

    my $xs = XML::Simple->new();
    $xml = $xs->XMLout($ref, OutputFile => $fh, KeepRoot => 1, NoSort=
+>1, NoEscape=>1, XMLDecl=>'<?xml version="1.0" ?>
<!DOCTYPE tmx SYSTEM "tmx14.dtd">');

    close($fh);

  };

  if($@) {
    warn "failed to write $tmx_file: $@\n";

    return 0;
  }

  return 1;

}

# read terminology file for word/phrases list
sub read_terminology_file {
  my($term_file) = @_;

  my $ref;

  eval {
    my $xs = XML::Simple->new();
    $ref = $xs->XMLin($term_file);

  };

  if($@) {
    warn "failed to read $term_file: $@\n";
  }

  #print Dumper($ref) if($debug);

  return $ref;
}

# read TMX file
sub read_tmx_file {
  my($tmx_file) = @_;

  my $ref;

  eval {
    my $xs = XML::Simple->new();
    $ref = $xs->XMLin($tmx_file, KeepRoot => 1, ForceArray => 1);

  };

  if($@) {
    warn "failed to read $tmx_file: $@\n";
  }

  #print Dumper($ref) if($debug);

  return $ref;
}

# escape element value
sub escape_element_value {
  my($tmx_file, $element_name) = @_;

  open my $fh, "<:utf8", $tmx_file or die "failed to read $tmx_file\n"
+;
  my @lines = <$fh>;
  close($fh);

  for(my $i=0; $i<@lines; $i++) {
    if($lines[$i] =~ /^\s*<$element_name>.*<\/$element_name>\s*$/) {
      $lines[$i] =~ s/<$element_name>(.*)<\/$element_name>/<$element_n
+ame><\!\[CDATA\[$1\]\]><\/$element_name>/i;
    }
  }

  my $escape_tmx = $tmx_file . '_escape';
  open $fh, ">:utf8", $escape_tmx or die "failed to write $escape_tmx\
+n";
  print $fh join('', @lines);

  close($fh);


  return $escape_tmx;
}
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.