File indexing completed on 2024-05-19 08:50:23
0001 #!/usr/bin/perl 0002 #--------------------------------------------------------- 0003 # info2html 0004 #--------------------------------------------------------- 0005 # 0006 # PURPOSE 0007 # This perl script converts info nodes to HTML format. 0008 # The node is specified on the command line using the 0009 # syntax 0010 # (<infofile>)<tag> 0011 # If <infofile> and/or <tag> are missing, (dir)Top is assumed. 0012 # 0013 # AUTHOR 0014 # Karl Guggisberg <guggis@iam.unibe.ch> 0015 # 0016 # Changes for the KDE Help Center (c) 1999 Matthias ELter 0017 # (me@kde.org) 0018 # 0019 # LICENSE 0020 # GPL 0021 # 0022 # HISTORY 0023 # 11.10.93 V 1.0 0024 # 14.10.93 V 1.0a some comments added 0025 # 15.10.93 V 1.0b file for configuration settings 0026 # 16.10.93 V 1.0c multiple info path possible 0027 # some bugs in escaping references removed 0028 # 28.6.94 V 1.0d some minor changes 0029 # 8.4.95 V 1.1 bug fixes by Tim Witham 0030 # <twitham@eng.fm.intel.com> 0031 # March 1999 Changes for use in KDE Help Center 0032 # February 2000 Changes for bzip2 format 0033 # Sept. 4 2002 Updated to the KDE look 0034 # by Hisham Muhammad <hisham@apple2.com> 0035 # January 30 2003 Ported Hisham's work to HEAD 0036 # by David Pashley <david@davidpashley.com> 0037 # March 6 2003 Substitute use of absolute fixed file URLs to images with help:common URLs 0038 # for the images and style sheet. By Luis Pedro Coelho 0039 # March 9 2003 Add support for browsing by file. by Luis Pedro Coelho 0040 # June 11 2003 Update the layout of the sides to the new infopageslayout. 0041 # by Sven Leiber <s.leiber@web.de> 0042 # July 22 2008 Add support for lzma. 0043 # by Per Øyvind Karlsen <peroyvind@mandriva.org> 0044 # January 8 2009 Update lzma support for new xz tool and format. 0045 # by Per Øyvind Karlsen <peroyvind@mandriva.org> 0046 # 0047 #------------------------------------------------------- 0048 0049 use strict; 0050 0051 # set here the full path of the info2html.conf 0052 push @INC, $1 if $0 =~ m{(.*/)[^/]+$}; # full path of config file is passed in ARGV[1] by caller but let's clean this anyway 0053 my $config_file = $ARGV[0]; 0054 my $css_file = $ARGV[1]; 0055 chomp $css_file; 0056 my $css_link = qq(<link rel="stylesheet" href="file://$css_file" type="text/css">) if $css_file; 0057 delete $ENV{CDPATH}; 0058 delete $ENV{ENV}; 0059 require $config_file; #-- configuration settings 0060 my $DOCTYPE = qq(<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" >); 0061 0062 my $STYLESHEET_KDE = 0063 qq(<link rel="stylesheet" href="help:/kdoctools5-common/kde-default.css" type="text/css"> 0064 $css_link 0065 <style type="text/css"><!-- .chapter { padding-right: 1em } --></style>); 0066 0067 # the use of a query should make sure it never conflicts with a "real" path 0068 my $BROWSE_BY_FILE_PATH = '/browse_by_file?special=yes'; 0069 0070 0071 my $DONTPRINTYET = 'DONTPRINTYET '; 0072 0073 #-- patterns 0074 my $NODEBORDER = '\037\014?'; #-- delimiter of an info node 0075 my $REDIRSEP = '\177'; #-- delimiter in tag tables 0076 my $WS = '[ \t]+'; #-- white space + 0077 my $WSS = '[ \t]*'; #-- white space * 0078 my $TE = '[\t\,\.]'; #-- end of a tag 0079 my $TAG = '[^\t\,\.]+'; #-- pattern for a tag 0080 my $FTAG = '[^\)]+'; #-- pattern for a file name in 0081 #-- a cross reference 0082 0083 #--------------------------------------------------------- 0084 # DieFileNotFound 0085 #--------------------------------------------------------- 0086 # Replies and error message if the file '$FileName' is 0087 # not accessible. 0088 #--------------------------------------------------------- 0089 sub DieFileNotFound { 0090 my ($FileName) = @_; 0091 $FileName =~ s/&/&/g; 0092 $FileName =~ s/>/>/g; 0093 $FileName =~ s/</</g; 0094 0095 #-- TEXT : error message if a file could not be opened 0096 print <<EOF; 0097 $DOCTYPE 0098 <head> 0099 <meta http-equiv="Content-Type" content="text/html;charset=utf-8" > 0100 $STYLESHEET_KDE 0101 <title>Info: (no page found)</title> 0102 </head> 0103 <body> 0104 <h1>KDE Info Pages Viewer Error</h1> 0105 No info page for topic <code>"$FileName"</code> found.<br> 0106 You may find what you are looking for at the <a href="man:$FileName">$FileName manpage</a>. 0107 </body> 0108 EOF 0109 die "\n"; 0110 } 0111 0112 #--------------------------------------------------------- 0113 # Redirect 0114 #--------------------------------------------------------- 0115 # Since we can't do a kioworker redirection from here, we resort to an HTML 0116 # redirection. 0117 # 0118 # It could be simpler to just output the correct page, but that would leave the 0119 # the browser URL indication a bit wrong and more importantly we might mess up relative links. 0120 # Therefore, I implemented it like this which is simpler if not as nice on the end user 0121 # who sees a flicker. 0122 #--------------------------------------------------------- 0123 0124 sub Redirect { 0125 my ($File,$Tag) = @_; 0126 print <<EOF; 0127 $DOCTYPE 0128 <html><head><title>Doing redirection</title> 0129 <meta http-equiv="Content-Type" content="text/html;charset=utf-8" > 0130 $STYLESHEET_KDE 0131 <meta http-equiv="refresh" content="0; url=info:$File/$Tag"> 0132 </head> 0133 <body> 0134 <h1>Redirecting .... </h1> 0135 <p>If you are not automatically taken to a new page, <a href="info:$File/$Tag">click here</a> to continue. 0136 </body> 0137 </html> 0138 EOF 0139 0140 exit 0; 0141 } 0142 0143 #--------------------------------------------------------- 0144 # FileNotFound 0145 #--------------------------------------------------------- 0146 # If the file is not found and the node is '', try to go through 0147 # dir entries. 0148 # This deals with cases like info:ls should open "coreutils/ls invocation" 0149 #--------------------------------------------------------- 0150 sub FileNotFound { 0151 my ($FileName,$NodeName) = @_; 0152 DieFileNotFound($FileName) if $NodeName ne 'Top' || $FileName eq 'dir'; 0153 # Try to find it in dir 0154 0155 my $DirFileName = &FindFile('dir'); 0156 if ($DirFileName =~ m/.info.bz2$/ ) { 0157 open DIR, "-|", "bzcat", $DirFileName; 0158 } 0159 elsif ($DirFileName =~ m/.info.(lzma|xz)$/ ) { 0160 open DIR, "-|", "xzcat", $DirFileName; 0161 } 0162 0163 elsif ($DirFileName =~ m/.info.gz$/ ) { 0164 open DIR, "-|", "gzip", "-dc", $DirFileName; 0165 } 0166 else { 0167 open DIR, $DirFileName; 0168 } 0169 my $looking = 1; 0170 while (<DIR>) { 0171 next if $looking && !/\* Menu/; 0172 $looking = 0; 0173 my @item = &ParseMenuItem($_,'dir'); 0174 if (!@item) { next } 0175 my ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText) = @item; 0176 if ($MenuLinkRef eq $FileName) { 0177 &Redirect($MenuLinkFile, $MenuLinkTag); 0178 exit 0; 0179 } 0180 } 0181 &DieFileNotFound($FileName); 0182 } 0183 0184 #--------------------------------------------------------- 0185 # Escape 0186 #--------------------------------------------------------- 0187 # This procedures escapes some special characeters. The 0188 # escape sequence follows the WWW guide for escaped 0189 # characters in URLs 0190 #--------------------------------------------------------- 0191 sub Escape { 0192 my ($Tag) = @_; 0193 #-- escaping is not needed anymore KG/28.6.94 0194 #-- it is, for "?" %3f (info:/cvs/What is CVS?), kaper/23.7.02 0195 $Tag =~ s/ /%20/g; # space 0196 $Tag =~ s/\?$/%3f/g; # space 0197 $Tag =~ s/\"/%22/g; # space 0198 $Tag =~ s/\#/%23/g; 0199 # $Tag =~ s/\+/%AB/g; # + 0200 $Tag; 0201 } 0202 0203 #---------------------------------------------------------- 0204 # DirnameCheck 0205 # TV: This is totally broken. 0206 # I don't know what was the original attempt but that code 0207 # cannot work ! we cannot match the info name (which has no full path) 0208 # with the info path ... 0209 # The only thing i can see (guessed from the || part of the caller) 0210 # is that we try to reject files with "/" in their name, guessing 0211 # we pass a man page full path instead of a info file name ... 0212 # In *that* case, the flow logic is inverted and we should have used "&&" 0213 # instead of "||" 0214 # 0215 # Thus the commented out call... 0216 #---------------------------------------------------------- 0217 #sub DirnameCheck { 0218 # my ($Base) = @_; 0219 # my $Dir = $Base; 0220 # 0221 # $Base =~ s!.*/!!g; 0222 # $Dir =~ s!\Q$Base\E!!; 0223 # 0224 # foreach (@info2html::config::INFODIR) { 0225 # return 1 if $Dir =~ /^$_/; 0226 # } 0227 # 0228 # foreach my $i (split(/:/, $ENV{INFOPATH})) { 0229 # return 1 if $Dir =~ /^$i/; 0230 # } 0231 # 0232 # return 0; 0233 #} 0234 0235 #---------------------------------------------------------- 0236 # DeEscape 0237 #---------------------------------------------------------- 0238 #sub DeEscape { 0239 # my ($Tag) = @_; 0240 # #-- deescaping is not needed anymore. KG/28.6.94 0241 # $Tag =~ s/%AB/+/g; 0242 # $Tag =~ s/%20/ /g; 0243 # $Tag =~ s/\.\.\///g; 0244 # $Tag =~ s/\.\.//g; 0245 # $Tag =~ s/\.\///g; 0246 # $Tag; 0247 #} 0248 0249 sub infocat { 0250 # Collect them all into an array that can be sorted 0251 0252 my %InfoFile; 0253 my %LinkText; 0254 my @dirs; 0255 0256 foreach my $dir (@info2html::config::INFODIR) { 0257 push @dirs, $dir; 0258 } 0259 if ($ENV{'INFOPATH'}) { 0260 foreach my $dir (split(/:/, $ENV{INFOPATH})) { 0261 push @dirs, $dir; 0262 } 0263 } 0264 0265 foreach my $dir (@dirs) { 0266 opendir DIR, $dir; 0267 my ($infofile,$filedesc); 0268 while ($infofile = readdir(DIR)) { 0269 if ($infofile =~ m/.info.bz2$/ ) { 0270 open INFOFILE, "-|", "bzcat", "$dir/$infofile"; 0271 } 0272 elsif ($infofile =~ m/.info.(lzma|xz)$/ ) { 0273 open INFOFILE, "-|", "xzcat", "$dir/$infofile"; 0274 } 0275 elsif ($infofile =~ m/.info.gz$/ ) { 0276 open INFOFILE, "-|", "gzip", "-dc", "$dir/$infofile"; 0277 } 0278 elsif ($infofile =~ m/.info$/) { 0279 open INFOFILE, "-|", "$dir/$infofile"; 0280 } 0281 else { 0282 next; 0283 } 0284 $filedesc = ''; 0285 my $collect = 0; 0286 my $empty = 1; 0287 while (<INFOFILE>) { 0288 last if (m/END-INFO-DIR-ENTRY/); 0289 s/^\* //; 0290 chomp; 0291 next if /^\s*$/; 0292 if ($collect) { 0293 $filedesc .= "\n<br>" if ($collect < 16); 0294 $filedesc .= $_; 0295 --$collect; 0296 $empty = 0; 0297 } elsif (!$empty && !$collect) { 0298 $filedesc .= "<br><b>...</b>\n"; 0299 last; 0300 } 0301 $collect=16 if (m/START-INFO-DIR-ENTRY/); 0302 } 0303 0304 # Avoid a noisy "Broken pipe" message from bzcat 0305 while (<INFOFILE>) {} 0306 close INFOFILE; 0307 0308 if ($empty) { $filedesc .= 'no description available'; } 0309 $filedesc .= $infofile if ($filedesc eq ""); 0310 # Add to the hash 0311 $LinkText{$filedesc} = "$dir/$infofile"; 0312 $InfoFile{$filedesc} = "$infofile"; 0313 } 0314 } 0315 0316 # Now output the list 0317 my @sorted = sort { lc($a) cmp lc($b) } keys %InfoFile; 0318 0319 print '<dl>'; 0320 foreach my $description ( @sorted ) { 0321 print <<EOF; 0322 <dt> <a href="info:$InfoFile{$description}/Top">$LinkText{$description}</a> 0323 <dd>$description 0324 0325 EOF 0326 } 0327 print '</dl>'; 0328 } 0329 0330 #---------------------------------------------------------- 0331 # ParsHeaderToken 0332 #---------------------------------------------------------- 0333 # Parses the header line of an info node for a specific 0334 # link directive (e.g. Up, Prev) 0335 # 0336 # Returns a link as (InfoFile,Tag). 0337 #---------------------------------------------------------- 0338 sub ParsHeaderToken { 0339 my ($HeaderLine, $Token) = @_; 0340 return ("", "") if $HeaderLine !~ /$Token:/; #-- token not available 0341 my ($InfoFile, $node, $Temp); 0342 if ($HeaderLine =~ m!$Token:$WS(\(($FTAG)\))!) { 0343 $InfoFile = $2; 0344 $Temp = $2 ne "" ? '\(' . $2 . '\)' : ""; 0345 } 0346 $node = $1 if $HeaderLine =~ m!$Token:$WS$Temp$WSS([^\t,\n]+)?([\t,\.\n])!; 0347 $node ||= "Top"; 0348 return $InfoFile, $node; 0349 } 0350 0351 #--------------------------------------------------------- 0352 # ParsHeaderLine 0353 #-------------------------------------------------------- 0354 # Parses the header line on an info node for all link 0355 # directives allowed in a header line. 0356 # Sometimes the keyword 'Previous' is found in stead of 0357 # 'Prev'. Thats why the redirection line is checked 0358 # against both of these keywords. 0359 #------------------------------------------------------- 0360 sub ParsHeaderLine { 0361 my ($HL) = @_; 0362 my @LinkList; 0363 #-- Node 0364 push(@LinkList, &ParsHeaderToken($HL, "Node")); 0365 #-- Next 0366 push(@LinkList, &ParsHeaderToken($HL, "Next")); 0367 #-- Up 0368 push(@LinkList, &ParsHeaderToken($HL, "Up")); 0369 #-- Prev or Previous 0370 my @LinkInfo = &ParsHeaderToken($HL, "Prev"); 0371 &ParsHeaderToken($HL, "Previous") if $LinkInfo[0] eq "" && $LinkInfo[1] eq ""; 0372 push(@LinkList, @LinkInfo); 0373 return @LinkList; 0374 } 0375 0376 ############################################################ 0377 # turn tabs into correct number of spaces 0378 # 0379 sub Tab2Space { 0380 my ($line) = @_; 0381 $line =~ s/^\t/ /; # 8 leading spaces if initial tab 0382 while ($line =~ s/^([^\t]+)(\t)/$1 . ' ' x (8 - length($1) % 8)/e) { 0383 } # replace each tab with right num of spaces 0384 return $line; 0385 } 0386 0387 #-------------------------------------------------------- 0388 # ParseMenuItem 0389 #-------------------------------------------------------- 0390 # Takes a line containing a Menu item and returns a list of 0391 # ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText) 0392 # or undef if the parsing fails 0393 #------------------------------------------------------- 0394 0395 sub ParseMenuItem { 0396 my ($Line,$BaseInfoFile) = @_; 0397 my ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText); 0398 $Line = &Tab2Space($Line); # make sure columns line up well 0399 0400 if ($Line =~ /\* ([^:]+)::/) { # -- is a simple entry ending with :: ? 0401 $MenuLinkTag = $1; 0402 $MenuLinkRef = $1; 0403 $MenuLinkText = $'; #' --just to help emacs perl-mode 0404 $MenuLinkFile = &Escape($BaseInfoFile); 0405 } elsif ($Line =~ /\* ([^:]+):(\s*\(($FTAG)\)($TAG)?$TE\.?)?(.*)$/) { 0406 $MenuLinkFile = $BaseInfoFile; 0407 $MenuLinkRef = $1; 0408 $MenuLinkText = $5; 0409 if ($2) { 0410 $MenuLinkFile = $3; 0411 $MenuLinkTag = $4 || 'Top'; 0412 $MenuLinkText = ($2 ? ' ' x (length($2)+1) : '') . "$5\n"; 0413 } else { 0414 $Line = "$5\n"; 0415 if ($Line =~ /( *($TAG)?$TE(.*))$/) { 0416 $MenuLinkTag = $2; 0417 $MenuLinkText = $Line; 0418 } 0419 } 0420 } else { 0421 return undef; 0422 } 0423 $MenuLinkTag = &Escape($MenuLinkTag); # -- escape special chars 0424 $MenuLinkText =~ s/^ *//; 0425 return ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText); 0426 } 0427 0428 #-------------------------------------------------------- 0429 # MenuItem2HTML 0430 #-------------------------------------------------------- 0431 # Transform an info menu item in HTML with references 0432 #------------------------------------------------------- 0433 sub MenuItem2HTML { 0434 my ($Line, $BaseInfoFile) = @_; 0435 my @parse_results = &ParseMenuItem($Line, $BaseInfoFile); 0436 if (!@parse_results) { return $Line; } 0437 my ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText) = @parse_results; 0438 #-- produce a HTML line 0439 return "<tr class=\"infomenutr\"><td class=\"infomenutd\" style=\"width:30%\"><ul><li><a href=\"info:/$MenuLinkFile/$MenuLinkTag\">$MenuLinkRef</a></ul></td><td class=\"infomenutd\">$MenuLinkText"; 0440 } 0441 0442 #------------------------------------------------------------- 0443 # ReadIndirectTable 0444 #------------------------------------------------------------ 0445 # Scans an info file for the occurence of an 'Indirect:' 0446 # table. Scans the entrys and returns two lists with the 0447 # filenames and the global offsets. 0448 #--------------------------------------------------------- 0449 sub ReadIndirectTable { 0450 my ($FileName, $FileNames, $Offsets) = @_; 0451 0452 local *FH1; 0453 if ($FileName =~ /\.gz$/) { 0454 open FH1, "-|", "gunzip", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); 0455 } elsif ($FileName =~ /\.bz2$/) { 0456 open FH1, "-|", "bunzip2", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); 0457 } elsif ($FileName =~ /\.(lzma|xz)$/) { 0458 open FH1, "-|", "unxz", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); 0459 } else { 0460 open(FH1, $FileName) || &DieFileNotFound($FileName); 0461 } 0462 #-- scan for start of Indirect: Table 0463 local $_; 0464 while (<FH1>) { 0465 my $Next = <FH1> if /$NODEBORDER/; 0466 last if $Next =~ /^Indirect:/i; 0467 } 0468 #-- scan the entrys and setup the arrays 0469 local $_; 0470 while (<FH1>) { 0471 last if /$NODEBORDER/; 0472 if (/([^:]+):[ \t]+(\d+)/) { 0473 push(@$FileNames, $1); 0474 push(@$Offsets, $2); 0475 } 0476 } 0477 close(FH1); 0478 } 0479 0480 #--------------------------------------------------------- 0481 # ReadTagTable 0482 #-------------------------------------------------------- 0483 # Reads in a tag table from an info file. 0484 # Returns an assoziative array with the tags found. 0485 # Tags are transformed to lower case (info is not 0486 # case sensitive for tags). 0487 # The entrys in the assoziative Array are of the 0488 # form 0489 # <file>#<offset> 0490 # <file> may be empty if an indirect table is 0491 # present or if the node is located in the 0492 # main file. 0493 # 'Exists' indicates if a tag table has been found. 0494 # 'IsIndirect' indicates if the tag table is based 0495 # on a indirect table. 0496 #-------------------------------------------------------- 0497 sub ReadTagTable { 0498 my ($FileName, $TagList, $Exists, $IsIndirect) = @_; 0499 0500 local *FH; 0501 if ($FileName =~ /\.gz$/) { 0502 open FH, "-|", "gunzip", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); 0503 } elsif ($FileName =~ /\.bz2$/) { 0504 open FH, "-|", "bunzip2", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); 0505 } elsif ($FileName =~ /\.(lzma|xz)$/) { 0506 open FH, "-|", "unxz", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); 0507 } else { 0508 open FH, $FileName || &DieFileNotFound($FileName); 0509 } 0510 ($$Exists, $$IsIndirect) = (0, 0); 0511 #-- scan for start of tag table 0512 local $_; 0513 while (<FH>) { 0514 if (/$NODEBORDER/) { 0515 if (<FH> =~ /^Tag table:/i) { 0516 $$Exists = 1; 0517 last; 0518 } 0519 } 0520 } 0521 #-- scan the entrys 0522 local $_; 0523 while (<FH>) { 0524 $$IsIndirect = 1 if /^\(Indirect\)/i; 0525 last if /$NODEBORDER/; 0526 if (/Node:[ \t]+([^$REDIRSEP]+)$REDIRSEP(\d+)/) { 0527 my ($Tag, $Offset) = (lc($1), $2); 0528 my $File = $1 if /File:[ \t]+([^\t,]+)/; 0529 $TagList->{$Tag} = $File."#".$Offset; 0530 } 0531 } 0532 close(FH); 0533 } 0534 0535 #---------------------------------------------------------- 0536 # ParsCrossRefs 0537 #---------------------------------------------------------- 0538 # scans a line for the existence of cross references and 0539 # transforms them to HTML using a little icon 0540 #---------------------------------------------------------- 0541 sub ParsCrossRefs { 0542 my ($prev, $Line, $BaseInfoFile) = @_; 0543 my ($NewLine, $Token); 0544 my ($CrossRef, $CrossRefFile, $CrossRefTag, $CrossRefRef, $CrossRefText); 0545 $Line = " " . $Line; 0546 if ($prev =~ /\*Note([^\t\,\.]*)$/mi) { 0547 $Line = "$prev-NEWLINE-$Line" if $Line =~ /^$TAG$TE/m; 0548 } 0549 my @Tokens = split(/(\*Note)/i, $Line); # -- split the line 0550 while ($Token = shift @Tokens) { 0551 $CrossRefTag = $CrossRefRef = $CrossRefFile = $CrossRefText = ''; 0552 if ($Token !~ /^\*Note/i) { #-- this part is pure text 0553 $NewLine .= $Token; 0554 next; #-- ... take the next part 0555 } 0556 $CrossRef = shift(@Tokens); 0557 if ($CrossRef !~ /:/) { #-- seems not to be a valid cross ref. 0558 $NewLine .= $Token.$CrossRef; 0559 next; # -- ... take the next one 0560 } 0561 if ($CrossRef =~ /^([^:]+)::/) { # -- a simple cross ref.. 0562 $CrossRefTag = $1; 0563 $CrossRefText = $'; 0564 $CrossRefRef = $CrossRefTag; 0565 $CrossRefTag =~ s/-NEWLINE-/ /g; 0566 $CrossRefTag =~ s/^\s+//; 0567 $CrossRefTag =~ s/\s+/ /g; 0568 $CrossRefRef =~ s/-NEWLINE-/\n/g; 0569 $CrossRefTag = &Escape($CrossRefTag); # -- escape specials 0570 $BaseInfoFile = &Escape($BaseInfoFile); 0571 $NewLine .= "<a href=\"info:/$BaseInfoFile/$CrossRefTag\">"; 0572 $NewLine .= "$CrossRefRef</a>$CrossRefText"; 0573 next; # -- .. take the next one 0574 } 0575 if ($CrossRef !~ /$TE/) { # never mind if tag doesn't end on this line 0576 $NewLine .= $Token.$CrossRef; 0577 next; 0578 } 0579 #print "--- Com. CR : $CrossRef --- \n"; 0580 if ($CrossRef =~ /([^:]+):/) { #-- A more complicated one .. 0581 $CrossRefRef = $1; 0582 $CrossRef = $'; 0583 $CrossRefText = $CrossRef; 0584 } 0585 if ($CrossRef =~ /^(\s|\n|-NEWLINE-)*\(($FTAG)\)/) { #-- .. with another file ? 0586 $CrossRefFile = $2; 0587 $CrossRef = $'; 0588 } 0589 $CrossRefTag = $2 if $CrossRef =~ /^(\s|\n|-NEWLINE-)*($TAG)?($TE)/; #-- ... and a tag ? 0590 if ($CrossRefTag eq "" && $CrossRefFile eq "") { 0591 $NewLine .= "*Note : $CrossRefText$3"; 0592 next; 0593 } 0594 0595 $CrossRefTag =~ s/-NEWLINE-/ /g; 0596 $CrossRefTag =~ s/^\s+//; 0597 $CrossRefTag =~ s/\s+/ /g; 0598 $CrossRefRef =~ s/-NEWLINE-/\n/g; 0599 $CrossRefText =~ s/-NEWLINE-/\n/g; 0600 $CrossRefFile = $BaseInfoFile if $CrossRefFile eq ""; 0601 $CrossRefTag = "Top" if $CrossRefTag eq ""; 0602 $CrossRefRef = "($CrossRefFile)$CrossRefTag" if $CrossRefRef eq ''; 0603 $CrossRefTag = &Escape($CrossRefTag); #-- escape specials 0604 $CrossRefFile = &Escape($CrossRefFile); 0605 #-- append the HTML text 0606 $NewLine .= "<a href=\"info:/$CrossRefFile/$CrossRefTag\">"; 0607 $NewLine .= "$CrossRefRef</a>$CrossRefText"; 0608 } 0609 if ($NewLine =~ /\*Note([^\t\,\.]*)$/i) { 0610 return "$DONTPRINTYET$NewLine"; 0611 } else { 0612 $NewLine; #-- return the new line 0613 } 0614 } 0615 0616 0617 #------------------------------------------------------------- 0618 # PrintLinkInfo 0619 #------------------------------------------------------------- 0620 # prints the HTML text for a link information in the 0621 # header of an info node. Uses some icons URLs of icons 0622 # are specified in 'info2html.conf'. 0623 #------------------------------------------------------------ 0624 sub PrintLinkInfo { 0625 my ($LinkType, $LinkFile, $LinkTag, $BaseInfoFile) = @_; 0626 my ($LinkFileEsc, $LinkTypeText); 0627 return if $LinkFile eq "" && $LinkTag eq ""; 0628 0629 #-- If no auxiliary file specified use the current info file 0630 $LinkFile ||= $BaseInfoFile; 0631 my $LinkRef = $LinkTag; 0632 $LinkTag = &Escape($LinkTag); 0633 $LinkFileEsc = &Escape($LinkFile); 0634 #-- print the HTML Text 0635 print <<EOF; 0636 <a href="info:/$LinkFileEsc/$LinkTag"> 0637 $LinkTypeText 0638 <strong>$LinkRef</strong> 0639 </a> 0640 EOF 0641 } 0642 0643 #------------------------------------------------------------- 0644 # PrintHeader 0645 #------------------------------------------------------------- 0646 # Prints the header for an info node in HTML format 0647 #------------------------------------------------------------ 0648 sub PrintHeader { 0649 my ($LinkList, $BaseInfoFile) = @_; 0650 my @LinkList = @{$LinkList}; 0651 0652 my $UpcaseInfoFile = $BaseInfoFile; 0653 $UpcaseInfoFile =~ tr/a-z/A-Z/; 0654 #-- TEXT for the header of an info node 0655 print <<EOF; 0656 $DOCTYPE 0657 <html> 0658 <head> 0659 <meta http-equiv="Content-Type" content="text/html;charset=utf-8" > 0660 <title>Info: ($BaseInfoFile) $LinkList[1]</title> 0661 $STYLESHEET_KDE 0662 <!-- These can't be in the .css file due to the help KIO worker not being 0663 followed. --> 0664 <style type="text/css"> 0665 #header_top { background-image: url("help:/kdoctools5-common/top.jpg"); } 0666 #header_top div { background-image: url("help:/kdoctools5-common/top-left.jpg"); } 0667 #header_top div div { background-image: url("help:/kdoctools5-common/top-right.jpg"); } 0668 0669 /* Newer updates to kde.org, looks good */ 0670 #header_bottom { 0671 margin: 0 auto; 0672 padding: 0.1em 0em 0.3em 0; 0673 vertical-align: middle; 0674 text-align: center; 0675 background: #eeeeee; 0676 } 0677 </style> 0678 </head> 0679 <body> 0680 <!--header start--> 0681 <div id="header"><div id="header_top"> 0682 <div><div> 0683 <img src="help:/kdoctools5-common/top-kde.jpg" alt="[KDE Help]"> $UpcaseInfoFile: $LinkList[1]</div></div> 0684 </div> 0685 <div class="header_bottom" style="border: none"> 0686 EOF 0687 common_headers($LinkList, $BaseInfoFile); 0688 print <<EOF; 0689 </div></div> 0690 <div id="contents"> 0691 <div class="chapter"> 0692 EOF 0693 } 0694 0695 sub common_headers { 0696 my ($LinkList, $BaseInfoFile) = @_; 0697 my @LinkList = @{$LinkList}; 0698 print <<EOF; 0699 <table border="0" cellspacing="0" cellpadding="0" width="100%"> 0700 <tr><td style="width:33%" align="left"> 0701 EOF 0702 &PrintLinkInfo("Prev", $LinkList[6], $LinkList[7], $BaseInfoFile); 0703 print <<EOF; 0704 </td><td style="width:34%" align="center"> 0705 EOF 0706 &PrintLinkInfo("Up", $LinkList[4], $LinkList[5], $BaseInfoFile); 0707 print <<EOF; 0708 </td><td style="width:33%" align="right"> 0709 EOF 0710 &PrintLinkInfo("Next", $LinkList[2], $LinkList[3], $BaseInfoFile); 0711 print <<EOF; 0712 </td></tr></table> 0713 EOF 0714 } 0715 0716 #--------------------------------------------------------- 0717 # PrintFooter 0718 #--------------------------------------------------------- 0719 # prints the footer for an info node in HTML format 0720 #--------------------------------------------------------- 0721 sub PrintFooter { 0722 my ($LinkList, $BaseInfoFile, $LinkFile) = @_; 0723 0724 $LinkFile ||= $BaseInfoFile; 0725 0726 #-- TEXT for the footer of an info node 0727 print <<EOF; 0728 </div> 0729 </div> 0730 <div id="footer"> 0731 EOF 0732 common_headers($LinkList, $BaseInfoFile); 0733 print <<EOF; 0734 <div id="footer_text"> 0735 <em>Automatically generated by a version of 0736 <a href="$info2html::config::DOC_URL"> 0737 <b>info2html</b> 0738 </a> modified for <a href="https://www.kde.org/">KDE</a></em>. 0739 </div></div> 0740 </body> 0741 </html> 0742 EOF 0743 } 0744 0745 #---------------------------------------------------------- 0746 # ReplyNotFoundMessage 0747 #---------------------------------------------------------- 0748 sub ReplyNotFoundMessage { 0749 my ($FileName, $Tag) = @_; 0750 print <<EOF; 0751 $DOCTYPE 0752 <head> 0753 <meta http-equiv="Content-Type" content="text/html;charset=utf-8" > 0754 <title>Info Files - Error Message</title> 0755 $STYLESHEET_KDE 0756 </head> 0757 <h1>Error</h1> 0758 <body> 0759 The Info node <em>$Tag</em> in Info file <em>$FileName</em> 0760 does not exist. 0761 </body> 0762 EOF 0763 } 0764 0765 sub PrintByFileLink { 0766 print <<EOF 0767 0768 <hr width="80%"/> 0769 <p>If you did not find what you were looking for try <a href="info:$BROWSE_BY_FILE_PATH">browsing by file</a> to 0770 see info files from packages which may not have updated the directory. 0771 EOF 0772 } 0773 0774 #----------------------------------------------------------- 0775 # BrowseByFile 0776 #----------------------------------------------------------- 0777 # Shows a list of available files in the system with a short 0778 # description of them. 0779 #------------------------------------------------------------ 0780 0781 sub BrowseByFile { 0782 my @LinkList = ('', '', '', '', 0783 'dir', 'Top', '','',''); # set LinkList[4] & LinkList[5], of course ;) 0784 my $BaseInfoFile = 'Available Files'; 0785 &PrintHeader(\@LinkList, $BaseInfoFile); 0786 print <<EOF; 0787 <h2>Available Files</h2> 0788 EOF 0789 &infocat; 0790 &PrintFooter(\@LinkList, $BaseInfoFile); 0791 } 0792 0793 #----------------------------------------------------------- 0794 # InfoNode2HTML 0795 #----------------------------------------------------------- 0796 # scans an info file for the node with the name '$Tag' 0797 # starting at the postion '$Offset'. 0798 # If found the node is tranlated to HTML and printed. 0799 #------------------------------------------------------------ 0800 sub InfoNode2HTML { 0801 my ($FileName, $Offset, $Tag, $BaseInfoFile) = @_; 0802 0803 local *FH2; 0804 if ($FileName =~ /\.gz$/) { 0805 open FH2, "-|", "gunzip", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); 0806 } elsif ($FileName =~ /\.bz2$/) { 0807 open FH2, "-|", "bunzip2", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); 0808 } elsif ($FileName =~ /\.(lzma|xz)$/) { 0809 open FH2, "-|", "unxz", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); 0810 } else { 0811 open FH2, $FileName || &DieFileNotFound($FileName); 0812 } 0813 seek(FH2, $Offset, 0); 0814 $Tag =~ tr/A-Z/a-z/; # -- to lowercase 0815 #-- scan for the node start 0816 my ($Found, @LinkList); 0817 local $_; 0818 while (<FH2>) { 0819 if (/$NODEBORDER/) { 0820 my $line = <FH2>; 0821 @LinkList = &ParsHeaderLine($line); 0822 my $CompareTag = $Tag; 0823 $CompareTag =~ s/([^0-9A-Za-z])/\\$1/g; #-- escape special chars ! 0824 my $Temp = $LinkList[1]; 0825 $Temp =~ tr/A-Z/a-z/; #-- to lower case 0826 if ($Temp =~ /^\s*$CompareTag\s*$/) { #-- node start found ? 0827 $Found = 1; 0828 last; 0829 } 0830 } 0831 } 0832 0833 return &ReplyNotFoundMessage($FileName, $Tag) unless $Found; # -- break if not found; 0834 0835 &PrintHeader(\@LinkList, $BaseInfoFile); 0836 my $InMenu = 0; 0837 my $prev; 0838 my $LineCount = 0; 0839 my $Entries = 0; 0840 my $Par = 0; 0841 my @ParLines = (); 0842 my $ParLine=0; 0843 my $MayBeText=0; 0844 my $MayBeTitle=0; 0845 my $Line; 0846 my $PrevMenu; 0847 local $_; 0848 while (<FH2>) { 0849 $LineCount++; 0850 last if /$NODEBORDER/; 0851 #-- replace meta characters 0852 #s/"`"([^"'"]*)"'"/"<span class=\"option\">"$1"</span>"/g; 0853 s/&/&/g; 0854 s/>/>/g; 0855 s/</</g; 0856 0857 my $Length = length($_); 0858 if ($LineCount == 3 && $InMenu == 0 && length($_) == $Length && $Length > 1){ #-- an underline ? 0859 if (/^\**$/) { 0860 print "<h2>$prev</h2>\n"; 0861 $prev = ""; 0862 next; 0863 } 0864 elsif (/^=*$/) { 0865 print "<h3>$prev</h3>\n"; 0866 $prev = ""; 0867 next; 0868 } 0869 else { 0870 print "<h4>$prev</h4>\n"; 0871 $prev = ""; 0872 next; 0873 } 0874 } 0875 0876 if (/^\* Menu/ && $InMenu == 0) { # -- start of menu section ? 0877 $InMenu = 1; 0878 print "<h3>Menu</h3>\n"; 0879 } 0880 elsif ($InMenu == 1) { 0881 # This is pretty crappy code. 0882 # A lot of logic (like the ParsCrossRefs and tranforming Variable: etc) is repeated below. 0883 # There have been a few bugs which were fixed in one branch of the code and left in the other. 0884 # This should be refactored. 0885 # LPC (16 March 2003) 0886 if (/^\* /) { #-- a menu entry ? 0887 if ($Entries == 0) { 0888 $Entries = 1; 0889 print "<table class=\"infomenutable\">"; 0890 } 0891 print &MenuItem2HTML($_,$BaseInfoFile); 0892 } 0893 elsif (/^$/) { #-- empty line 0894 if ($Entries == 1) { 0895 print "</td></tr></table>"; 0896 $Entries = 0; 0897 } 0898 print "<br>"; 0899 } 0900 else { 0901 $Line = &ParsCrossRefs($prev,$_,$BaseInfoFile); 0902 if ($Line =~ /^$DONTPRINTYET/) { 0903 $prev = $Line; 0904 $prev =~ s/^$DONTPRINTYET//; 0905 chomp $prev; 0906 } 0907 elsif ($LineCount == 2) { 0908 $prev = $Line; 0909 } else { 0910 $prev = $Line; 0911 $Line =~ s{- (Variable|Function|Macro|Command|Special Form|User Option|Data Type):.*$}{<em><strong>$&</strong></em>}; 0912 $Line =~ s/^[ \t]*//; 0913 print $Line; 0914 } 0915 } 0916 } 0917 else { 0918 if (/^ *$/) { 0919 if ($MayBeText == 1) { 0920 print "<p>$Par</p>" 0921 } else { 0922 print "<pre>"; 0923 foreach (@ParLines) { 0924 print $_; 0925 } 0926 print "\n"; 0927 print "</pre>"; 0928 } 0929 @ParLines = (); 0930 $ParLine = 1; 0931 $MayBeText = 1; 0932 $MayBeTitle = 1; 0933 $Par = ""; 0934 } else { 0935 if ($ParLine == 1) { 0936 if (!/^ {1,4}[^ ]/ || /[^ ] [^ ]/) { 0937 $MayBeText = 0; 0938 } 0939 } else { 0940 if (!/^ ?[^ ]/ || /[^ ] [^ ]/) { 0941 $MayBeText = 0; 0942 } 0943 } 0944 $Line = &ParsCrossRefs($prev,$_,$BaseInfoFile); 0945 if ($Line =~ /^$DONTPRINTYET/) { 0946 $prev = $Line; 0947 $prev =~ s/^$DONTPRINTYET//; 0948 chomp $prev; 0949 } elsif ($LineCount == 2) { 0950 $prev = $Line; 0951 } else { 0952 $prev = $Line; 0953 $Line =~ s{- (Variable|Function|Macro|Command|Special Form|User Option):.*$}{<strong>$&</strong>}; 0954 $Line =~ s/`([^']*)'/`<span class="option">$1<\/span>'/g; #' 0955 $Line =~ s/((news|ftp|http):\/\/[A-Za-z0-9\.\/\#\-_\~\?\=\%]*)/<a href="$1">$1<\/a>/g; 0956 $Line =~ s/([A-Za-z0-9\.\/\#\-_\~]*\@[A-Za-z0-9\.\/\#\-_\~]*\.[A-Za-z]{2,3})/<a href="mailto:$1">$1<\/a>/g; 0957 $Par = $Par . $Line; 0958 $ParLines[$ParLine] = $Line; 0959 $ParLine++; 0960 } 0961 } 0962 } 0963 } 0964 if ($Entries == 1) { 0965 print "</table>" 0966 } 0967 if ($PrevMenu =~ "") { 0968 print &MenuItem2HTML($PrevMenu,$BaseInfoFile); 0969 } 0970 0971 close(FH2); 0972 0973 if ($BaseInfoFile =~ m/dir/i 0974 && $Tag =~ m/Top/i) { 0975 &PrintByFileLink; 0976 } 0977 0978 &PrintFooter(\@LinkList, $BaseInfoFile); 0979 } 0980 0981 #------------------------------------------------------------- 0982 # max 0983 #------------------------------------------------------------ 0984 sub max { 0985 my ($a, $b) = @_; 0986 return $a >= $b ? $a : $b; 0987 } 0988 0989 #----------------------------------------------------------- 0990 # GetFileAndOffset 0991 #------------------------------------------------------------ 0992 # This procedure locates a specific node in a info file 0993 # The location is based on the tag and indirect table in 0994 # basic info file if such tables are available. 0995 # Because the offsets specified in the tag and in the 0996 # indirect table are more or less inacurate the computet 0997 # offset is set back 100 bytes. From this position 0998 # the specified node will looked for sequentially 0999 #------------------------------------------------------------ 1000 sub GetFileAndOffset { 1001 my ($BaseInfoFile, $NodeName) = @_; 1002 my ($Exists, $IsIndirect, $File, $Offset, $FileOffset, %TagList, @FileNames, @Offsets); 1003 $NodeName =~ tr/A-Z/a-z/; 1004 &ReadIndirectTable($BaseInfoFile, \@FileNames, \@Offsets); 1005 1006 1007 # This looks wastefull: 1008 # We build a whole TagList hash and then use it to lookup the tag info. 1009 # Why not pass $NodeName to ReadTagTable and let it return just the desired info? 1010 # lpc (16 March 2003) 1011 &ReadTagTable($BaseInfoFile, \%TagList, \$Exists, \$IsIndirect); 1012 return "", 0 unless $Exists; #-- no tag table available 1013 return "", 0 unless defined $TagList{$NodeName}; #-- tag is not in the tag table 1014 ($File, $Offset) = split(/#/, $TagList{$NodeName}); 1015 return $File, &max($Offset - 100, 0) if $File; #-- there is an explicite 1016 #-- not in the tag table 1017 1018 if ($IsIndirect == 1) { 1019 foreach my $i (0..$#Offsets) { 1020 $FileOffset = $Offsets[$i] if $Offsets[$i] <= $Offset; 1021 $File = $FileNames[$i] if $Offsets[$i] <= $Offset; 1022 } 1023 return $File, &max($Offset - $FileOffset - 100,0); #-- be safe (-100!) 1024 } else { 1025 return "", &max($Offset - 100, 0); 1026 } 1027 } 1028 1029 # FindFile: find the given file on the infopath, return full name or "". 1030 # Let filenames optionally have .info suffix. Try named version first. 1031 # Handle gzipped file too. 1032 sub FindFile { 1033 my ($File) = @_; 1034 return "" if ($File =~ /\.\./); 1035 my $Alt = $File =~ /^(.+)\.info$/ ? $1 : $File . '.info'; 1036 foreach my $Name ($File, $Alt) { 1037 my $gzName = $Name . '.gz'; 1038 my $bz2Name = $Name . '.bz2'; 1039 my $lzmaName = $Name . '.lzma'; 1040 my $xzName = $Name . '.xz'; 1041 1042 foreach (@info2html::config::INFODIR) { 1043 return "$_/$Name" if -e "$_/$Name"; 1044 return "$_/$gzName" if -e "$_/$gzName"; 1045 return "$_/$bz2Name" if -e "$_/$bz2Name"; 1046 return "$_/$lzmaName" if -e "$_/$lzmaName"; 1047 return "$_/$xzName" if -e "$_/$xzName"; 1048 } 1049 next unless $ENV{INFOPATH}; 1050 foreach my $i (split(/:/, $ENV{INFOPATH})) { 1051 return "$i/$Name" if -e "$i/$Name"; 1052 return "$i/$gzName" if -e "$i/$gzName"; 1053 return "$i/$bz2Name" if -e "$i/$bz2Name"; 1054 return "$i/$lzmaName" if -e "$i/$lzmaName"; 1055 return "$i/$xzName" if -e "$i/$xzName"; 1056 } 1057 } 1058 return ""; 1059 } 1060 1061 #------------------------------------------------------- 1062 # 1063 #------------------- MAIN ----------------------------- 1064 # 1065 # called as 1066 # perl /path/kde-info2html config_file image_base_path BaseInfoFile NodeName 1067 # 1068 # BaseInfoFile eq '#special#' to pass special args through NodeName (yes, it is a hack). 1069 # 1070 1071 my $PROGRAM = $0; # determine our basename and version 1072 $PROGRAM =~ s!.*/!!; 1073 my ($BaseInfoFile, $NodeName) = ($ARGV[2], $ARGV[3]); 1074 #&DirnameCheck($BaseInfoFile) || &DieFileNotFound($BaseInfoFile); 1075 1076 if ($BaseInfoFile eq '#special#' && $NodeName eq 'browse_by_file') { 1077 &BrowseByFile; 1078 exit 0; 1079 } 1080 1081 $BaseInfoFile = "dir" if $BaseInfoFile =~ /^dir$/i; 1082 my $FileNameFull = &FindFile($BaseInfoFile) || &FileNotFound($BaseInfoFile,$NodeName); 1083 my ($File, $Offset) = &GetFileAndOffset($FileNameFull, $NodeName); 1084 $File ||= $BaseInfoFile; 1085 $FileNameFull = &FindFile($File); 1086 &InfoNode2HTML($FileNameFull, $Offset, $NodeName, $BaseInfoFile); 1087 1088 exit 0;