#! /usr/bin/env perl

use strict;

use FileHandle;
use Fcntl qw(SEEK_SET :mode);
use DirHandle;
use Locale::gettext;
use Getopt::Std qw(getopts);
use Config;

use constant {
    MENU_ENTRY_SECTION => 0,
    MENU_ENTRY_TAG => 1,
    MENU_ENTRY_TARGET_FILE => 2,
    MENU_ENTRY_TARGET_NODE => 3,
    MENU_ENTRY_DESCRIPTION => 4,
};

use constant {
    STATE_INITIAL => 0,
    STATE_MENU => 1,
    STATE_ENTRY => 2,
};

use constant {
    STAT_DEV => 0,
    STAT_INODE => 1,
    STAT_MODE => 2,
    STAT_SIZE => 7,
};

use vars qw(@menu_entries  @dir_queue  %inodes %tags $td $opt_l $opt_r $opt_u $opt_d);

sub split_menu {
    my ($section, $menu) = @_;
    return () unless $menu =~ m(^\* \s* ([^:\s]+): \s* [\(] ([^\)]+) [\)] ([^.]*) \. (\s+ (.*))?$)sx ;
    return  [ $section, $1, $2, $3, $5 ];
}

sub read_info_file {
    my $fh = shift;
    my ($section, $text, $line, $entry);
    my $state = STATE_INITIAL;
    while ($line = $fh->getline ()) {
        if ($state == STATE_INITIAL) {
            if ($line =~ /^INFO-DIR-SECTION\s+(.*)/) {
                $section = $1;
                chomp $section;
            }
            elsif ($line =~ /^START-INFO-DIR-ENTRY/) {
                $state = STATE_ENTRY;
            }
        }
        elsif ($state == STATE_ENTRY) {
            if ($line =~ /^END-INFO-DIR-ENTRY/) {
                $state = STATE_INITIAL;
            }
            elsif ($line =~ /^\*/) {
                $text = $line;
                $state = STATE_MENU;
            }
        }
        elsif ($state == STATE_MENU) {
            if ($line =~ /^END-INFO-DIR-ENTRY/) {
                $section ||= $td->get ("Miscellaneous");
                $state = STATE_INITIAL;
                $entry = split_menu ($section, $text);
                next unless $entry;
                next if $opt_u && $tags{$entry->[MENU_ENTRY_TAG]};
                push @menu_entries, $entry;
                $tags{$entry->[MENU_ENTRY_TAG]} = 1;
            }
            elsif ($line =~ /^\*/) {
                $section ||= $td->get ("Miscellaneous");
                $entry = split_menu ($section, $text);
                $text = $line, next unless $entry;
                $text = $line, next if $opt_u && $tags{$entry->[MENU_ENTRY_TAG]};
                push @menu_entries, $entry;
                $tags{$entry->[MENU_ENTRY_TAG]} = 1;
                $text = $line;
            }
            elsif ($line =~ /^\s+/) {
                $text .= $line;
            }
        }
    }
    die "$!" if $fh->error;
}

sub open_info_file {
    my $name = shift;
    my ($fh, $prog, @magic);
    $fh = FileHandle->new;
    $fh->open ("<$name") or die "$!";
    $fh->binmode ();
    for (0..3) {
        $fh->read ($magic [$_], 1) or die "$!";
    }
    $fh->close ();
    $prog = 'gzip' if $magic [0] eq chr 0x1f && $magic [1] eq chr 0x8b;
    $prog = 'bzip2' if $magic [0] eq 'B' && $magic [1] eq 'Z' && $magic [2] eq 'h';
    $prog = 'bzip' if $magic [0] eq 'B' && $magic [1] eq 'Z' && $magic [2] eq '0';
    if ($prog) {
        my $cmd = "$prog -cd < $name |";
        $fh->open ($cmd) or die "$!";
    }
    else {
        $fh->open ("<$name") or die "$!";
    }
    return $fh;
}

sub read_info_byname {
    my $name = shift;
    my $fh = open_info_file ($name);
    read_info_file ($fh);
    $fh->close () or die "$?";
}

sub is_subsidiary {
    my $name = shift;
    return $name =~ /-[0-9]+(\.(gz|bz|bz2))?$/;
}

sub scan_infos {
    my $name = shift;
    my $d = DirHandle->new;
    $d->open ($name) or die "$!";
    my $entry;
    while ($entry = $d->read ()) {
        next if $entry eq '.' || $entry eq '..' || $entry =~ /^dir([~.].*)?$/ ;
        my $fullentry = "$name/$entry";
        my @stats = stat ($fullentry) or die "$!";
        my $is_plain = not S_ISDIR ($stats [STAT_MODE]);
        next if $is_plain && is_subsidiary ($entry);
        my $fid = "$stats[STAT_DEV]:$stats[STAT_INODE]";
        next if $inodes{$fid};
        if ($is_plain) {
            read_info_byname ($fullentry);
        }
        else {
            push @dir_queue, $fullentry;
        }
        $inodes{$fid} = 1;
    }
    $d->close ();
}

sub compare_menu_entries ($$) {
    return ($_[0]->[MENU_ENTRY_SECTION] cmp $_[1]->[MENU_ENTRY_SECTION]
           || $_[0]->[MENU_ENTRY_TAG] cmp $_[1]->[MENU_ENTRY_TAG]);
}

sub write_items {
    my $name = shift;
    my $have_autoformat = eval { require Text::Autoformat };
    my $fh = FileHandle->new;
    $fh->open (">$name") or die "$!";
    $fh->printf ($td->get ("%s\nThis is the file .../info/dir, which contains the\
topmost node of the Info hierarchy, called (dir)Top.\
The first time you invoke Info you start off looking at this node.\
\x1f\
%s\tThis is the top of the INFO tree\
\
  This (the Directory node) gives a menu of major topics.\
  Typing \"q\" exits, \"?\" lists all Info commands, \"d\" returns here,\
  \"h\" gives a primer for first-timers,\
  \"mEmacs<Return>\" visits the Emacs manual, etc.\
\
  In Emacs, you can click mouse button 2 on a menu item or cross reference\
  to select it.\
\
%s\
"), "-*- Text -*-", "File: dir,\tNode: Top", "* Menu:");
    my $section = '';
    foreach my $menu_entry (sort compare_menu_entries @menu_entries) {
        if (($section cmp $menu_entry->[MENU_ENTRY_SECTION]) != 0) {
            $section = $menu_entry->[MENU_ENTRY_SECTION];
            $fh->print ("\n");
            $fh->print ($section);
            $fh->print ("\n");
        }
        $fh->printf ("* %s: (%s)%s.\n",
                    $menu_entry->[MENU_ENTRY_TAG],
                    $menu_entry->[MENU_ENTRY_TARGET_FILE],
                    $menu_entry->[MENU_ENTRY_TARGET_NODE]);
        if ($have_autoformat) {
            $fh->print (Text::Autoformat::autoformat ($menu_entry->[MENU_ENTRY_DESCRIPTION], { left => $opt_l, right => $opt_r }))
              if $menu_entry->[MENU_ENTRY_DESCRIPTION];
        }
        else {
            map { $fh->printf ("%s%s\n", ' ' x $opt_l, $_); } (split /\n/, $menu_entry->[MENU_ENTRY_DESCRIPTION])
              if $menu_entry->[MENU_ENTRY_DESCRIPTION];
        }
    }
    $fh->close ();
}

sub usage {
    print $td->get (
<<'EOF'
usage: generate-info-dir [-l LEFT] [-r RIGHT] [-d FILE] [-u] DIR ...
  DIR: defaults to contents of INFOPATH, if that is not set, "/usr/share/info"
 LEFT: left margin for description formatting; defaults to 12
RIGHT: right margin for description formatting; defaults to 72
 FILE: the dirfile to write; defaults to DIR/dir
   -u: ensure each menu entry tag is unique
EOF
    );
    exit $_[0];
}

sub main {
    $td = Locale::gettext->domain ('texinfo');
    getopts ('l:r:d:u') or usage (1);
    $opt_l ||= 12;
    $opt_r ||= 72;
    if (@ARGV) {
        push @dir_queue, @ARGV;
    }
    elsif ($ENV{'INFOPATH'}) {
        push @dir_queue, split ($Config{'path_sep'}, $ENV{'INFOPATH'});
    }
    else {
        push @dir_queue, '/usr/share/info';
    }
    $opt_d ||= $dir_queue [0] . '/dir';
    while (my $info_dir = shift @dir_queue) {
        scan_infos ($info_dir);
    } 
    write_items ("$opt_d~~");
    rename ($opt_d, "$opt_d~") || die "$!" if -r $opt_d;
    rename ("$opt_d~~", $opt_d) || die "$!";
    1;
}

main ();