0
0
mirror of https://gitlab.nic.cz/labs/bird.git synced 2024-12-25 03:01:55 +00:00
bird/tools/linuxdoc-tools/LinuxDocTools/InfoUtils.pm

358 lines
11 KiB
Perl
Raw Normal View History

# InfoUtils.pm
#
# Some utils for the linuxdoc info backend.
#
# * Create menus
# * Normalize node names and associated text
# * Point references to the associated node as needed
#
# Copyright (C) 2009 Agust<73>n Mart<72>n Domingo, agmartin at debian org
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
# --------------------------------------------------------------------
package LinuxDocTools::InfoUtils;
use base qw(Exporter);
# List all exported symbols here.
our @EXPORT_OK = qw(info_process_texi);
# Import :all to get everything.
our %EXPORT_TAGS = (all => [@EXPORT_OK]);
=head1 NAME
InfoUtils - Some utils for the linuxdoc info backend.
=head1 SYNOPSIS
use InfoUtils q{:all};
info_process_texi($infile, $outfile, $infoname)
=head1 DESCRIPTION
This module contains some utils to process the raw texinfo file
creating menus, normalizing node names and associated text and
pointing references to the associated node as needed.
=head1 FUNCTIONS
=over 4
=cut
# -------------------------------------------------------------------------
sub info_normalize_node_text {
# -------------------------------------------------------------------------
# Filter characters not allowed in section names
# -------------------------------------------------------------------------
my $text = shift;
$text =~ s/\s+/ /g;
$text =~ s/\@[A-Za-z][A-Za-z0-9]*//g;
$text =~ s/(\{|\})//g;
$text =~ s/\,//g;
# $text =~ s/\.+$//g;
$text =~ s/\./-/g;
$text =~ s/\s+$//g;
return $text;
}
# -------------------------------------------------------------------------
sub info_normalize_node_name {
# -------------------------------------------------------------------------
# Filter characters not allowed in node names. Previous filtering of
# characters not allowed in section names is supposed.
# -------------------------------------------------------------------------
my $text = shift;
# my $tmpnodedata = shift;
$text =~ s/\://g;
$text =~ s/\;//g;
# die "Error: Reference \"$text\" already used"
# if defined $tmpnodedata->{$text};
return $text;
}
# -------------------------------------------------------------------------
sub info_parse_raw_file {
# -------------------------------------------------------------------------
# Parse raw texinfo file. It does not yet contain section names, menus,
# correct references or title.
# -------------------------------------------------------------------------
my $inputfile = shift;
my $INPUT;
my @inputtext = (); # Copy of input file with some preprocessing
my %nodedata = # A hash of hashes with all node info
( 'Top' =>
{ 'text' => "Top",
'depth' => 0,
'up' => "",
'next' => '',
'previous' => "",
'sort' => 0,
'debug' => "",
'menu' => []}
);
my %levellast = (0 => "Top");
my %labels = ();
my %docdata = # Some misc data for the document
( 'title' => "",
'author' => "",
'subtitle' => ""
);
my $depth = my $lastdepth = 0;
my $lastnode = "";
my $sort = 0;
my $inauthor;
my $authorline;
open ($INPUT, "< $inputfile")
or die "info-postASP: Could not open $inputfile for read. Aborting ...\n";
while (<$INPUT>){
chomp;
if ( s/^\@SUB\s+// ){
my $updepth = $depth;
my $uppernode = $levellast{$updepth};
$depth++;
$sort++;
my @levelmenu = ();
if ( defined $nodedata{$uppernode}->{'menu'} ){
@levelmenu = @{ $nodedata{$uppernode}->{'menu'} };
}
my $nodetext = info_normalize_node_text($_);
my $nodename = info_normalize_node_name($nodetext,\%nodedata);
# Make first appearing node the next node for top node
$nodedata{'Top'}->{'next'} = $nodename if ( $lastdepth eq 0);
# Fill info for current node (and 'next' for last one in level)
$nodedata{$nodename}->{'orig'} = $_;
$nodedata{$nodename}->{'text'} = $nodetext;
$nodedata{$nodename}->{'depth'} = $depth;
$nodedata{$nodename}->{'previous'} =
defined $levellast{$depth} ? $levellast{$depth} : "";
$nodedata{$levellast{$depth}}->{'next'} = $nodename
if defined $levellast{$depth};
$nodedata{$nodename}->{'up'} = $uppernode;
$nodedata{$nodename}->{'sort'} = $sort;
$nodedata{$nodename}->{'debug'} =
"updepth: $updepth, lastdepth: $lastdepth, up: $uppernode";
# Keep this defined in case tbere is no next node in the same level.
$nodedata{$nodename}->{'next'} = "";
push @inputtext, "\@SUB $nodename"; # Rewrite @SUB with the new name
push @levelmenu, $nodename; # Add $nodename to the level menu list
# Prepare things for next @SUB entry found
$levellast{$depth} = $lastnode = $nodename;
$lastdepth = $depth;
$nodedata{$uppernode}->{'menu'} = \@levelmenu;
} elsif ( s/^\@ENDSUB// ){
$depth--;
push @inputtext, $_;
} elsif (s/^\@LABEL\s+//){
# Keep record of node labels vs nodenames. Will use the last.
$labels{$_} = $lastnode;
} elsif (s/^\@title\s+//){
$docdata{'title'} = $_;
} elsif (/^\@ldt_endauthor/){
$inauthor = '';
my @authors;
if ( @$docdata{'authors'} ){
@authors = @$docdata{'authors'};
}
push @authors, $authorline;
$docdata{'authors'} = \@authors;
$authorline = "";
} elsif ( s/^\@author\s+// ){
$inauthor = 1;
$authorline = $_;
} elsif ( $inauthor ){
next if m/^\s*$/;
s/^\s+//;
$authorline .= " $_ ";
} elsif (s/^\@subtitle\s+//){
$docdata{'subtitle'} = $_;
} elsif (s/^\@ldt_translator\s+//){
$docdata{'translator'} = $_;
} elsif (s/^\@ldt_tdate\s+//){
$docdata{'tdate'} = $_;
} else {
push @inputtext, $_;
}
}
close $INPUT;
$docdata{'nodedata'} = \%nodedata;
$docdata{'labels'} = \%labels;
$docdata{'inputtext'} = \@inputtext;
return \%docdata;
}
# -------------------------------------------------------------------------
sub info_write_preprocessed_file {
# -------------------------------------------------------------------------
# Write processed texinfo file. Add section names, menus, correct
# references and title.
# -------------------------------------------------------------------------
my $docdata = shift;
my $infoname = shift;
my $texiout = shift;
die "InfoUtils.pm: No info file name $infoname.\n" unless $infoname;
die "InfoUtils.pm: No output texi file $texiout\n" unless $texiout;
my $nodedata = $docdata->{'nodedata'};
my $labels = $docdata->{'labels'};
my $inputtext = $docdata->{'inputtext'};
my $OUTFILE;
# info_check_parsed_data($nodedata);
my %sections = ( 1 => "\@chapter",
2 => "\@section",
3 => "\@subsection",
4 => "\@subsubsection");
my $lastdepth = 0;
my $lastnode = "Top";
my $texinfo = "\@c %** START OF HEADER
\@setfilename $infoname
\@c %** END OF HEADER\n";
foreach ( @$inputtext ) {
if ( s/^\@SUB\s+// ){
my $key = $_;
my $depth = $nodedata->{$key}->{'depth'};
my $name = $nodedata->{$key}->{'text'};
if ( $depth le 4 ){
my $next = $nodedata->{$key}->{'next'};
my $previous = $nodedata->{$key}->{'previous'};
my $up = $nodedata->{$key}->{'up'};
# my $txt = "\@comment nodename, next, previous, up\n";
my $txt = "";
# $txt .= "\@node $key, $previous, $next, $up\n";
$txt .= "\@node $key\n";
$txt .= "$sections{$depth} $name\n";
if ( $depth gt $lastdepth && defined $nodedata->{$lastnode}->{'menu'}){
$txt = "\n\@menu\n\* "
. join("::\n\* ",@{$nodedata->{$lastnode}->{'menu'}})
. "::\n\@end menu\n"
. "\n$txt";
}
$texinfo .= $txt;
$lastdepth = $depth;
$lastnode = $key;
} elsif ( $depth eq 5 ){
$texinfo .= "\@subsubheading $nodedata->{$key}->{'text'}\n";
} else {
die "info-postASP: Entry \"$key\" has wrong depth $depth\n";
}
} elsif (s/^\@REF\s+//){
if ( defined $labels->{$_} ){
# If this reference is to a node, use its nodename
$texinfo .= "\@ref{" . $labels->{$_} . "}\n";
} else {
$texinfo .= "\@ref{$_}\n";
}
} elsif (s/^\@TOP//){
$texinfo .= "\@node top\n"
. "\@top " . $docdata->{'title'} . "\n"
. "\@example\n";
$texinfo .= join(' and ',@{$docdata->{'authors'}}) . "\n"
if ( @{$docdata->{'authors'}} );
$texinfo .= $docdata->{'subtitle'} . "\n"
if ( defined $docdata->{'subtitle'} );
$texinfo .= $docdata->{'translator'} . "\n"
if ( defined $docdata->{'translator'} );
$texinfo .= $docdata->{'tdate'} . "\n"
if ( defined $docdata->{'tdate'} );
$texinfo .= "\@end example\n";
} else {
$texinfo .= "$_\n";
}
}
open ($OUTFILE, "> $texiout")
or die "Could not open \"$texiout\" for write. Aborting ...\n";
print $OUTFILE $texinfo;
close $OUTFILE;
}
# -------------------------------------------------------------------------
sub info_check_parsed_data {
# -------------------------------------------------------------------------
# -------------------------------------------------------------------------
my $tmpnodedata = shift;
my @sections = sort {
$tmpnodedata->{$a}->{'sort'} <=> $tmpnodedata->{$b}->{'sort'}
} keys %$tmpnodedata;
foreach ( @sections ){
my $ref = $tmpnodedata->{$_};
print STDERR "Node: $_\n";
print STDERR " orig: $ref->{'orig'}\n";
print STDERR " text: $ref->{'text'}\n";
print STDERR " debug: $ref->{'debug'}\n";
print STDERR " up: $ref->{'up'}\n";
print STDERR " depth: $ref->{'depth'}\n";
print STDERR " previous: $ref->{'previous'}\n";
print STDERR " next: $ref->{'next'}\n";
print STDERR " sort: $ref->{'sort'}\n";
print STDERR " menu:\n * " . join("\n * ",@{$ref->{'menu'}}) . "\n" if defined $ref->{'menu'};
}
}
# -------------------------------------------------------------------------
sub info_process_texi {
# -------------------------------------------------------------------------
# info_process_texi($infile, $outfile, $infoname)
#
# Call the other functions.
# -------------------------------------------------------------------------
my $infile = shift;
my $outfile = shift;
my $infoname = shift;
info_write_preprocessed_file(info_parse_raw_file($infile),$infoname,$outfile);
}