You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
tdebase/tdeioslave/info/kde-info2html

1032 lines
33 KiB

#!/usr/bin/perl
#---------------------------------------------------------
# info2html
#---------------------------------------------------------
#
# PURPOSE
# This perl script converts info nodes to HTML format.
# The node is specified on the command line using the
# syntax
# (<infofile>)<tag>
# If <infofile> and/or <tag> are missing, (dir)Top is assumed.
#
# AUTHOR
# Karl Guggisberg <guggis@iam.unibe.ch>
#
# Changes for the KDE Help Center (c) 1999 Matthias ELter
# (me@kde.org)
#
# LICENSE
# GPL
#
# HISTORY
# 11.10.93 V 1.0
# 14.10.93 V 1.0a some comments added
# 15.10.93 V 1.0b file for configuration settings
# 16.10.93 V 1.0c multiple info path possible
# some bugs in escaping references removed
# 28.6.94 V 1.0d some minor changes
# 8.4.95 V 1.1 bug fixes by Tim Witham
# <twitham@eng.fm.intel.com>
# March 1999 Changes for use in KDE Help Center
# February 2000 Changes for bzip2 format
# Sept. 4 2002 Updated to the KDE look
# by Hisham Muhammad <hisham@apple2.com>
# January 30 2003 Ported Hisham's work to HEAD
# by David Pashley <david@davidpashley.com>
# March 6 2003 Substitute use of absolute fixed file URLs to images with help:common URLs
# for the images and style sheet. By Luis Pedro Coelho
# March 9 2003 Add support for browsing by file. by Luis Pedro Coelho
# June 11 2003 Update the layout of the sides to the new infopageslayout.
# by Sven Leiber <s.leiber@web.de>
#
#-------------------------------------------------------
use strict;
# set here the full path of the info2html.conf
push @INC, $1 if $0 =~ m!(.*/)[^/]+$!; # full path of config file is passed in ARGV[1] by caller but let's clean this anyway
my $IMAGEDIR = "file:$ARGV[1]/"; # TV: broken, broken, not passed
my $config_file = $ARGV[0];
delete $ENV{CDPATH};
delete $ENV{ENV};
require $config_file; #-- configuration settings
my $STYLESHEET_KDE = "<link rel=\"stylesheet\" href=\"help:common/tde-default.css\" type=\"text/css\"/>";
my $LOGO_KDE = "<img src=\"help:/common/kde_logo.png\" alt=\"TDE - The Trinity Desktop Environment\" width=\"296\" height=\"79\" border=\"0\">";
# the use of a query should make sure it never conflicts with a "real" path
my $BROWSE_BY_FILE_PATH = '/browse_by_file?special=yes';
my $DONTPRINTYET = 'DONTPRINTYET ';
#-- patterns
my $NODEBORDER = '\037\014?'; #-- delimiter of an info node
my $REDIRSEP = '\177'; #-- delimiter in tag tables
my $WS = '[ \t]+'; #-- white space +
my $WSS = '[ \t]*'; #-- white space *
my $TE = '[\t\,\.]'; #-- end of a tag
my $TAG = '[^\t\,\.]+'; #-- pattern for a tag
my $FTAG = '[^\)]+'; #-- pattern for a file name in
#-- a cross reference
#---------------------------------------------------------
# DieFileNotFound
#---------------------------------------------------------
# Replies and error message if the file '$FileName' is
# not accessible.
#---------------------------------------------------------
sub DieFileNotFound {
my ($FileName) = @_;
$FileName =~ s/&/&amp;/g;
$FileName =~ s/>/&gt;/g;
$FileName =~ s/</&lt;/g;
#-- TEXT : error message if a file could not be opened
print <<EOF;
<head>
<title>Info: (no page found)</title>
</head>
<body>
<h1>KDE Info Pages Viewer Error</h1>
No info page for topic <code>"$FileName"</code> found.<br>
You may find what you are looking for at the <a href="man:$FileName">$FileName manpage</a>.
</body>
EOF
die "\n";
}
#---------------------------------------------------------
# Redirect
#---------------------------------------------------------
# Since we can't do a tdeioslave redirection from here, we resort to an HTML
# redirection.
#
# It could be simpler to just output the correct page, but that would leave the
# the browser URL indication a bit wrong and more importantly we might mess up relative links.
# Therefore, I implemented it like this which is simpler if not as nice on the end user
# who sees a flicker.
#---------------------------------------------------------
sub Redirect {
my ($File,$Tag) = @_;
print <<EOF;
<html><head><title>Doing redirection</title>
<meta http-equiv="refresh" content="0; url=info:$File/$Tag">
<body>
<h1>Redirecting .... </h1>
<p>If you are not automatically taken to a new page, <a href="info:$File/$Tag">click here</a> to continue.
</body>
</html>
EOF
exit 0;
}
#---------------------------------------------------------
# FileNotFound
#---------------------------------------------------------
# If the file is not found and the node is '', try to go through
# dir entries.
# This deals with cases like info:ls should open "coreutils/ls invocation"
#---------------------------------------------------------
sub FileNotFound {
my ($FileName,$NodeName) = @_;
DieFileNotFound($FileName) if $NodeName ne 'Top' || $FileName eq 'dir';
# Try to find it in dir
my $DirFileName = &FindFile('dir');
if ($DirFileName =~ m/.info.bz2$/ ) {
open DIR, "-|", "bzcat", $DirFileName;
}
elsif ($DirFileName =~ m/.info.gz$/ ) {
open DIR, "-|", "gzip", "-dc", $DirFileName;
}
else {
open DIR, $DirFileName;
}
my $looking = 1;
while (<DIR>) {
next if $looking && !/\* Menu/;
$looking = 0;
my @item = &ParseMenuItem($_,'dir');
if (!defined(@item)) { next }
my ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText) = @item;
if ($MenuLinkRef eq $FileName) {
&Redirect($MenuLinkFile, $MenuLinkTag);
exit 0;
}
}
&DieFileNotFound($FileName);
}
#---------------------------------------------------------
# Escape
#---------------------------------------------------------
# This procedures escapes some special characeters. The
# escape sequence follows the WWW guide for escaped
# characters in URLs
#---------------------------------------------------------
sub Escape {
my ($Tag) = @_;
#-- escaping is not needed anymore KG/28.6.94
#-- it is, for "?" %3f (info:/cvs/What is CVS?), kaper/23.7.02
$Tag =~ s/ /%20/g; # space
$Tag =~ s/\?$/%3f/g; # space
$Tag =~ s/\"/%22/g; # space
$Tag =~ s/\#/%23/g;
# $Tag =~ s/\+/%AB/g; # +
$Tag;
}
#----------------------------------------------------------
# DirnameCheck
# TV: This is totally broken.
# I don't know what was the original attempt but that code
# cannot work ! we cannot match the info name (which has no full path)
# with the info path ...
# The only thing i can see (guessed from the || part of the caller)
# is that we try to reject files with "/" in their name, guessing
# we pass a man page full path instead of a info file name ...
# In *that* case, the flow logic is inverted and we should have used "&&"
# instead of "||"
#
# Thus the commented out call...
#----------------------------------------------------------
#sub DirnameCheck {
# my ($Base) = @_;
# my $Dir = $Base;
#
# $Base =~ s!.*/!!g;
# $Dir =~ s!\Q$Base\E!!;
#
# foreach (@info2html::config::INFODIR) {
# return 1 if $Dir =~ /^$_/;
# }
#
# foreach my $i (split(/:/, $ENV{INFOPATH})) {
# return 1 if $Dir =~ /^$i/;
# }
#
# return 0;
#}
#----------------------------------------------------------
# DeEscape
#----------------------------------------------------------
#sub DeEscape {
# my ($Tag) = @_;
# #-- deescaping is not needed anymore. KG/28.6.94
# $Tag =~ s/%AB/+/g;
# $Tag =~ s/%20/ /g;
# $Tag =~ s/\.\.\///g;
# $Tag =~ s/\.\.//g;
# $Tag =~ s/\.\///g;
# $Tag;
#}
sub infocat {
# Collect them all into an array that can be sorted
my %InfoFile;
my %LinkText;
my @dirs;
foreach my $dir (@info2html::config::INFODIR) {
push @dirs, $dir;
}
if ($ENV{'INFOPATH'}) {
foreach my $dir (split(/:/, $ENV{INFOPATH})) {
push @dirs, $dir;
}
}
foreach my $dir (@dirs) {
opendir DIR, $dir;
my ($infofile,$filedesc);
while ($infofile = readdir(DIR)) {
if ($infofile =~ m/.info.bz2$/ ) {
open INFOFILE, "-|", "bzcat", "$dir/$infofile";
}
elsif ($infofile =~ m/.info.gz$/ ) {
open INFOFILE, "-|", "gzip", "-dc", "$dir/$infofile";
}
elsif ($infofile =~ m/.info$/) {
open INFOFILE, "-|", "$dir/$infofile";
}
else {
next;
}
$filedesc = '';
my $collect = 0;
my $empty = 1;
while (<INFOFILE>) {
last if (m/END-INFO-DIR-ENTRY/);
s/^\* //;
chomp;
next if /^\s*$/;
if ($collect) {
$filedesc .= "\n<br>" if ($collect < 16);
$filedesc .= $_;
--$collect;
$empty = 0;
} elsif (!$empty && !$collect) {
$filedesc .= "<br><b>...</b>\n";
last;
}
$collect=16 if (m/START-INFO-DIR-ENTRY/);
}
if ($empty) { $filedesc .= 'no description available'; }
close INFOFILE;
$filedesc .= $infofile if ($filedesc eq "");
# Add to the hash
$LinkText{$filedesc} = "$dir/$infofile";
$InfoFile{$filedesc} = "$infofile";
}
}
# Now output the list
my @sorted = sort { lc($a) cmp lc($b) } keys %InfoFile;
print '<dl>';
foreach my $description ( @sorted ) {
print <<EOF;
<dt> <a href="info:$InfoFile{$description}/Top">$LinkText{$description}</a>
<dd>$description
EOF
}
print '</dl>';
}
#----------------------------------------------------------
# ParsHeaderToken
#----------------------------------------------------------
# Parses the header line of an info node for a specific
# link directive (e.g. Up, Prev)
#
# Returns a link as (InfoFile,Tag).
#----------------------------------------------------------
sub ParsHeaderToken {
my ($HeaderLine, $Token) = @_;
return ("", "") if $HeaderLine !~ /$Token:/; #-- token not available
my ($InfoFile, $node, $Temp);
if ($HeaderLine =~ m!$Token:$WS(\(($FTAG)\))!) {
$InfoFile = $2;
$Temp = $2 ne "" ? '\(' . $2 . '\)' : "";
}
$node = $1 if $HeaderLine =~ m!$Token:$WS$Temp$WSS([^\t,\n]+)?([\t,\.\n])!;
$node ||= "Top";
return $InfoFile, $node;
}
#---------------------------------------------------------
# ParsHeaderLine
#--------------------------------------------------------
# Parses the header line on an info node for all link
# directives allowed in a header line.
# Sometimes the keyword 'Previous' is found in stead of
# 'Prev'. Thats why the redirection line is checked
# against both of these keywords.
#-------------------------------------------------------
sub ParsHeaderLine {
my ($HL) = @_;
my @LinkList;
#-- Node
push(@LinkList, &ParsHeaderToken($HL, "Node"));
#-- Next
push(@LinkList, &ParsHeaderToken($HL, "Next"));
#-- Up
push(@LinkList, &ParsHeaderToken($HL, "Up"));
#-- Prev or Previous
my @LinkInfo = &ParsHeaderToken($HL, "Prev");
&ParsHeaderToken($HL, "Previous") if $LinkInfo[0] eq "" && $LinkInfo[1] eq "";
push(@LinkList, @LinkInfo);
return @LinkList;
}
############################################################
# turn tabs into correct number of spaces
#
sub Tab2Space {
my ($line) = @_;
$line =~ s/^\t/ /; # 8 leading spaces if initial tab
while ($line =~ s/^([^\t]+)(\t)/$1 . ' ' x (8 - length($1) % 8)/e) {
} # replace each tab with right num of spaces
return $line;
}
#--------------------------------------------------------
# ParseMenuItem
#--------------------------------------------------------
# Takes a line containing a Menu item and returns a list of
# ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText)
# or undef if the parsing fails
#-------------------------------------------------------
sub ParseMenuItem {
my ($Line,$BaseInfoFile) = @_;
my ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText);
$Line = &Tab2Space($Line); # make sure columns line up well
if ($Line =~ /\* ([^:]+)::/) { # -- is a simple entry ending with :: ?
$MenuLinkTag = $1;
$MenuLinkRef = $1;
$MenuLinkText = $'; #' --just to help emacs perl-mode
$MenuLinkFile = &Escape($BaseInfoFile);
} elsif ($Line =~ /\* ([^:]+):(\s*\(($FTAG)\)($TAG)?$TE\.?)?(.*)$/) {
$MenuLinkFile = $BaseInfoFile;
$MenuLinkRef = $1;
$MenuLinkText = $5;
if ($2) {
$MenuLinkFile = $3;
$MenuLinkTag = $4 || 'Top';
$MenuLinkText = ($2 ? ' ' x (length($2)+1) : '') . "$5\n";
} else {
$Line = "$5\n";
if ($Line =~ /( *($TAG)?$TE(.*))$/) {
$MenuLinkTag = $2;
$MenuLinkText = $Line;
}
}
} else {
return undef;
}
$MenuLinkTag = &Escape($MenuLinkTag); # -- escape special chars
$MenuLinkText =~ s/^ *//;
return ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText);
}
#--------------------------------------------------------
# MenuItem2HTML
#--------------------------------------------------------
# Transform an info menu item in HTML with references
#-------------------------------------------------------
sub MenuItem2HTML {
my ($Line, $BaseInfoFile) = @_;
my @parse_results = &ParseMenuItem($Line, $BaseInfoFile);
if (!defined (@parse_results)) { return $Line; }
my ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText) = @parse_results;
#-- produce a HTML line
return "<tr class=\"infomenutr\"><td class=\"infomenutd\" width=\"30%\"><ul><li><a href=\"info:/$MenuLinkFile/$MenuLinkTag\">$MenuLinkRef</a></ul></td><td class=\"infomenutd\">$MenuLinkText";
}
#-------------------------------------------------------------
# ReadIndirectTable
#------------------------------------------------------------
# Scans an info file for the occurence of an 'Indirect:'
# table. Scans the entrys and returns two lists with the
# filenames and the global offsets.
#---------------------------------------------------------
sub ReadIndirectTable {
my ($FileName, $FileNames, $Offsets) = @_;
local *FH1;
if ($FileName =~ /\.gz$/) {
open FH1, "-|", "gunzip", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName);
} elsif ($FileName =~ /\.bz2$/) {
open FH1, "-|", "bunzip2", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName);
} else {
open(FH1, $FileName) || &DieFileNotFound($FileName);
}
#-- scan for start of Indirect: Table
local $_;
while (<FH1>) {
my $Next = <FH1> if /$NODEBORDER/;
last if $Next =~ /^Indirect:/i;
}
#-- scan the entrys and setup the arrays
local $_;
while (<FH1>) {
last if /$NODEBORDER/;
if (/([^:]+):[ \t]+(\d+)/) {
push(@$FileNames, $1);
push(@$Offsets, $2);
}
}
close(FH1);
}
#---------------------------------------------------------
# ReadTagTable
#--------------------------------------------------------
# Reads in a tag table from an info file.
# Returns an assoziative array with the tags found.
# Tags are transformed to lower case (info is not
# case sensitive for tags).
# The entrys in the assoziative Array are of the
# form
# <file>#<offset>
# <file> may be empty if an indirect table is
# present or if the node is located in the
# main file.
# 'Exists' indicates if a tag table has been found.
# 'IsIndirect' indicates if the tag table is based
# on a indirect table.
#--------------------------------------------------------
sub ReadTagTable {
my ($FileName, $TagList, $Exists, $IsIndirect) = @_;
local *FH;
if ($FileName =~ /\.gz$/) {
open FH, "-|", "gunzip", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName);
} elsif ($FileName =~ /\.bz2$/) {
open FH, "-|", "bunzip2", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName);
} else {
open FH, $FileName || &DieFileNotFound($FileName);
}
($$Exists, $$IsIndirect) = (0, 0);
#-- scan for start of tag table
local $_;
while (<FH>) {
if (/$NODEBORDER/) {
if (<FH> =~ /^Tag table:/i) {
$$Exists = 1;
last;
}
}
}
#-- scan the entrys
local $_;
while (<FH>) {
$$IsIndirect = 1 if /^\(Indirect\)/i;
last if /$NODEBORDER/;
if (/Node:[ \t]+([^$REDIRSEP]+)$REDIRSEP(\d+)/) {
my ($Tag, $Offset) = (lc($1), $2);
my $File = $1 if /File:[ \t]+([^\t,]+)/;
$TagList->{$Tag} = $File."#".$Offset;
}
}
close(FH);
}
#----------------------------------------------------------
# ParsCrossRefs
#----------------------------------------------------------
# scans a line for the existence of cross references and
# transforms them to HTML using a little icon
#----------------------------------------------------------
sub ParsCrossRefs {
my ($prev, $Line, $BaseInfoFile) = @_;
my ($NewLine, $Token);
my ($CrossRef, $CrossRefFile, $CrossRefTag, $CrossRefRef, $CrossRefText);
$Line = " " . $Line;
if ($prev =~ /\*Note([^\t\,\.]*)$/mi) {
$Line = "$prev-NEWLINE-$Line" if $Line =~ /^$TAG$TE/m;
}
my @Tokens = split(/(\*Note)/i, $Line); # -- split the line
while ($Token = shift @Tokens) {
$CrossRefTag = $CrossRefRef = $CrossRefFile = $CrossRefText = '';
if ($Token !~ /^\*Note/i) { #-- this part is pure text
$NewLine .= $Token;
next; #-- ... take the next part
}
$CrossRef = shift(@Tokens);
if ($CrossRef !~ /:/) { #-- seems not to be a valid cross ref.
$NewLine .= $Token.$CrossRef;
next; # -- ... take the next one
}
if ($CrossRef =~ /^([^:]+)::/) { # -- a simple cross ref..
$CrossRefTag = $1;
$CrossRefText = $';
$CrossRefRef = $CrossRefTag;
$CrossRefTag =~ s/-NEWLINE-/ /g;
$CrossRefTag =~ s/^\s+//;
$CrossRefTag =~ s/\s+/ /g;
$CrossRefRef =~ s/-NEWLINE-/\n/g;
$CrossRefTag = &Escape($CrossRefTag); # -- escape specials
$BaseInfoFile = &Escape($BaseInfoFile);
$NewLine .= "<a href=\"info:/$BaseInfoFile/$CrossRefTag\">";
$NewLine .= "$CrossRefRef</a>$CrossRefText";
next; # -- .. take the next one
}
if ($CrossRef !~ /$TE/) { # never mind if tag doesn't end on this line
$NewLine .= $Token.$CrossRef;
next;
}
#print "--- Com. CR : $CrossRef --- \n";
if ($CrossRef =~ /([^:]+):/) { #-- A more complicated one ..
$CrossRefRef = $1;
$CrossRef = $';
$CrossRefText = $CrossRef;
}
if ($CrossRef =~ /^(\s|\n|-NEWLINE-)*\(($FTAG)\)/) { #-- .. with another file ?
$CrossRefFile = $2;
$CrossRef = $';
}
$CrossRefTag = $2 if $CrossRef =~ /^(\s|\n|-NEWLINE-)*($TAG)?($TE)/; #-- ... and a tag ?
if ($CrossRefTag eq "" && $CrossRefFile eq "") {
$NewLine .= "*Note : $CrossRefText$3";
next;
}
$CrossRefTag =~ s/-NEWLINE-/ /g;
$CrossRefTag =~ s/^\s+//;
$CrossRefTag =~ s/\s+/ /g;
$CrossRefRef =~ s/-NEWLINE-/\n/g;
$CrossRefText =~ s/-NEWLINE-/\n/g;
$CrossRefFile = $BaseInfoFile if $CrossRefFile eq "";
$CrossRefTag = "Top" if $CrossRefTag eq "";
$CrossRefRef = "($CrossRefFile)$CrossRefTag" if $CrossRefRef eq '';
$CrossRefTag = &Escape($CrossRefTag); #-- escape specials
$CrossRefFile = &Escape($CrossRefFile);
#-- append the HTML text
$NewLine .= "<a href=\"info:/$CrossRefFile/$CrossRefTag\">";
$NewLine .= "$CrossRefRef</a>$CrossRefText";
}
if ($NewLine =~ /\*Note([^\t\,\.]*)$/i) {
return "$DONTPRINTYET$NewLine";
} else {
$NewLine; #-- return the new line
}
}
#-------------------------------------------------------------
# PrintLinkInfo
#-------------------------------------------------------------
# prints the HTML text for a link information in the
# header of an info node. Uses some icons URLs of icons
# are specified in 'info2html.conf'.
#------------------------------------------------------------
sub PrintLinkInfo {
my ($LinkType, $LinkFile, $LinkTag, $BaseInfoFile) = @_;
my ($LinkFileEsc, $LinkTypeText);
return if $LinkFile eq "" && $LinkTag eq "";
#-- If no auxiliary file specified use the current info file
$LinkFile ||= $BaseInfoFile;
my $LinkRef = $LinkTag;
$LinkTag = &Escape($LinkTag);
$LinkFileEsc = &Escape($LinkFile);
#-- print the HTML Text
print <<EOF;
<a href="info:/$LinkFileEsc/$LinkTag">
$LinkTypeText
<strong>$LinkRef</strong>
</a>
EOF
}
#-------------------------------------------------------------
# PrintHeader
#-------------------------------------------------------------
# Prints the header for an info node in HTML format
#------------------------------------------------------------
sub PrintHeader {
my ($LinkList, $BaseInfoFile) = @_;
my @LinkList = @{$LinkList};
my $UpcaseInfoFile = $BaseInfoFile;
$UpcaseInfoFile =~ tr/a-z/A-Z/;
#-- TEXT for the header of an info node
print <<EOF;
<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html>
<head>
<title>Info: ($BaseInfoFile) $LinkList[1]</title>
$STYLESHEET_KDE
</head>
<body bgcolor="white" text="black" link="#0000FF" vlink="#840084" alink="#0000FF">
<!--header start-->
<div style="background-image: url(help:/common/top-middle.png); width: 100%; height: 131px;">
<div style="position: absolute; right: 0px;">
<img src="help:/common/top-right-konqueror.png" style="margin: 0px" alt="" />
</div>
<div style="position: absolute; left: 0px;">
<img src="help:/common/top-left.png" style="margin: 0px" alt="" />
</div>
<div style="position: absolute; top: 25px; right: 100px; text-align: right; font-size: xx-large; font-weight: bold; text-shadow: #fff 0px 0px 5px; color: #444">
$UpcaseInfoFile: $LinkList[1]</div>
</div>
<div class="header" style="border: none">
EOF
common_headers($LinkList, $BaseInfoFile);
print <<EOF;
</div>
<div id="contents">
<div class="chapter">
EOF
}
sub common_headers {
my ($LinkList, $BaseInfoFile) = @_;
my @LinkList = @{$LinkList};
print <<EOF;
<tr><td width="33%" align="left" valign="top" class="navLeft">
EOF
&PrintLinkInfo("Prev", $LinkList[6], $LinkList[7], $BaseInfoFile);
print <<EOF;
</td><td width="34%" align="center" valign="top" class="navCenter">
EOF
&PrintLinkInfo("Up", $LinkList[4], $LinkList[5], $BaseInfoFile);
print <<EOF;
</td><td width="33%" align="right" valign="top" class="navRight">
EOF
&PrintLinkInfo("Next", $LinkList[2], $LinkList[3], $BaseInfoFile);
}
#---------------------------------------------------------
# PrintFooter
#---------------------------------------------------------
# prints the footer for an info node in HTML format
#---------------------------------------------------------
sub PrintFooter {
my ($LinkList, $BaseInfoFile, $LinkFile) = @_;
$LinkFile ||= $BaseInfoFile;
#-- TEXT for the footer of an info node
print <<EOF;
</div>
<em>Automatically generated by a version of
<a href="$info2html::config::DOC_URL">
<b>info2html</b>
</a> modified for <a href="http://www.kde.org/">KDE</a></em>.
<div class="bottom-nav">
EOF
common_headers($LinkList, $BaseInfoFile);
print <<EOF;
<!--<br />--><em>$LinkFile</em>
</div>
</body>
</html>
EOF
}
#----------------------------------------------------------
# ReplyNotFoundMessage
#----------------------------------------------------------
sub ReplyNotFoundMessage {
my ($FileName, $Tag) = @_;
print <<EOF;
<head>
<title>Info Files - Error Message</title>
</head>
<h1>Error</h1>
<body>
The Info node <em>$Tag</em> in Info file <em>$FileName</em>
does not exist.
</body>
EOF
}
sub PrintByFileLink {
print <<EOF
<hr width="80%"/>
<p>If you did not find what you were looking for try <a href="info:$BROWSE_BY_FILE_PATH">browsing by file</a> to
see files from packages which did not update the directory.
EOF
}
#-----------------------------------------------------------
# BrowseByFile
#-----------------------------------------------------------
# Shows a list of available files in the system with a short
# description of them.
#------------------------------------------------------------
sub BrowseByFile {
my @LinkList = ('', '', '', '',
'dir', 'Top', '','',''); # set LinkList[4] & LinkList[5], of course ;)
my $BaseInfoFile = 'Available Files';
&PrintHeader(\@LinkList, $BaseInfoFile);
print <<EOF;
<h2>Available Files</h2>
EOF
&infocat;
&PrintFooter(\@LinkList, $BaseInfoFile);
}
#-----------------------------------------------------------
# InfoNode2HTML
#-----------------------------------------------------------
# scans an info file for the node with the name '$Tag'
# starting at the postion '$Offset'.
# If found the node is tranlated to HTML and printed.
#------------------------------------------------------------
sub InfoNode2HTML {
my ($FileName, $Offset, $Tag, $BaseInfoFile) = @_;
local *FH2;
if ($FileName =~ /\.gz$/) {
open FH2, "-|", "gunzip", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName);
} elsif ($FileName =~ /\.bz2$/) {
open FH2, "-|", "bunzip2", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName);
} else {
open FH2, $FileName || &DieFileNotFound($FileName);
}
seek(FH2, $Offset, 0);
$Tag =~ tr/A-Z/a-z/; # -- to lowercase
#-- scan for the node start
my ($Found, @LinkList);
local $_;
while (<FH2>) {
if (/$NODEBORDER/) {
my $line = <FH2>;
@LinkList = &ParsHeaderLine($line);
my $CompareTag = $Tag;
$CompareTag =~ s/([^0-9A-Za-z])/\\$1/g; #-- escape special chars !
my $Temp = $LinkList[1];
$Temp =~ tr/A-Z/a-z/; #-- to lower case
if ($Temp =~ /^\s*$CompareTag\s*$/) { #-- node start found ?
$Found = 1;
last;
}
}
}
return &ReplyNotFoundMessage($FileName, $Tag) unless $Found; # -- break if not found;
&PrintHeader(\@LinkList, $BaseInfoFile);
my $InMenu = 0;
my $prev;
my $LineCount = 0;
my $Entries = 0;
my $Par = 0;
my @ParLines = ();
my $ParLine=0;
my $MayBeText=0;
my $MayBeTitle=0;
my $Line;
my $PrevMenu;
local $_;
while (<FH2>) {
$LineCount++;
last if /$NODEBORDER/;
#-- replace meta characters
#s/"`"([^"'"]*)"'"/"<span class=\"option\">"$1"</span>"/g;
s/&/&amp;/g;
s/>/&gt;/g;
s/</&lt;/g;
my $Length = length($_);
if ($LineCount == 3 && $InMenu == 0 && length($_) == $Length && $Length > 1){ #-- an underline ?
if (/^\**$/) {
print "<h2>$prev</h2>\n";
$prev = "";
next;
}
elsif (/^=*$/) {
print "<h3>$prev</h3>\n";
$prev = "";
next;
}
else {
print "<h4>$prev</h4>\n";
$prev = "";
next;
}
}
if (/^\* Menu/ && $InMenu == 0) { # -- start of menu section ?
$InMenu = 1;
print "<h3>Menu</h3>\n";
}
elsif ($InMenu == 1) {
# This is pretty crappy code.
# A lot of logic (like the ParsCrossRefs and tranforming Variable: etc) is repeated below.
# There have been a few bugs which were fixed in one branch of the code and left in the other.
# This should be refactored.
# LPC (16 March 2003)
if (/^\* /) { #-- a menu entry ?
if ($Entries == 0) {
$Entries = 1;
print "<table class=\"infomenutable\">";
}
print &MenuItem2HTML($_,$BaseInfoFile);
}
elsif (/^$/) { #-- empty line
if ($Entries == 1) {
print "</td></tr></table>";
$Entries = 0;
}
print "<br>";
}
else {
$Line = &ParsCrossRefs($prev,$_,$BaseInfoFile);
if ($Line =~ /^$DONTPRINTYET/) {
$prev = $Line;
$prev =~ s/^$DONTPRINTYET//;
chomp $prev;
}
elsif ($LineCount == 2) {
$prev = $Line;
} else {
$prev = $Line;
$Line =~ s#- (Variable|Function|Macro|Command|Special Form|User Option|Data Type):.*$#<em><strong>$&</strong></em>#;
$Line =~ s/^[ \t]*//;
print $Line;
}
}
}
else {
if (/^ *$/) {
if ($MayBeText == 1) {
print "<p>$Par</p>"
} else {
print "<pre>";
foreach (@ParLines) {
print $_;
}
print "\n";
print "</pre>";
}
@ParLines = ();
$ParLine = 1;
$MayBeText = 1;
$MayBeTitle = 1;
$Par = "";
} else {
if ($ParLine == 1) {
if (!/^ {1,4}[^ ]/ || /[^ ] [^ ]/) {
$MayBeText = 0;
}
} else {
if (!/^ ?[^ ]/ || /[^ ] [^ ]/) {
$MayBeText = 0;
}
}
$Line = &ParsCrossRefs($prev,$_,$BaseInfoFile);
if ($Line =~ /^$DONTPRINTYET/) {
$prev = $Line;
$prev =~ s/^$DONTPRINTYET//;
chomp $prev;
} elsif ($LineCount == 2) {
$prev = $Line;
} else {
$prev = $Line;
$Line =~ s#- (Variable|Function|Macro|Command|Special Form|User Option):.*$#<strong>$&</strong>#;
$Line =~ s/`([^']*)'/`<span class="option">$1<\/span>'/g; #'
$Line =~ s/((news|ftp|http):\/\/[A-Za-z0-9\.\/\#\-_\~]*)/<a href="$1">$1<\/a>/g;
$Line =~ s/([A-Za-z0-9\.\/\#\-_\~]*\@[A-Za-z0-9\.\/\#\-_\~]*\.[A-Za-z]{2,3})/<a href="mailto:$1">$1<\/a>/g;
$Par = $Par . $Line;
$ParLines[$ParLine] = $Line;
$ParLine++;
}
}
}
}
if ($Entries == 1) {
print "</table>"
}
if ($PrevMenu =~ "") {
print &MenuItem2HTML($PrevMenu,$BaseInfoFile);
}
close(FH2);
if ($BaseInfoFile =~ m/dir/i
&& $Tag =~ m/Top/i) {
&PrintByFileLink;
}
&PrintFooter(\@LinkList, $BaseInfoFile);
}
#-------------------------------------------------------------
# max
#------------------------------------------------------------
sub max {
my ($a, $b) = @_;
return $a >= $b ? $a : $b;
}
#-----------------------------------------------------------
# GetFileAndOffset
#------------------------------------------------------------
# This procedure locates a specific node in a info file
# The location is based on the tag and indirect table in
# basic info file if such tables are available.
# Because the offsets specified in the tag and in the
# indirect table are more or less inacurate the computet
# offset is set back 100 bytes. From this position
# the specified node will looked for sequentially
#------------------------------------------------------------
sub GetFileAndOffset {
my ($BaseInfoFile, $NodeName) = @_;
my ($Exists, $IsIndirect, $File, $Offset, $FileOffset, %TagList, @FileNames, @Offsets);
$NodeName =~ tr/A-Z/a-z/;
&ReadIndirectTable($BaseInfoFile, \@FileNames, \@Offsets);
# This looks wastefull:
# We build a whole TagList hash and then use it to lookup the tag info.
# Why not pass $NodeName to ReadTagTable and let it return just the desired info?
# lpc (16 March 2003)
&ReadTagTable($BaseInfoFile, \%TagList, \$Exists, \$IsIndirect);
return "", 0 unless $Exists; #-- no tag table available
return "", 0 unless defined $TagList{$NodeName}; #-- tag is not in the tag table
($File, $Offset) = split(/#/, $TagList{$NodeName});
return $File, &max($Offset - 100, 0) if $File; #-- there is an explicite
#-- not in the tag table
if ($IsIndirect == 1) {
foreach my $i (0..$#Offsets) {
$FileOffset = $Offsets[$i] if $Offsets[$i] <= $Offset;
$File = $FileNames[$i] if $Offsets[$i] <= $Offset;
}
return $File, &max($Offset - $FileOffset - 100,0); #-- be safe (-100!)
} else {
return "", &max($Offset - 100, 0);
}
}
# FindFile: find the given file on the infopath, return full name or "".
# Let filenames optionally have .info suffix. Try named version first.
# Handle gzipped file too.
sub FindFile {
my ($File) = @_;
return "" if ($File =~ /\.\./);
my $Alt = $File =~ /^(.+)\.info$/ ? $1 : $File . '.info';
foreach my $Name ($File, $Alt) {
my $gzName = $Name . '.gz';
my $bz2Name = $Name . '.bz2';
foreach (@info2html::config::INFODIR) {
return "$_/$Name" if -e "$_/$Name";
return "$_/$gzName" if -e "$_/$gzName";
return "$_/$bz2Name" if -e "$_/$bz2Name";
}
next unless $ENV{INFOPATH};
foreach my $i (split(/:/, $ENV{INFOPATH})) {
return "$i/$Name" if -e "$i/$Name";
return "$i/$gzName" if -e "$i/$gzName";
return "$i/$bz2Name" if -e "$i/$bz2Name";
}
}
return "";
}
#-------------------------------------------------------
#
#------------------- MAIN -----------------------------
#
# called as
# perl /path/kde-info2html config_file image_base_path BaseInfoFile NodeName
#
# BaseInfoFile eq '#special#' to pass special args through NodeName (yes, it is a hack).
#
my $PROGRAM = $0; # determine our basename and version
$PROGRAM =~ s!.*/!!;
my ($BaseInfoFile, $NodeName) = ($ARGV[2], $ARGV[3]);
#&DirnameCheck($BaseInfoFile) || &DieFileNotFound($BaseInfoFile);
if ($BaseInfoFile eq '#special#' && $NodeName eq 'browse_by_file') {
&BrowseByFile;
exit 0;
}
$BaseInfoFile = "dir" if $BaseInfoFile =~ /^dir$/i;
my $FileNameFull = &FindFile($BaseInfoFile) || &FileNotFound($BaseInfoFile,$NodeName);
my ($File, $Offset) = &GetFileAndOffset($FileNameFull, $NodeName);
$File ||= $BaseInfoFile;
$FileNameFull = &FindFile($File);
&InfoNode2HTML($FileNameFull, $Offset, $NodeName, $BaseInfoFile);
exit 0;