Redirecting ....

If you are not automatically taken to a new page, click here to continue. 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.(lzma|xz)$/ ) { open DIR, "-|", "xzcat", $DirFileName; } elsif ($DirFileName =~ m/.info.gz$/ ) { open DIR, "-|", "gzip", "-dc", $DirFileName; } else { open DIR, $DirFileName; } my $looking = 1; while (

) { next if $looking && !/\* Menu/; $looking = 0; my @item = &ParseMenuItem($_,'dir'); if (!@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.(lzma|xz)$/ ) { open INFOFILE, "-|", "xzcat", "$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 () { last if (m/END-INFO-DIR-ENTRY/); s/^\* //; chomp; next if /^\s*$/; if ($collect) { $filedesc .= "\n
" if ($collect < 16); $filedesc .= $_; --$collect; $empty = 0; } elsif (!$empty && !$collect) { $filedesc .= "
...\n"; last; } $collect=16 if (m/START-INFO-DIR-ENTRY/); } # Avoid a noisy "Broken pipe" message from bzcat while () {} close INFOFILE; if ($empty) { $filedesc .= 'no description available'; } $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 '

'; foreach my $description ( @sorted ) { print < $LinkText{$description}

$description EOF } print '

'; } #---------------------------------------------------------- # 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 (!@parse_results) { return $Line; } my ($MenuLinkTag, $MenuLinkFile, $MenuLinkRef, $MenuLinkText) = @parse_results; #-- produce a HTML line return "$MenuLinkRef $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); } elsif ($FileName =~ /\.(lzma|xz)$/) { open FH1, "-|", "unxz", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); } else { open(FH1, $FileName) || &DieFileNotFound($FileName); } #-- scan for start of Indirect: Table local $_; while () { my $Next = if /$NODEBORDER/; last if $Next =~ /^Indirect:/i; } #-- scan the entrys and setup the arrays local $_; while () { 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 # # # 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); } elsif ($FileName =~ /\.(lzma|xz)$/) { open FH, "-|", "unxz", "-q", "-d", "-c", $FileName || &DieFileNotFound($FileName); } else { open FH, $FileName || &DieFileNotFound($FileName); } ($$Exists, $$IsIndirect) = (0, 0); #-- scan for start of tag table local $_; while () { if (/$NODEBORDER/) { if ( =~ /^Tag table:/i) { $$Exists = 1; last; } } } #-- scan the entrys local $_; while () { $$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 .= ""; $NewLine .= "$CrossRefRef$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 .= ""; $NewLine .= "$CrossRefRef$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 < $LinkTypeText $LinkRef 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 < Info: ($BaseInfoFile) $LinkList[1] $STYLESHEET_KDE

EOF common_headers($LinkList, $BaseInfoFile); print <

EOF } sub common_headers { my ($LinkList, $BaseInfoFile) = @_; my @LinkList = @{$LinkList}; print < EOF &PrintLinkInfo("Prev", $LinkList[6], $LinkList[7], $BaseInfoFile); print < EOF &PrintLinkInfo("Up", $LinkList[4], $LinkList[5], $BaseInfoFile); print < EOF &PrintLinkInfo("Next", $LinkList[2], $LinkList[3], $BaseInfoFile); print < EOF } #--------------------------------------------------------- # 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 } #---------------------------------------------------------- # ReplyNotFoundMessage #---------------------------------------------------------- sub ReplyNotFoundMessage { my ($FileName, $Tag) = @_; print < Info Files - Error Message $STYLESHEET_KDE

Error

The Info node $Tag in Info file $FileName does not exist. EOF } sub PrintByFileLink { print <

If you did not find what you were looking for try browsing by file to see info files from packages which may not have updated 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 <Available Files 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); } elsif ($FileName =~ /\.(lzma|xz)$/) { open FH2, "-|", "unxz", "-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 () { if (/$NODEBORDER/) { my $line = ; @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 () { $LineCount++; last if /$NODEBORDER/; #-- replace meta characters #s/"`"([^"'"]*)"'"/""$1""/g; s/&/&/g; s/>/>/g; s/ 1){ #-- an underline ? if (/^\**$/) { print "

$prev

\n"; $prev = ""; next; } elsif (/^=*$/) { print "

$prev

\n"; $prev = ""; next; } else { print "

$prev

\n"; $prev = ""; next; } } if (/^\* Menu/ && $InMenu == 0) { # -- start of menu section ? $InMenu = 1; print "

\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 ""; } print &MenuItem2HTML($_,$BaseInfoFile); } elsif (/^$/) { #-- empty line if ($Entries == 1) { print "

"; $Entries = 0; } print "
"; } 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):.*$}{$&}; $Line =~ s/^[ \t]*//; print $Line; } } } else { if (/^ *$/) { if ($MayBeText == 1) { print "

$Par

" } else { print "

";
            foreach (@ParLines) {
               print $_;
            }
            print "\n";
            print "