require HTML::Parser;
require HTML::TreeBuilder;
require HTML::Element;
use File::Basename;
use strict;
use checkargs;
my @section_stack = (); my $current_ref_tdf; my $html_directory;
my %footnotes;
my @sectionmarker = ("manual", "chapter", "section", "subsection", "subsubsection");
my %inline_markup = ("b" => "strong",
"code" => "code",
"i" => "emph",
"kbd" => "kbd",
"samp" => "samp",
"strong" => "strong",
"tt" => "code",
"var" => "var");
my @deferred_index_entries = ();
my @index_titles = (); my %index_info = ("Index" => ["\@blindex", "bl"],
"Concept Index" => ["\@cindex", "cp"],
"Module Index" => ["\@mdindex", "md"]);
my @contents_list = ();
my %contents_hash = ();
my %contents_fixups = ();
my @current_contents_list = ();
sub merge_contents_lists ( )
{ check_args(0, @_);
if (scalar(@current_contents_list) == 0)
{ die "empty current_contents_list"; }
for (my $i=0; $i<scalar(@current_contents_list); $i++)
{ my $ref_c_tdf = $current_contents_list[$i];
if ($i >= scalar(@contents_list))
{ push @contents_list, $ref_c_tdf;
my $title = $ {$ref_c_tdf}[0];
if (defined $contents_hash{$title})
{ $contents_fixups{$title} = 1; }
else
{ $contents_hash{$title} = 1; }
next; }
my $ref_tdf = $contents_list[$i];
my ($title, $depth, $file) = @{$ref_tdf};
my ($c_title, $c_depth, $c_file) = @{$ref_c_tdf};
if (($title ne $c_title)
&& ($depth < $c_depth)
&& ($file ne $c_file))
{ splice @contents_list, $i, 0, $ref_c_tdf;
if (defined $contents_hash{$c_title})
{ $contents_fixups{$c_title} = 1; }
else
{ $contents_hash{$c_title} = 1; }
next; }
if (($title ne $c_title)
|| ($depth != $c_depth)
|| ($file ne $c_file))
{ die ("while processing $ {$current_ref_tdf}[2] at depth $ {$current_ref_tdf}[1], mismatch at index $i:",
"\n main: <<<$title>>> $depth $file",
"\n curr: <<<$c_title>>> $c_depth $c_file"); }
}
@current_contents_list = ();
}
sub process_child_links ( $ )
{ my ($he) = check_args(1, @_);
if (scalar(@current_contents_list) != 0)
{ die "current_contents_list nonempty: @current_contents_list"; }
$he->traverse(\&increment_current_contents_list, 'ignore text');
my %depths = ();
for my $ref_tdf (@current_contents_list)
{ $depths{$ {$ref_tdf}[1]} = 1; }
my @sorted_depths = sort keys %depths;
my $current_depth = scalar(@section_stack)-1;
my $current_depth_2 = $ {$current_ref_tdf}[1];
if ($current_depth != $current_depth_2)
{ die "mismatch in current depths: $current_depth $current_depth_2; ", join(", ", @section_stack); }
for (my $i=0; $i<scalar(@sorted_depths); $i++)
{ $depths{$sorted_depths[$i]} = $i + $current_depth+1; }
for my $ref_tdf (@current_contents_list)
{ $ {$ref_tdf}[1] = $depths{$ {$ref_tdf}[1]}; }
if ($ {$current_contents_list[-1]}[0] eq "About this document ...")
{ pop @current_contents_list; }
if ((scalar(@current_contents_list) > 1)
&& ($ {$current_contents_list[1]}[0] eq "Contents"))
{ my $ref_first_tdf = shift @current_contents_list;
$current_contents_list[0] = $ref_first_tdf; }
for (my $i=0; $i<scalar(@current_contents_list); $i++)
{ my $ref_tdf = $current_contents_list[$i];
my $title = $ {$ref_tdf}[0];
if (exists $index_info{$title})
{ my $index_file = $ {$ref_tdf}[2];
my ($indexing_command, $suffix) = @{$index_info{$title}};
process_index_file($index_file, $indexing_command);
print TEXI "\n\@defindex $suffix\n";
push @index_titles, $title;
splice @current_contents_list, $i, 1;
$i--; }
elsif ($title =~ /\bIndex$/)
{ print STDERR "Warning: \"$title\" might be an index; if so, edit \%index_info.\n"; } }
merge_contents_lists();
}
sub increment_current_contents_list ( $$$ )
{ my ($he, $startflag, $depth) = check_args(3, @_);
if (!$startflag)
{ return; }
if ($he->tag eq "li")
{ my @li_content = @{$he->content};
if ($li_content[0]->tag ne "a")
{ die "first element of <LI> should be <A>"; }
my ($name, $href, @content) = anchor_info($li_content[0]);
my $title = join("", collect_texts($li_content[0]));
$title = texi_remove_punctuation($title);
$title =~ s/``/\"/g;
$title =~ s/''/\"/g;
$title =~ s/ -- / /g;
push @current_contents_list, [ $title, $depth, $href ]; }
return 1;
}
sub html_to_texi ( $ )
{ my ($he) = check_args(1, @_);
if (!ref $he)
{ return $he; }
my $tag = $he->tag;
if (exists $inline_markup{$tag})
{ my $result = "\@$inline_markup{$tag}\{";
for my $elt (@{$he->content})
{ $result .= html_to_texi($elt); }
$result .= "\}";
return $result; }
else
{ $he->dump();
die "html_to_texi confused by <$tag>"; }
}
sub print_contents_list ()
{ check_args(0, @_);
print STDERR "Contents list:\n";
for my $ref_tdf (@contents_list)
{ my ($title, $depth, $file) = @{$ref_tdf};
print STDERR "$title $depth $file\n"; }
}
my $l2h_broken_link_name = "l2h-";
my %file_index_entries = ();
my %this_index_entries;
my %file_index_entries_broken = (); my @this_index_entries_broken;
my $index_prefix = "";
my @index_prefixes = ();
my $this_indexing_command;
sub print_index_info ()
{ check_args(0, @_);
my ($key, $val);
for my $file (sort keys %file_index_entries)
{ my %index_entries = %{$file_index_entries{$file}};
print STDERR "file: $file\n";
for my $aname (sort keys %index_entries)
{ my @entries = @{$index_entries{$aname}};
if (scalar(@entries) == 1)
{ print STDERR " $aname : $entries[0]\n"; }
else
{ print STDERR " $aname : ", join("\n " . (" " x length($aname)), @entries), "\n"; } } }
for my $file (sort keys %file_index_entries_broken)
{ my @entries = @{$file_index_entries_broken{$file}};
print STDERR "file: $file\n";
for my $entry (@entries)
{ print STDERR " $entry\n"; }
}
}
sub process_index_file ( $$ )
{ my ($file, $indexing_command) = check_args(2, @_);
my $he = file_to_tree($html_directory . $file);
$this_indexing_command = $indexing_command;
$he->traverse(\&process_if_index_dl_compact, 'ignore text');
undef $this_indexing_command;
}
sub process_if_index_dl_compact ( $$$ )
{ my ($he, $startflag) = (check_args(3, @_))[0,1]; if (!$startflag)
{ return; }
if (($he->tag() eq "dl") && (defined $he->attr('compact')))
{ process_index_dl_compact($he);
return 0; }
else
{ return 1; }
}
sub process_index_dl_compact ( $ )
{ my ($h) = check_args(1, @_);
my @content = @{$h->content()};
for (my $i = 0; $i < scalar(@content); $i++)
{ my $this_he = $content[$i];
if ($this_he->tag ne "dt")
{ $this_he->dump();
die "Expected <DT> tag: " . $this_he->tag; }
if (($i < scalar(@content) - 1) && ($content[$i+1]->tag eq "dd"))
{ process_index_dt_and_dd($this_he, $content[$i+1]);
$i++; }
else
{ process_index_lone_dt($this_he); } } }
sub process_index_lone_dt ( $ )
{ my ($dt) = check_args(1, @_);
my @dtcontent = @{$dt->content()};
my $acontent;
my $acontent_suffix;
for my $a (@dtcontent)
{ if ($a eq ", ")
{ next; }
if (!ref $a)
{ $dt->dump;
die "Unexpected <DT> string element: $a"; }
if ($a->tag eq "dl")
{ push @index_prefixes, $index_prefix;
if (!defined $acontent_suffix)
{ die "acontent_suffix not yet defined"; }
$index_prefix .= $acontent_suffix . ", ";
process_index_dl_compact($a);
$index_prefix = pop(@index_prefixes);
return; }
if ($a->tag ne "a")
{ $dt->dump;
$a->dump;
die "Expected anchor in lone <DT>"; }
my ($aname, $ahref, @acontent) = anchor_info($a);
if (scalar(@acontent) != 1)
{ die "Expected just one content of <A> in <DT>: @acontent"; }
if (ref $acontent[0])
{ $acontent[0]->dump;
die "Expected string content of <A> in <DT>: $acontent[0]"; }
if (!defined($acontent))
{ $acontent = $index_prefix . $acontent[0];
$acontent_suffix = $acontent[0]; }
elsif (($acontent[0] ne "[Link]") && ($acontent ne ($index_prefix . $acontent[0])))
{ die "Differing content: <<<$acontent>>>, <<<$acontent[0]>>>"; }
if (!defined $ahref)
{ $dt->dump;
die "no HREF in nachor in <DT>"; }
my ($ahref_file, $ahref_name) = split(/\ if (!defined $ahref_name)
{ $ahref_name = ""; }
if ($ahref_name eq $l2h_broken_link_name)
{ if (!exists $file_index_entries_broken{$ahref_file})
{ $file_index_entries_broken{$ahref_file} = []; }
push @{$file_index_entries_broken{$ahref_file}}, "$this_indexing_command $acontent";
next; }
if (!exists $file_index_entries{$ahref_file})
{ $file_index_entries{$ahref_file} = {}; }
if (!exists $ {$file_index_entries{$ahref_file}}{$ahref_name})
{ $ {$file_index_entries{$ahref_file}}{$ahref_name} = []; }
push @{$ {$file_index_entries{$ahref_file}}{$ahref_name}}, "$this_indexing_command $acontent";
}
}
sub process_index_dt_and_dd ( $$ )
{ my ($dt, $dd) = check_args(2, @_);
my $dtcontent;
{ my @dtcontent = @{$dt->content()};
if ((scalar(@dtcontent) != 1) || (ref $dtcontent[0]))
{ $dd->dump;
$dt->dump;
die "Expected single string (actual size = " . scalar(@dtcontent) . ") in content of <DT>: @dtcontent"; }
$dtcontent = $dtcontent[0];
$dtcontent =~ s/ +$//; }
my $ddcontent;
{ my @ddcontent = @{$dd->content()};
if (scalar(@ddcontent) != 1)
{ die "Expected single <DD> content, got ", scalar(@ddcontent), " elements:\n", join("\n", @ddcontent), "\n "; }
$ddcontent = $ddcontent[0]; }
if ($ddcontent->tag ne "dl")
{ die "Expected <DL> as content of <DD>, but saw: $ddcontent"; }
push @index_prefixes, $index_prefix;
$index_prefix .= $dtcontent . ", ";
process_index_dl_compact($ddcontent);
$index_prefix = pop(@index_prefixes);
}
sub process_section_file ( $$$ )
{ my ($file, $depth, $nodetitle) = check_args(3, @_);
my $he = file_to_tree(($file =~ /^\//) ? $file : $html_directory . $file);
@section_stack = @section_stack[0..$depth-1];
if ((defined $contents_fixups{$nodetitle})
&& (scalar(@section_stack) > 0))
{ my $up_title = $section_stack[$ $up_title =~ s/^(Built-in|Standard) Module //g;
my ($up_first_word) = split(/ /, $up_title);
$nodetitle = "$up_first_word $nodetitle";
}
push @section_stack, $nodetitle;
$he->traverse(\&process_if_child_links, 'ignore text');
%footnotes = ();
$he->traverse(\&process_if_footnotes, 'ignore text');
if (exists $file_index_entries{$file})
{ %this_index_entries = %{$file_index_entries{$file}};
}
else
{ %this_index_entries = (); }
if (exists $file_index_entries_broken{$file})
{ @this_index_entries_broken = @{$file_index_entries_broken{$file}}; }
else
{ @this_index_entries_broken = (); }
if ($he->tag() ne "html")
{ die "Expected <HTML> at top level"; }
my @content = @{$he->content()};
if ((!ref $content[0]) or ($content[0]->tag ne "head"))
{ $he->dump;
die "<HEAD> not first element of <HTML>"; }
if ((!ref $content[1]) or ($content[1]->tag ne "body"))
{ $he->dump;
die "<BODY> not second element of <HTML>"; }
$content[1]->traverse(\&output_body);
}
my @index_deferrers = ();
sub push_or_pop_index_deferrers ( $$ )
{ my ($tag, $startflag) = check_args(2, @_);
if ($startflag)
{ push @index_deferrers, $tag; }
else
{ my $old_deferrer = pop @index_deferrers;
if ($tag ne $old_deferrer)
{ die "Expected $tag at top of index_deferrers but saw $old_deferrer; remainder = ", join(" ", @index_deferrers); }
do_deferred_index_entries(); }
}
sub label_add_index_entries ( $;$ )
{ my ($label, $he) = check_args_range(1, 2, @_);
if (exists $this_index_entries{$label})
{ push @deferred_index_entries, @{$this_index_entries{$label}};
return; }
if ($label eq $l2h_broken_link_name)
{ my @anchor_texts = collect_texts($he);
my @previous_texts = collect_texts($he->parent, $he);
my @candidate_texts = (@anchor_texts, (reverse(@previous_texts))[0..min(3,$
my $guessed = 0;
for my $text (@candidate_texts)
{ if ($text =~ /^[\"\`\'().?! ]*$/)
{ next; }
if (length($text) <= 2)
{ next; }
$text =~ s/^sys\.//g;
for my $iterm (@this_index_entries_broken)
{ if (index($iterm, $text) != -1)
{ push @deferred_index_entries, $iterm;
$guessed = 1;
} } }
if (!$guessed)
{ }
}
}
sub do_deferred_index_entries ()
{ check_args(0, @_);
if ((scalar(@deferred_index_entries) > 0)
&& (scalar(@index_deferrers) == 0))
{ print TEXI "\n", join("\n", @deferred_index_entries), "\n";
@deferred_index_entries = (); }
}
my $table_columns; my $table_first_column;
sub output_body ( $$$ )
{ my ($he, $startflag) = (check_args(3, @_))[0,1];
if (!ref $he)
{ my $space_index = index($he, " ");
if ($space_index != -1)
{ print TEXI &texi_quote(substr($he, 0, $space_index+1));
do_deferred_index_entries();
print TEXI &texi_quote(substr($he, $space_index+1)); }
else
{ print TEXI &texi_quote($he); }
return; }
my $tag = $he->tag();
if (exists $inline_markup{$tag})
{ if ($startflag)
{ print TEXI "\@$inline_markup{$tag}\{"; }
else
{ print TEXI "\}"; } }
elsif ($tag eq "a")
{ my ($name, $href, @content) = anchor_info($he);
if (!$href)
{ if ($startflag)
{ label_add_index_entries($name, $he); }
}
elsif ($href =~ "^(ftp|http|news):")
{ if ($startflag)
{ print TEXI "\@uref\{$href, "; }
else
{ print TEXI "\}"; }
}
elsif ($href =~ /^\ { if ($startflag)
{ print TEXI "\@footnote\{";
$footnotes{$1}->traverse(\&output_body);
print TEXI "\}";
return 0; } }
else
{ if ($startflag)
{ print STDERR "Can't deal with internal HREF anchors yet:\n";
$he->dump; }
}
}
elsif ($tag eq "br")
{ print TEXI "\@\n"; }
elsif ($tag eq "body")
{ }
elsif ($tag eq "center")
{ if (has_single_content_string($he)
&& ($ {$he->content}[0] =~ /^ *$/))
{ return 0; }
if ($startflag)
{ print TEXI "\n\@center\n"; }
else
{ print TEXI "\n\@end center\n"; }
}
elsif ($tag eq "div")
{ my $align = $he->attr('align');
if (defined($align) && ($align eq "center"))
{ if (has_single_content_string($he)
&& ($ {$he->content}[0] =~ /^ *$/))
{ return 0; }
if ($startflag)
{ print TEXI "\n\@center\n"; }
else
{ print TEXI "\n\@end center\n"; } }
}
elsif ($tag eq "dl")
{ if (has_single_content_with_tag($he, "dd"))
{ my $he_dd = $ {$he->content}[0];
if (has_single_content_with_tag($he_dd, "pre"))
{ my $he_pre = $ {$he_dd->content}[0];
print_pre($he_pre);
return 0; } }
if ($startflag)
{ print TEXI "\n\@table \@asis\n"; }
else
{ print TEXI "\n\@end table\n"; }
}
elsif ($tag eq "dt")
{ push_or_pop_index_deferrers($tag, $startflag);
if ($startflag)
{ print TEXI "\n\@item "; }
else
{ } }
elsif ($tag eq "dd")
{ if ($startflag)
{ print TEXI "\n"; }
else
{ }
if (scalar(@index_deferrers) != 0)
{ $he->dump;
die "Unexpected <$tag> while inside: (" . join(" ", @index_deferrers) . "); bad HTML?"; }
do_deferred_index_entries();
}
elsif ($tag =~ /^(font|big|small)$/)
{ }
elsif ($tag =~ /^h[1-6]$/)
{ my $secname = "";
my @seclabels = ();
for my $elt (@{$he->content})
{ if (!ref $elt)
{ $secname .= $elt; }
elsif ($elt->tag eq "br")
{ }
elsif ($elt->tag eq "a")
{ my ($name, $href, @acontent) = anchor_info($elt);
if ($href)
{ $he->dump;
$elt->dump;
die "Nonsimple anchor in <$tag>"; }
if (!defined $name)
{ die "No NAME for anchor in $tag"; }
push @seclabels, $name;
for my $subelt (@acontent)
{ $secname .= html_to_texi($subelt); } }
else
{ $secname .= html_to_texi($elt); } }
if ($secname eq "")
{ die "No section name in <$tag>"; }
if (scalar(@section_stack) == 1)
{ if ($section_stack[-1] ne "Top")
{ die "Not top? $section_stack[-1]"; }
print TEXI "\@settitle $secname\n";
print TEXI "\@c %**end of header\n";
print TEXI "\n";
print TEXI "\@node Top\n";
print TEXI "\n"; }
else
{ print TEXI "\n\@node $section_stack[-1]\n";
print TEXI "\@$sectionmarker[scalar(@section_stack)-1] ", texi_remove_punctuation($secname), "\n"; }
for my $seclabel (@seclabels)
{ label_add_index_entries($seclabel); }
label_add_index_entries("");
if (scalar(@index_deferrers) != 0)
{ $he->dump;
die "Unexpected <$tag> while inside: (" . join(" ", @index_deferrers) . "); bad HTML?"; }
do_deferred_index_entries();
return 0;
}
elsif ($tag eq "hr")
{ }
elsif ($tag eq "ignore")
{ return 0;
}
elsif ($tag eq "li")
{ if ($startflag)
{ print TEXI "\n\n\@item\n";
do_deferred_index_entries(); } }
elsif ($tag eq "ol")
{ if ($startflag)
{ print TEXI "\n\@enumerate \@bullet\n"; }
else
{ print TEXI "\n\@end enumerate\n"; } }
elsif ($tag eq "p")
{ if ($startflag)
{ print TEXI "\n\n"; }
if (scalar(@index_deferrers) != 0)
{ $he->dump;
die "Unexpected <$tag> while inside: (" . join(" ", @index_deferrers) . "); bad HTML?"; }
do_deferred_index_entries(); }
elsif ($tag eq "pre")
{ print_pre($he);
return 0; }
elsif ($tag eq "table")
{ if ($startflag)
{ if (defined $table_columns)
{ $he->dump;
die "Can't deal with table nested inside $table_columns-column table"; }
$table_columns = table_columns($he);
if ($table_columns < 2)
{ $he->dump;
die "Column with $table_columns columns?"; }
elsif ($table_columns == 2)
{ print TEXI "\n\@table \@asis\n"; }
else
{ print TEXI "\n\@multitable \@columnfractions";
for (my $i=0; $i<$table_columns; $i++)
{ print TEXI " ", 1.0/$table_columns; }
print TEXI "\n"; } }
else
{ if ($table_columns == 2)
{ print TEXI "\n\@end table\n"; }
else
{ print TEXI "\n\@end multitable\n"; }
undef $table_columns; } }
elsif (($tag eq "td") || ($tag eq "th"))
{ if ($startflag)
{ if ($table_first_column)
{ print TEXI "\n\@item ";
$table_first_column = 0; }
elsif ($table_columns > 2)
{ print TEXI "\n\@tab "; } }
else
{ print TEXI "\n"; } }
elsif ($tag eq "tr")
{ if ($startflag)
{ $table_first_column = 1; } }
elsif ($tag eq "ul")
{ if ($startflag)
{ print TEXI "\n\@itemize \@bullet\n"; }
else
{ print TEXI "\n\@end itemize\n"; } }
else
{ print STDERR "output_body: ignoring <$tag> tag\n";
$he->dump;
return 0; }
return 1;
}
sub print_pre ( $ )
{ my ($he_pre) = check_args(1, @_);
if (!has_single_content_string($he_pre))
{ die "Multiple or non-string content for <PRE>: ", @{$he_pre->content}; }
my $pre_content = $ {$he_pre->content}[0];
print TEXI "\n\@example";
print TEXI &texi_quote($pre_content);
print TEXI "\@end example\n";
}
sub table_columns ( $ )
{ my ($table) = check_args(1, @_);
my $result = 0;
for my $row (@{$table->content})
{ if ($row->tag ne "tr")
{ $table->dump;
$row->dump;
die "Expected <TR> as table row."; }
$result = max($result, scalar(@{$row->content})); }
return $result;
}
sub min ( $$ )
{ my ($x, $y) = check_args(2, @_);
return ($x < $y) ? $x : $y;
}
sub max ( $$ )
{ my ($x, $y) = check_args(2, @_);
return ($x > $y) ? $x : $y;
}
sub file_to_tree ( $ )
{ my ($file) = check_args(1, @_);
my $tree = new HTML::TreeBuilder;
$tree->ignore_unknown(1);
$tree->parse_file($file);
cleanup_parse_tree($tree);
return $tree
}
sub has_single_content ( $ )
{ my ($he) = check_args(1, @_);
if (!ref $he)
{ die "Non-reference argument: $he"; }
my $ref_content = $he->content;
if (!defined $ref_content)
{ return 0; }
my @content = @{$ref_content};
if (scalar(@content) != 1)
{ return 0; }
return 1;
}
sub has_single_content_with_tag ( $$ )
{ my ($he, $tag) = check_args(2, @_);
if (!has_single_content($he))
{ return 0; }
my $content = $ {$he->content}[0];
if (!ref $content)
{ return 0; }
my $content_tag = $content->tag;
if (!defined $content_tag)
{ return 0; }
return $content_tag eq $tag;
}
sub has_single_content_string ( $ )
{ my ($he) = check_args(1, @_);
if (!has_single_content($he))
{ return 0; }
my $content = $ {$he->content}[0];
if (ref $content)
{ return 0; }
return 1;
}
sub anchor_info ( $ )
{ my ($he) = check_args(1, @_);
if ($he->tag ne "a")
{ $he->dump;
die "passed non-anchor to anchor_info"; }
my $name = $he->attr('name');
my $href = $he->attr('href');
my @content = ();
{ my $ref_content = $he->content;
if (defined $ref_content)
{ @content = @{$ref_content}; } }
return ($name, $href, @content);
}
sub texi_quote ( $ )
{ my ($text) = check_args(1, @_);
$text =~ s/([\@\{\}])/\@$1/g;
$text =~ s/ -- / --- /g;
return $text;
}
sub texi_remove_punctuation ( $ )
{ my ($text) = check_args(1, @_);
$text =~ s/^ +//g;
$text =~ s/[ :]+$//g;
$text =~ s/^[1-9][0-9.]* +//g;
$text =~ s/,//g;
$text =~ s/://g;
return $text;
}
sub html_remove ( $;$ )
{ my ($he, $parent) = check_args_range(1, 2, @_);
if (!defined $parent)
{ $parent = $he->parent; }
my $ref_pcontent = $parent->content;
my @pcontent = @{$ref_pcontent};
for (my $i=0; $i<scalar(@pcontent); $i++)
{ if ($pcontent[$i] eq $he)
{ splice @{$ref_pcontent}, $i, 1;
$he->parent(undef);
return 1; } }
die "Didn't find $he in $parent";
}
sub html_replace ( $$;$ )
{ my ($orig, $new, $parent) = check_args_range(2, 3, @_);
if (!defined $parent)
{ $parent = $orig->parent; }
my $ref_pcontent = $parent->content;
my @pcontent = @{$ref_pcontent};
for (my $i=0; $i<scalar(@pcontent); $i++)
{ if ($pcontent[$i] eq $orig)
{ $ {$ref_pcontent}[$i] = $new;
$new->parent($parent);
$orig->parent(undef);
return 1; } }
die "Didn't find $orig in $parent";
}
sub html_replace_by_meta ( $;$ )
{ my ($orig, $parent) = check_args_range(1, 2, @_);
my $meta = new HTML::Element "meta";
if (!defined $parent)
{ $parent = $orig->parent; }
return html_replace($orig, $meta, $parent);
}
sub html_replace_by_ignore ( $;$ )
{ my ($orig, $parent) = check_args_range(1, 2, @_);
my $ignore = new HTML::Element "ignore";
if (!defined $parent)
{ $parent = $orig->parent; }
return html_replace($orig, $ignore, $parent);
}
my @collected_texts;
my $collect_texts_stoppoint;
my $done_collecting;
sub collect_texts ( $;$ )
{ my ($root, $stop) = check_args_range(1, 2, @_);
$collect_texts_stoppoint = $stop;
$done_collecting = 0;
@collected_texts = ();
$root->traverse(\&collect_if_text); return @collected_texts;
}
sub collect_if_text ( $$$ )
{ my $he = (check_args(3, @_))[0]; if ($done_collecting)
{ return 0; }
if (!defined $he)
{ return 0; }
if (!ref $he)
{ push @collected_texts, $he;
return 0; }
if ((defined $collect_texts_stoppoint) && ($he eq $collect_texts_stoppoint))
{ $done_collecting = 1;
return 0; }
return 1;
}
sub cleanup_parse_tree ( $ )
{ my ($he) = check_args(1, @_);
$he->traverse(\&delete_if_navigation, 'ignore text');
$he->traverse(\&delete_extra_spaces, 'ignore text');
$he->traverse(\&merge_dl, 'ignore text');
$he->traverse(\&reorder_dt_and_dl, 'ignore text');
return $he;
}
sub delete_if_navigation ( $$$ )
{ my ($he, $startflag) = (check_args(3, @_))[0,1]; if (!$startflag)
{ return; }
if (($he->tag() eq "div") && (defined $he->attr('class')) && ($he->attr('class') eq 'navigation'))
{ my $ref_pcontent = $he->parent()->content();
for (my $i = 0; $i<scalar(@{$ref_pcontent}); $i++)
{ if (${$ref_pcontent}[$i] eq $he)
{ splice(@{$ref_pcontent}, $i, 1);
last; } }
$he->delete();
return 0; }
else
{ return 1; }
}
sub delete_extra_spaces ( $$$ )
{ my ($he, $startflag) = (check_args(3, @_))[0,1]; if (!$startflag)
{ return; }
my $tag = $he->tag;
if ($tag =~ /^(head|html|table|tr|ul)$/)
{ delete_child_spaces($he); }
delete_trailing_spaces($he);
return 1;
}
sub delete_child_spaces ( $ )
{ my ($he) = check_args(1, @_);
my $ref_content = $he->content();
for (my $i = 0; $i<scalar(@{$ref_content}); $i++)
{ if ($ {$ref_content}[$i] =~ /^ *$/)
{ splice(@{$ref_content}, $i, 1);
$i--; } }
}
sub delete_trailing_spaces ( $ )
{ my ($he) = check_args(1, @_);
my $ref_content = $he->content();
if (! defined $ref_content)
{ return; }
for (my $i = 0; $i<scalar(@{$ref_content})-1; $i++)
{ if ($ {$ref_content}[$i] =~ /^ *$/)
{ my $next_elt = $ {$ref_content}[$i+1];
if ((ref $next_elt) && ($next_elt->tag =~ /^(br|dd|dl|dt|hr|p|ul)$/))
{ splice(@{$ref_content}, $i, 1);
$i--; } } }
if ($he->tag =~ /^(dd|dt|^h[1-6]|li|p)$/)
{ my $last_elt = $ {$ref_content}[$ if ((defined $last_elt) && ($last_elt =~ /^ *$/))
{ pop @{$ref_content}; } }
}
sub reorder_dt_and_dl ( $$$ )
{ my ($he, $startflag) = (check_args(3, @_))[0,1]; if (!$startflag)
{ return; }
if ($he->tag() eq "p")
{ my $ref_pcontent = $he->content();
if (defined $ref_pcontent)
{ my @pcontent = @{$ref_pcontent};
if ((scalar(@pcontent) >= 1)
&& (ref $pcontent[0]) && ($pcontent[0]->tag() eq "dl")
&& $pcontent[0]->implicit())
{ my $ref_dlcontent = $pcontent[0]->content();
if (defined $ref_dlcontent)
{ my @dlcontent = @{$ref_dlcontent};
if ((scalar(@dlcontent) >= 1)
&& (ref $dlcontent[0]) && ($dlcontent[0]->tag() eq "dt"))
{ my $ref_dtcontent = $dlcontent[0]->content();
if (defined $ref_dtcontent)
{ my @dtcontent = @{$ref_dtcontent};
if ((scalar(@dtcontent) > 0)
&& (ref $dtcontent[$ && ($dtcontent[$ { my $ref_dl2content = $dtcontent[$ if (defined $ref_dl2content)
{ my @dl2content = @{$ref_dl2content};
if ((scalar(@dl2content) > 0)
&& (ref ($dl2content[0]))
&& ($dl2content[0]->tag() eq "dd"))
{
html_replace_by_ignore($dtcontent[$ splice(@{$ref_dlcontent}, 1, 0, @dl2content);
return 0; } } } } } } } } }
return 1;
}
sub process_if_child_links ( $$$ )
{ my ($he, $startflag) = (check_args(3, @_))[0,1]; if (!$startflag)
{ return; }
if ($he->tag() eq "p")
{ my $ref_content = $he->content();
if (defined $ref_content)
{ my @content = @{$ref_content};
if ((scalar(@content) == 2)
&& (ref $content[0]) && $content[0]->tag() eq "hr"
&& (ref $content[1]) && $content[1]->tag() eq "ul")
{ process_child_links($he);
$he->delete();
return 0; } } }
return 1;
}
my $process_if_footnotes_expect_dl_next = 0;
sub process_if_footnotes ( $$$ )
{ my ($he, $startflag) = (check_args(3, @_))[0,1]; if (!$startflag)
{ return; }
if (($he->tag() eq "h4")
&& has_single_content_string($he)
&& ($ {$he->content}[0] eq "Footnotes"))
{ html_replace_by_ignore($he);
$process_if_footnotes_expect_dl_next = 1;
return 0; }
if ($process_if_footnotes_expect_dl_next && ($he->tag() eq "dl"))
{ my $ref_content = $he->content();
if (defined $ref_content)
{ $process_if_footnotes_expect_dl_next = 0;
my @content = @{$ref_content};
for (my $i=0; $i<$ { my $he_dt = $content[$i];
my $he_dd = $content[$i+1];
if (($he_dt->tag ne "dt") || ($he_dd->tag ne "dd"))
{ $he->dump;
die "expected <DT> and <DD> at positions $i and ", $i+1; }
my @dt_content = @{$he_dt->content()};
if ((scalar(@dt_content) != 2)
|| ($dt_content[0]->tag ne "a")
|| ($dt_content[1]->tag ne "a"))
{ $he_dt->dump;
die "Expected 2 anchors as content of <DT>"; }
my ($dt1_name, $dt1_href, $dt1_content) = anchor_info($dt_content[0]);
my ($dt2_name, $dt2_href, $dt2_content) = anchor_info($dt_content[0]);
if ($dt1_name ne $dt2_name)
{ $he_dt->dump;
die "Expected identical names for anchors"; }
html_replace_by_ignore($he_dd);
$he_dd->tag("div"); $footnotes{$dt1_name} = $he_dd; }
html_replace_by_ignore($he);
return 0; } }
if ($process_if_footnotes_expect_dl_next)
{ $he->dump;
die "Expected <DL> for footnotes next"; }
return 1;
}
sub merge_dl ( $$$ )
{ my ($he, $startflag) = (check_args(3, @_))[0,1]; if (!$startflag)
{ return; }
my $ref_content = $he->content;
if (!defined $ref_content)
{ return; }
my $i = 0;
while ($i < scalar(@{$ref_content})-1)
{ my $p1 = $ {$ref_content}[$i];
if ((ref $p1) && ($p1->tag eq "p")
&& has_single_content_with_tag($p1, "dl"))
{ my $dl1 = $ {$p1->content}[0];
while ($i < scalar(@{$ref_content})-1)
{ my $p2 = $ {$ref_content}[$i+1];
if (!((ref $p2) && ($p2->tag eq "p")
&& has_single_content_with_tag($p2, "dl")))
{ last; }
splice(@{$ref_content}, $i+1, 1); my $dl2 = $ {$p2->content}[0];
$dl1->push_content(@{$dl2->content}); }
$i++; }
$i++; }
return 1;
}
sub test ( $$ )
{ my ($action, $file) = check_args(2, @_);
if (($action eq "view") || ($action eq ""))
{ my $tree = file_to_tree($file);
$tree->dump();
return;
}
elsif ($action eq "raw")
{ my $tree = new HTML::TreeBuilder;
$tree->ignore_unknown(1);
$tree->parse_file($file);
$tree->dump();
return;
}
elsif ($action eq "section")
{ process_section_file($file, 0, "Title");
}
elsif (0)
{ my @files = ("/homes/fish/mernst/tmp/python-doc/html/api/about.html",
"/homes/fish/mernst/tmp/python-doc/html/api/abstract.html",
"/homes/fish/mernst/tmp/python-doc/html/api/api.html",
"/homes/fish/mernst/tmp/python-doc/html/api/cObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/complexObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/concrete.html",
"/homes/fish/mernst/tmp/python-doc/html/api/countingRefs.html",
"/homes/fish/mernst/tmp/python-doc/html/api/debugging.html",
"/homes/fish/mernst/tmp/python-doc/html/api/dictObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/embedding.html",
"/homes/fish/mernst/tmp/python-doc/html/api/exceptionHandling.html",
"/homes/fish/mernst/tmp/python-doc/html/api/exceptions.html",
"/homes/fish/mernst/tmp/python-doc/html/api/fileObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/floatObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/front.html",
"/homes/fish/mernst/tmp/python-doc/html/api/fundamental.html",
"/homes/fish/mernst/tmp/python-doc/html/api/importing.html",
"/homes/fish/mernst/tmp/python-doc/html/api/includes.html",
"/homes/fish/mernst/tmp/python-doc/html/api/index.html",
"/homes/fish/mernst/tmp/python-doc/html/api/initialization.html",
"/homes/fish/mernst/tmp/python-doc/html/api/intObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/intro.html",
"/homes/fish/mernst/tmp/python-doc/html/api/listObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/longObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/mapObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/mapping.html",
"/homes/fish/mernst/tmp/python-doc/html/api/newTypes.html",
"/homes/fish/mernst/tmp/python-doc/html/api/node24.html",
"/homes/fish/mernst/tmp/python-doc/html/api/noneObject.html",
"/homes/fish/mernst/tmp/python-doc/html/api/number.html",
"/homes/fish/mernst/tmp/python-doc/html/api/numericObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/object.html",
"/homes/fish/mernst/tmp/python-doc/html/api/objects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/os.html",
"/homes/fish/mernst/tmp/python-doc/html/api/otherObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/processControl.html",
"/homes/fish/mernst/tmp/python-doc/html/api/refcountDetails.html",
"/homes/fish/mernst/tmp/python-doc/html/api/refcounts.html",
"/homes/fish/mernst/tmp/python-doc/html/api/sequence.html",
"/homes/fish/mernst/tmp/python-doc/html/api/sequenceObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/standardExceptions.html",
"/homes/fish/mernst/tmp/python-doc/html/api/stringObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/threads.html",
"/homes/fish/mernst/tmp/python-doc/html/api/tupleObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/typeObjects.html",
"/homes/fish/mernst/tmp/python-doc/html/api/types.html",
"/homes/fish/mernst/tmp/python-doc/html/api/utilities.html",
"/homes/fish/mernst/tmp/python-doc/html/api/veryhigh.html");
for my $file (@files)
{ print STDERR "\n", "=" x 75, "\n", "$file:\n";
process_section_file($file, 0, "Title");
}
}
elsif ($action eq "index")
{
process_index_file($file, "\@cindex");
print_index_info();
}
else
{ die "Unrecognized action `$action'"; }
}
sub process_contents_file ( $ )
{ my ($file) = check_args(1, @_);
my $info_file = $file;
$info_file =~ s/(\/?index)?\.html$//;
if ($info_file eq "")
{ chomp($info_file = `pwd`); }
$info_file =~ s/^.*\///; # not the most efficient way to remove dirs
$html_directory = $file;
$html_directory =~ s/(\/|^)[^\/]+$/$1/;
my $texi_file = "$info_file.texi";
open(TEXI, ">$texi_file");
print TEXI "\\input texinfo \@c -*-texinfo-*-\n";
print TEXI "\@c %**start of header\n";
print TEXI "\@setfilename $info_file\n";
$current_ref_tdf = [ "Top", 0, $ARGV[0] ];
process_section_file($file, 0, "Top");
while (scalar(@contents_list))
{ $current_ref_tdf = shift @contents_list;
process_section_file($ {$current_ref_tdf}[2], $ {$current_ref_tdf}[1], $ {$current_ref_tdf}[0]);
}
print TEXI "\n";
for my $indextitle (@index_titles)
{ print TEXI "\@node $indextitle\n";
print TEXI "\@unnumbered $indextitle\n";
print TEXI "\@printindex $ {$index_info{$indextitle}}[1]\n";
print TEXI "\n"; }
print TEXI "\@contents\n";
print TEXI "\@bye\n";
close(TEXI);
}
if (scalar(@ARGV) == 0)
{ die "No arguments supplied to html2texi.pl"; }
if ($ARGV[0] eq "-test")
{ my @test_args = @ARGV[1..$ if (scalar(@test_args) == 0)
{ test("", "index.html"); }
elsif (scalar(@test_args) == 1)
{ test("", $test_args[0]); }
elsif (scalar(@test_args) == 2)
{ test($test_args[0], $test_args[1]); }
else
{ die "Too many test arguments passed to html2texi: ", join(" ", @ARGV); }
exit();
}
if (scalar(@ARGV) != 1)
{ die "Pass one argument, the main/contents page"; }
process_contents_file($ARGV[0]);