#! /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 ();

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.