harusame/bin/harusame.pl

#!/usr/bin/perl
use strict;

use Getopt::Long;
use Pod::Usage;

my $lang;

GetOptions (
  'lang=s' => \$lang,
  'help' => sub {
    pod2usage (-exitval => 0, -verbose => 2);
  },
) or pod2usage (-exitval => 1, -verbose => 1);

pod2usage (-exitval => 1, -verbose => 1,
           -msg => "Required argument --lang is not specified.\n")
      unless defined $lang;
$lang =~ tr/A-Z/a-z/; ## ASCII case-insensitive.

require Message::DOM::DOMImplementation;
my $dom = Message::DOM::DOMImplementation->new;

my $doc = $dom->create_document;
$doc->manakai_is_html (1);

{
  binmode STDIN, ':encoding(utf8)';
  local $/ = undef;
  $doc->inner_html (scalar <STDIN>);
}

my @remove;

my $containers = $doc->query_selector_all
    ('[data-lang-container], [data-lang-content]');
for my $el (@$containers) {
  next unless $el->parent_node;

  if ($el->has_attribute ('data-lang-container')) {
    my $content = get_content_element ($el);
    next unless $content;
    if ($el->get_attribute ('data-lang-container') eq 'replace') {
      $el->parent_node->replace_child ($content, $el);
    } else {
      $el->text_content ('');
      $el->append_child ($content);
    }
  } elsif ($el->has_attribute ('data-lang-content')) {
    my $idref = $el->get_attribute ('data-lang-content');
    my $container = $doc->get_element_by_id ($idref);
    unless ($container) {
      warn "Element with ID $idref not found\n";
      next;
    }

    my $content = get_content_element ($container);
    $el->text_content ($content->text_content);
    $el->manakai_html_language ($content->manakai_html_language);
    
    if ($container->has_attribute ('data-lang-declaration')) {
      push @remove, $container;
    }
  }
}

for (@remove) {
  next unless $_->parent_node;
  $_->parent_node->remove_child ($_);
}

$doc->document_element->manakai_html_language ($lang);

binmode STDOUT, ':encoding(utf8)';
print STDOUT $doc->inner_html;

sub get_content_element ($) {
  my $container = shift;
  
  my $c_el;
  for my $e (@{$container->child_nodes}) {
    next unless $e->node_type == $e->ELEMENT_NODE;
    my $e_lang = $e->manakai_html_language;
    $e_lang =~ tr/A-Z/a-z/; ## ASCII case-insensitive.
    if ($e_lang eq $lang) {
      $c_el = $e;
      last;
    } else {
      $c_el ||= $e;
    }
  }
  
  return $c_el;
} # get_content_element

__END__

=head1 NAME

harusame.pl - Multilingual Web page management tool

=head1 SYNOPSIS

  perl harusame.pl --lang LANGCODE < input.html > output.html

  perl harusame.pl --help

=head1 DESCRIPTION

The C<harusame.pl> script extracts a version of the HTML document
written in the specified natural language, from a source HTML document
that contains paragraphs in multiple natural languages.

The document management of a multilingual Web site where there are
multiple versions of a (conceptually same) document is somewhat
difficult in general.  If the author of an HTML document wants to edit
a part of the document, then he or she has to ensure not to forget
updating translations at the same time, otherwise documents in
different language versions also differ in their content versions.

Using the C<harusame.pl>, one can generate versions of an HTML
document in different language from one source HTML document that
contains paragraphs written in all of those languages, such that
authors no longer have to manage different content versions and
different language versions in separate files.

=head1 ARGUMENTS

The source document must be provided to the script using the
I<standard input>.  It must be encoded in UTF-8.

The script outputs the generated document encoded in UTF-8 to the
I<standard output>.

Following command-line options are available to this script:

=over 4

=item C<--help>

Show the help message and exit.

=item C<--lang I<LANGCODE>> (B<REQUIRED>)

The language of the version to generate.  This option must be
specified.  The value must be a value that is valid for HTML
C<lang=""> attribute.

=back

=head1 SEE ALSO

Readme L<http://suika.fam.cx/www/harusame/readme>.  How to mark up the
source HTML document is described in this document.

=head1 AUTHOR

Wakaba <w@suika.fam.cx>.

=head1 LICENSE

Copyright 2008 Wakaba <w@suika.fam.cx>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

## $Date: 2008/10/21 08:36:59 $
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3
4			use Getopt::Long;
5			use Pod::Usage;
6
7			my $lang;
8
9			GetOptions (
10			'lang=s' => \$lang,
11			'help' => sub {
12			pod2usage (-exitval => 0, -verbose => 2);
13			},
14			) or pod2usage (-exitval => 1, -verbose => 1);
15
16			pod2usage (-exitval => 1, -verbose => 1,
17			-msg => "Required argument --lang is not specified.\n")
18			unless defined $lang;
19			$lang =~ tr/A-Z/a-z/; ## ASCII case-insensitive.
20
21	wakaba	1.2	require Message::DOM::DOMImplementation;
22	wakaba	1.1	my $dom = Message::DOM::DOMImplementation->new;
23
24			my $doc = $dom->create_document;
25			$doc->manakai_is_html (1);
26
27			{
28			binmode STDIN, ':encoding(utf8)';
29			local $/ = undef;
30			$doc->inner_html (scalar <STDIN>);
31			}
32
33			my @remove;
34
35			my $containers = $doc->query_selector_all
36			('[data-lang-container], [data-lang-content]');
37			for my $el (@$containers) {
38			next unless $el->parent_node;
39
40			if ($el->has_attribute ('data-lang-container')) {
41			my $content = get_content_element ($el);
42			next unless $content;
43			if ($el->get_attribute ('data-lang-container') eq 'replace') {
44			$el->parent_node->replace_child ($content, $el);
45			} else {
46			$el->text_content ('');
47			$el->append_child ($content);
48			}
49			} elsif ($el->has_attribute ('data-lang-content')) {
50			my $idref = $el->get_attribute ('data-lang-content');
51			my $container = $doc->get_element_by_id ($idref);
52			unless ($container) {
53			warn "Element with ID $idref not found\n";
54			next;
55			}
56
57			my $content = get_content_element ($container);
58			$el->text_content ($content->text_content);
59			$el->manakai_html_language ($content->manakai_html_language);
60
61			if ($container->has_attribute ('data-lang-declaration')) {
62			push @remove, $container;
63			}
64			}
65			}
66
67			for (@remove) {
68			next unless $_->parent_node;
69			$_->parent_node->remove_child ($_);
70			}
71
72			$doc->document_element->manakai_html_language ($lang);
73
74			binmode STDOUT, ':encoding(utf8)';
75			print STDOUT $doc->inner_html;
76
77			sub get_content_element ($) {
78			my $container = shift;
79
80			my $c_el;
81			for my $e (@{$container->child_nodes}) {
82			next unless $e->node_type == $e->ELEMENT_NODE;
83			my $e_lang = $e->manakai_html_language;
84			$e_lang =~ tr/A-Z/a-z/; ## ASCII case-insensitive.
85			if ($e_lang eq $lang) {
86			$c_el = $e;
87			last;
88			} else {
89			$c_el \|\|= $e;
90			}
91			}
92
93			return $c_el;
94			} # get_content_element
95
96	wakaba	1.2	__END__
97
98			=head1 NAME
99
100			harusame.pl - Multilingual Web page management tool
101
102			=head1 SYNOPSIS
103
104			perl harusame.pl --lang LANGCODE < input.html > output.html
105
106			perl harusame.pl --help
107
108			=head1 DESCRIPTION
109
110			The C<harusame.pl> script extracts a version of the HTML document
111			written in the specified natural language, from a source HTML document
112			that contains paragraphs in multiple natural languages.
113
114			The document management of a multilingual Web site where there are
115			multiple versions of a (conceptually same) document is somewhat
116			difficult in general. If the author of an HTML document wants to edit
117			a part of the document, then he or she has to ensure not to forget
118			updating translations at the same time, otherwise documents in
119			different language versions also differ in their content versions.
120
121			Using the C<harusame.pl>, one can generate versions of an HTML
122			document in different language from one source HTML document that
123			contains paragraphs written in all of those languages, such that
124			authors no longer have to manage different content versions and
125			different language versions in separate files.
126
127			=head1 ARGUMENTS
128
129			The source document must be provided to the script using the
130			I<standard input>. It must be encoded in UTF-8.
131
132			The script outputs the generated document encoded in UTF-8 to the
133			I<standard output>.
134
135			Following command-line options are available to this script:
136
137			=over 4
138
139			=item C<--help>
140
141			Show the help message and exit.
142
143			=item C<--lang I<LANGCODE>> (B<REQUIRED>)
144
145			The language of the version to generate. This option must be
146			specified. The value must be a value that is valid for HTML
147			C<lang=""> attribute.
148
149			=back
150
151			=head1 SEE ALSO
152
153			Readme L<http://suika.fam.cx/www/harusame/readme>. How to mark up the
154			source HTML document is described in this document.
155
156			=head1 AUTHOR
157
158			Wakaba <w@suika.fam.cx>.
159
160			=head1 LICENSE
161
162			Copyright 2008 Wakaba <w@suika.fam.cx>.
163
164			This library is free software; you can redistribute it and/or modify
165			it under the same terms as Perl itself.
166
167			=cut
168
169			## $Date: 2008/10/21 08:36:59 $