Perlindex port for win32

As a result of porting tk-pod to win32, there was a need to also port
perlindex.  Here is Diff against perlindex.PL

The menu option doesn't work on win32.  I don't need it so I didn't
look into it past "/dev/tty not found"...

So I turned the default to -nomenu if you run on win32.  This way it
just lists the matching files...

It needs to be tested on Unix. It should still work, but I have no
way of testing it right now.  It should work better on other OSs
too!

François Allard

diff -Naur
--- g:\tmp\perlindex-1.200\perlindex.PL	Tue May 27 11:54:24 1997
+++ perlindex.PL	Fri Feb  4 19:05:24 2000
@@ -65,6 +65,7 @@
 use Getopt::Long;
 use File::Basename;
 use Text::English;
+use File::Spec;			#FA

 # NDBM_File as LAST resort
 package AnyDBM_File;
@@ -129,10 +130,14 @@
 $stemmer = \&Text::English::stem;
 # directory for the index
 $IDIR = $man1direxp;
-$IDIR =~ s:/[^/]*$::;
+#FA up one directory (man\man1 => man).
+$IDIR = File::Spec->rel2abs(File::Spec->updir,$man1direxp);

+use vars '$prune';
+
+#FA menus don't work on win32 (disable or ignore?)
 $opt_index   = '';                # make perl -w happy
-$opt_menu    = 1;
+$opt_menu    = !($^O =~ /win32/i);
 $opt_maxhits = 15;
 $opt_cbreak  = 1;
 &GetOptions(
@@ -148,17 +153,29 @@
     $opt_dict ||= 100;
 }

+#FA
+my $binperlindex = File::Spec->catdir("bin","perlindex");
+
+#FA create variables that correspond to the paths
+my ($IDIR_if,$IDIR_idf,$IDIR_fn, $IDIR_seen);
+
+$IDIR_if = File::Spec->catpath("",$IDIR,"index_if");
+$IDIR_idf = File::Spec->catpath("",$IDIR,"index_idf");
+$IDIR_seen = File::Spec->catpath("",$IDIR,"index_seen");
+$IDIR_fn = File::Spec->catpath("",$IDIR,"index_fn");
+
+
 if ($opt_index) {
     &initstop;

-    tie (%IF,   AnyDBM_File, "$IDIR/index_if",   O_CREAT|O_RDWR, 0644)
-        or die "Could not tie $IDIR/index_if: $!\n";
-    tie (%IDF,  AnyDBM_File, "$IDIR/index_idf",  O_CREAT|O_RDWR, 0644)
-        or die "Could not tie $IDIR/index_idf: $!\n";
-    tie (%SEEN, AnyDBM_File, "$IDIR/index_seen", O_CREAT|O_RDWR, 0644)
-        or die "Could not tie $IDIR/index_seen: $!\n";
-    tie (%FN,   AnyDBM_File, "$IDIR/index_fn",   O_CREAT|O_RDWR, 0644)
-        or die "Could not tie $IDIR/index_fn: $!\n";
+    tie (%IF,   AnyDBM_File, $IDIR_if,   O_CREAT|O_RDWR, 0644)
+        or die "Could not tie $IDIR_if: $!\n";
+    tie (%IDF,  AnyDBM_File, $IDIR_idf,  O_CREAT|O_RDWR, 0644)
+        or die "Could not tie $IDIR_idf: $!\n";
+    tie (%SEEN, AnyDBM_File, $IDIR_seen, O_CREAT|O_RDWR, 0644)
+        or die "Could not tie $IDIR_seen: $!\n";
+    tie (%FN,   AnyDBM_File, $IDIR_fn,   O_CREAT|O_RDWR, 0644)
+        or die "Could not tie $IDIR_fn: $!\n";

     require "find.pl";
     for $dir ($privlibexp) {
@@ -166,35 +183,39 @@
         &find($dir);
     }
     for $name (@ARGV) {
-        my $fns = $name;
-        $fns =~ s:$prefix/::;
+#FA
+        my $fns = File::Spec->abs2rel($name,$prefix);
         next if $SEEN{$fns};
         next unless -f $name;
-        if ($name !~ /(~|,v)$/) {
+#FA ??? what does this mean? - disallow certain undesirables?
+#FA how does that mesh with other OSs?
+#FA index uses sysopen;
+#        if ($name !~ /(~|,v)$/) {
             $did = $FN{'last'}++;
             $SEEN{$fns} = &index($name, $fns, $did);
-        }
+#FA XXX may need some backout code if index fails?
+#        }
     }
     untie %IF;
     untie %IDF;
     untie %FN;
     untie %SEEN;
 } elsif ($opt_dict) {
-    tie (%IDF,  AnyDBM_File, "$IDIR/index_idf",  O_RDONLY, 0644)
-        or die "Could not tie $IDIR/index_idf: $!\n".
+    tie (%IDF,  AnyDBM_File, $IDIR_idf,  O_RDONLY, 0644)
+        or die "Could not tie $IDIR_idf: $!\n".
             "Did you run '$0 -index'?\n";
     while (($key,$val) = each %IDF) {
         printf "%-20s %d\n", $key, $val if $val >= $opt_dict;
     }
     untie %IDF;
 } else {
-    tie (%IF,   AnyDBM_File, "$IDIR/index_if",   O_RDONLY, 0644)
-        or die "Could not tie $IDIR/index_if: $!\n".
+    tie (%IF,   AnyDBM_File, $IDIR_if,   O_RDONLY, 0644)
+        or die "Could not tie $IDIR_if: $!\n".
             "Did you run '$0 -index'?\n";
-    tie (%IDF,  AnyDBM_File, "$IDIR/index_idf",   O_RDONLY, 0644)
-        or die "Could not tie $IDIR/index_idf: $!\n";
-    tie (%FN,   AnyDBM_File, "$IDIR/index_fn",   O_RDONLY, 0644)
-        or die "Could not tie $IDIR/index_fn: $!\n";
+    tie (%IDF,  AnyDBM_File, $IDIR_idf,   O_RDONLY, 0644)
+        or die "Could not tie $IDIR_idf: $!\n";
+    tie (%FN,   AnyDBM_File, $IDIR_fn,   O_RDONLY, 0644)
+        or die "Could not tie $IDIR_fn: $!\n";
     &search(@ARGV);
     untie %IF;
     untie %IDF;
@@ -203,19 +224,24 @@
 }

 sub wanted {
-    my $fns = $name;
+#FA
+   my $fns = File::Spec->abs2rel($name,$prefix);
+#FA    my $fns = $name;

     if ($name eq $man3direxp) {
         $prune = 1;
     }
-    $fns =~ s:$prefix/::;
+#FA    $fns =~ s:$prefix/::;
     return if $SEEN{$fns};
     return unless -f $_;
     if ($name =~ /man|bin|\.(pod|pm)$/) {
-        if (!/(~|,v)$/) {
+#FA again?
+#FA index uses sysopen;
+#        if (!/(~|,v)$/) {
             $did = $FN{'last'}++;
             $SEEN{$fns} = &index($name, $fns, $did);
-        }
+#FA XXX may need some backout code if index fails?
+#        }
     }
 }

@@ -227,7 +253,9 @@
     my $maxtf = 0;
     my $pod = ($fns =~ /\.pod|man/);

-    open(IN, "<$fn") || warn "Could not open $fn: $!\n", return (0);
+
+#FA use sysopen because open is magic.
+    sysopen(IN, $fn, O_RDONLY) || warn "Could not open $fn: $!\n", return (0);
     while ($line = <IN>) {
         if ($line =~ /^=head/) {
             $pod = 1;

• Perlindex port for win32 by franka
• Re: Perlindex port for win32 by Slaven Rezic