#!/usr/bin/perl
# Copyright (c) 1996-2003 SuSE Linux AG, Nuernberg, Germany.
# All rights reserved.
#
# Author: Werner Fink <werner@suse.de>, 1996,1997,2003
#
# MAKEDIR.perl  --- Version 0.54
#

use bytes;

if ( $#ARGV > 0 ) {
    printf(STDERR "%s: Usage:\n", $0);
    printf(STDERR "  %s [info_dir_file]\n", $0); exit(1);
}

if ( length($ENV{'INFOPATH'}) > 0 ) {
    @PATHS = split(/:/, $ENV{'INFOPATH'});
}
@PATHS=(
#
# /usr/share/info is the first in Path because it's our main info dir!
#
	     "/usr/share/info",
	     "/usr/info",
#
# Insert INFOPATH
#
	     @PATHS,
	     "/usr/lib/info",
#
# TeTeX-Infos are looked in by symbolic links in /usr/info.
#
#	     "/usr/lib/teTeX/info",
	     "/usr/local/info",
	     "/usr/local/lib/info",
	     "/usr/X11R6/info",
	     "/usr/X11R6/lib/info",
#
# xemacs has big problems handling nodes of the same name but
# different paths ... it's really buggy.
#
	     "/usr/X11R6/lib/xemacs/info",
	     "/usr/share/xemacs/xemacs-packages/info",
	     "/usr/share/xemacs/mule-packages/info",
	     "/usr/share/xemacs/info",
);
#
# Special: flushing file descriptor for speed, smothing, and big results
#
sub flush {
    local($old) = select(shift);
    $| = 1;
    print "";
    $| = 0;
    select($old);
}

#
# Open the main dir file
#
$rand = int(rand(32767));
if ( $#ARGV == 0 ) {
    $mdir    = "$ARGV[0]";
    $mdirbak = "$ARGV[0].bak";
    $mdirtmp = "$ARGV[0].tmp$$.$rand";
} else {
    $mdir    = "$PATHS[0]/dir";
    $mdirbak = "$PATHS[0]/dir.bak";
    $mdirtmp = "$PATHS[0]/dir.tmp$$.$rand";
}

sub cleanup {
    unlink $mdirtmp;
    exit(1);
}
$SIG{'INT'}  = "cleanup";
$SIG{'TERM'} = "cleanup";
$SIG{'HUP'}  = "cleanup";
$SIG{'PIPE'} = 'IGNORE';

if ( !-e $mdir ) { `touch $mdir 2>&1 /dev/null`; }

if ( -w $mdir ) {
    # sysopen(FH, $mdirtmp, O_RDWR|O_CREAT|O_EXCL) or die "Cannot create $mdirtmp\n";
    # close(FH);
    if ( -s $mdir && !-e $mdirbak ) {
	`cp -p $mdir $mdirbak`;
	if ( !-e $mdirbak ) { exit(1); }
    }
    `cp -p $mdir $mdirtmp`;
    if ( !-e $mdirtmp ) { exit(1); }
    $filehandle = ">$mdir" ;
} else {
    printf(STDERR "%s: Warning, can not write to %s\n", $0, $mdir);
    printf(STDERR "  ... using STDOUT!\n");
    flush(STDERR);
    sleep (2);
    $filehandle = ">-";
}

##
## read info dir
##
@allinfo = ();
%found   = ();
for ( @PATHS ) {
    @info = ();
    $found{$_}++;
    if ( $found{$_} > 1 ) {
	next;
    }
    (-e $_) && (@info = ( -d $_ ) ? ( <$_/*> ) : ( $_ ));
    @info = grep(/[^0-9](|\.gz)$/, @info);
    @info = grep(!/(dir|dir\.bak|localdir|\~|\,v|\.orig)(|\.gz)$/, @info);
    @info = sort grep(!/-\d+\./, @info);
    push(@allinfo, @info);
}

sub basename {
    local($name) = @_;
    $name =~ s!.*/!!;
    $name =~ s/\.gz//;
    $name =~ s/\.info//;
    $name =~ s/\+/\\\\+/g;

    return ($name);
}

sub path {
    local($name) = @_;
    $name =~ s!\/[^/]*$!!;

    return ($name);
}

##
##
## Global section titles used as keys
##
##
@sec = ();

#
# Reformat if required
#
sub do_format {
    local($node, @buf) =  @_;
    local($base) =  basename($node);
    local($path) =  path($node);
    local($name) = "";
    local($desc) = "";
    local($link) = "";
    local($l, $first, @ent);

    $node =~ s/\.gz$//;
    $node =~ s/\.info$//;
    $node =~ s!//!/!g;

    if ( $path =~ /^$PATHS[0]$/ ) { $node = $base; }

    @ent = ();
    foreach $l (@buf) {
	$first = index($l,"*");

	$l =~ s/\($base\)/\($node\)/g;
	$l =~ s/::/: \($node\)\./g;

	$name = "";
	$desc = "";
	$link = "";

	($name,$desc) = split(/\.\s+/,"$l");

	$name =~ s/\n//g;
	$name =~ s/\s+$//g;
	$name =~ s/^\s+//g;

	$desc =~ s/\n//g;
	$desc =~ s/\s+$//g;
	$desc =~ s/^\s+//g;

	if ( $first == 0 ) {
	    $l =~ s/^(\s+)//g;
	    ($name, $link) = split(/:/, $name);
	    $name =~ s/\s+$//g;
	    $link =~ s/^\s+//g;
	    $link =~ s/\.$//g;
	    $name = $name . ':' . ' ' . $link . '.';
	    if ( length($l) > 80 ) {
		if ( length($name) < 16 && length($desc) < 62) {
		     $l = sprintf("%-16.18s%s", $name, $desc);
		} else {
		    if ( length($desc) > 0 ) {
			$l = sprintf("%s\n\t\t%s", $name, $desc);
		    } else {
			$l = sprintf("%s", $name);
		    }
		}
	    }
	}
	push(@ent, $l);
    }
    return join("\n", @ent);
}

#
# No info for entry found, use old or make a new one
#
sub guess_missed {
    local($node) =  @_;
    local($base) =  basename($node);
    local($path) =  path($node);
    local($cur)  = "default";
    local($ldir);
    local(@buf, $add, $lines);

    $node =~ s/\.gz$//;
    $node =~ s/\.info$//;
    $node =~ s!//!/!g;

    if ( $path =~ /^$PATHS[0]$/ ) { $node = $base; }

    if ( $path !~ /^$PATHS[0]$/ ) {
	$ldir = "$path/dir";
    } else {
	$ldir = $mdirtmp;
    }

    @buf = ();
    if ( -e $ldir && -r $ldir ) {
	open(FILE, $ldir);
	$add = 0;
	while (<FILE>) {
	    #
	    # read next few lines if there is information ($add == 1)
	    #
	    if ( $add == 1 ) {
		if ( /^\s+[^\:\*]+$/ ) {
		    push(@buf, $_); $lines++;
		    next;
		}
		last;
	    }
	    if      ( /^\*\s+$base\:\s+\($base\)\.\s+\w/i ) {
		$add = 1; push(@buf, $_); $lines = 1;
	    } elsif ( /^\*\s+$base\:\:\s+\w/i ) {
		$add = 1; push(@buf, $_); $lines = 1;
	    } elsif ( /^\*\s+$base\:\s+\($base\)\.\s+$/i ) {
		$add = 1; push(@buf, $_); $lines = 0;
	    } elsif ( /^\*\s+$base\:\:\s+$/i ) {
		$add = 1; push(@buf, $_); $lines = 0;
	    } else {
		next;
	    }
	}
	close(FILE);
    }

    if ($lines > 0) {
	$sec{$cur} = join("\n", $sec{$cur}, do_format($node, @buf));
    } else {
	$base =~ s!(.*)!\L$1!;
	$base =~ s!(.*)!\u$1!;
	$base  = '* ' . $base . ':';
	$sec{$cur} = join("\n", $sec{$cur},
		sprintf("%-0.80s %s\n", $base, '(' . $node . ').'));
    }
}

#
# read info file for entry in dir file
#
sub read_entry {
    local($file) = @_;
    local($add, $lines, @buf);
    local($cur) = "default";
    local($source) = $file =~ /\.gz$/ ? "gunzip -q -d -c $file 2>/dev/null |" : "< $file";
    local(@buf);

    $add = 0;
    $lines = 0;
    @buf = ();
    open(_FILE, $source) or warn "can't open $source\n";
    while (<_FILE>) {
	chomp;
	s/\s+$//;
	last if ( /^($|File:)/ );
	next if ( /^$/ );
	if ( /^INFO-DIR-SECTION/o )  {
	    s/^INFO-DIR-SECTION\s+//;
	    $cur = $_;
	    next;
	}
	if ( /^START-INFO-DIR-ENTRY/o ) {
	    $add = 1;
	    push(@buf, "\n") if ( $cur =~ /default/ );
	    next;
	}
	if ( /^END-INFO-DIR-ENTRY/o ) {
	    $add = 0;
	    $sec{$cur} = join("\n", $sec{$cur}, do_format($file, @buf));
	    next;
	}
	if ( $add == 1 ) {
	    $lines++;
	    push(@buf, $_);
	    next;
	}
    }
    close(_FILE);

    guess_missed($file) if ( $lines == 0 );
}

#
# Do all the stuff
#
foreach $elem (@allinfo) {
    read_entry($elem) if ( -f $elem );
}

open(DIR, "$filehandle") or die "Cannot open $filehandle\n";
binmode DIR;

##
## define top format
##
format DIR =
-*- Text -*-
This is the file /usr/info/dir, which contains the topmost node of the
Info hierarchy.  The first time you invoke Info you start off
looking at that node, which is (dir)Top.

File: dir	Node: Top	This is the top of the INFO tree

  This (the Directory node) gives a menu of major topics.

  Usage in info-mode of EMACS:
    Typing "d" returns here,       typing "?" lists all INFO commands,
    typing "q" exits,     typing "h" gives a  primer for first-timers,
    pressing 2nd button on a highlighted word follows cross-reference.
    
 ---- EDIT WITH CARE: ----
 ---- Only descriptive text for otherwise empty topics will survive ----

* Menu: The list of major topics begins on the next line.

.
##
## end top format
##
write DIR; # write top format
flush(DIR);

@sec = sort keys %sec;
@keys = keys %sec;

while ($#keys >= 0) {
    $cur = pop(@keys);
    if ( $cur =~ /default/ ) {
	printf(DIR "\nVarious Utilities");
    } else {
	printf(DIR "\n%s", $cur);
    }
    printf(DIR "%s\n", $sec{$cur});
}

printf(DIR "\n* Locales:\n");
close(DIR);

unlink($mdirtmp) if ( -e $mdirtmp );
exit 0;
