<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#! /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 =&gt; 0,
    MENU_ENTRY_TAG =&gt; 1,
    MENU_ENTRY_TARGET_FILE =&gt; 2,
    MENU_ENTRY_TARGET_NODE =&gt; 3,
    MENU_ENTRY_DESCRIPTION =&gt; 4,
};

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

use constant {
    STAT_DEV =&gt; 0,
    STAT_INODE =&gt; 1,
    STAT_MODE =&gt; 2,
    STAT_SIZE =&gt; 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-&gt;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-&gt;get ("Miscellaneous");
                $state = STATE_INITIAL;
                $entry = split_menu ($section, $text);
                next unless $entry;
                next if $opt_u &amp;&amp; $tags{$entry-&gt;[MENU_ENTRY_TAG]};
                push @menu_entries, $entry;
                $tags{$entry-&gt;[MENU_ENTRY_TAG]} = 1;
            }
            elsif ($line =~ /^\*/) {
                $section ||= $td-&gt;get ("Miscellaneous");
                $entry = split_menu ($section, $text);
                $text = $line, next unless $entry;
                $text = $line, next if $opt_u &amp;&amp; $tags{$entry-&gt;[MENU_ENTRY_TAG]};
                push @menu_entries, $entry;
                $tags{$entry-&gt;[MENU_ENTRY_TAG]} = 1;
                $text = $line;
            }
            elsif ($line =~ /^\s+/) {
                $text .= $line;
            }
        }
    }
    die "$!" if $fh-&gt;error;
}

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

sub read_info_byname {
    my $name = shift;
    my $fh = open_info_file ($name);
    read_info_file ($fh);
    $fh-&gt;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-&gt;new;
    $d-&gt;open ($name) or die "$!";
    my $entry;
    while ($entry = $d-&gt;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 &amp;&amp; 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-&gt;close ();
}

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

sub write_items {
    my $name = shift;
    my $have_autoformat = eval { require Text::Autoformat };
    my $fh = FileHandle-&gt;new;
    $fh-&gt;open ("&gt;$name") or die "$!";
    $fh-&gt;printf ($td-&gt;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&lt;Return&gt;\" 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-&gt;[MENU_ENTRY_SECTION]) != 0) {
            $section = $menu_entry-&gt;[MENU_ENTRY_SECTION];
            $fh-&gt;print ("\n");
            $fh-&gt;print ($section);
            $fh-&gt;print ("\n");
        }
        $fh-&gt;printf ("* %s: (%s)%s.\n",
                    $menu_entry-&gt;[MENU_ENTRY_TAG],
                    $menu_entry-&gt;[MENU_ENTRY_TARGET_FILE],
                    $menu_entry-&gt;[MENU_ENTRY_TARGET_NODE]);
        if ($have_autoformat) {
            $fh-&gt;print (Text::Autoformat::autoformat ($menu_entry-&gt;[MENU_ENTRY_DESCRIPTION], { left =&gt; $opt_l, right =&gt; $opt_r }))
              if $menu_entry-&gt;[MENU_ENTRY_DESCRIPTION];
        }
        else {
            map { $fh-&gt;printf ("%s%s\n", ' ' x $opt_l, $_); } (split /\n/, $menu_entry-&gt;[MENU_ENTRY_DESCRIPTION])
              if $menu_entry-&gt;[MENU_ENTRY_DESCRIPTION];
        }
    }
    $fh-&gt;close ();
}

sub usage {
    print $td-&gt;get (
&lt;&lt;'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-&gt;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 ();
</pre></body></html>