--- /dev/null
+#!/usr/bin/perl -w
+
+#
+# mkprevnext
+# $Id: mkprevnext,v 1.22 2007/02/23 05:15:17 johnh Exp $
+#
+# Copyright (C) 1994-1996 by John Heidemann.
+# Comments to <johnh@isi.edu>.
+#
+# This file is under the Gnu Public License.
+#
+
+sub usage {
+ print STDOUT <<END;
+usage: $0 [-X] indexfile [FILE...]
+ Update the prev and next pointers in [file...]
+ based on indexfile.
+
+ We assume that indexfile is sorted.
+
+Option: -X means read the filesname from stdin rather than the command line.
+
+To update prev/next pointers do:
+ ./mkprevnext ./index 9?????
+END
+ exit 1
+}
+
+require 5.000;
+
+
+my($files_from_stdin) = undef;
+if ($ARGV[0] eq '-X') {
+ $files_from_stdin = 1;
+ shift @ARGV;
+}
+&usage if ($#ARGV < 0);
+
+%direction_delta = split(/ +/, 'prev -1 next 1');
+
+
+#
+# read the index
+#
+&read_index(shift);
+
+foreach (@ARGV) {
+ &reindex_file($_);
+};
+if ($files_from_stdin) {
+ while (<STDIN>) {
+ chomp;
+ &reindex_file($_);
+ }
+};
+
+exit 0;
+
+#
+# Read the index file.
+# Build links of in $index{"$file#$subject","$prevnext"}.
+# Assumes that the index is sorted.
+#
+sub read_index {
+ local($indexfile) = @_;
+ local ($file, $subject);
+ local (@old_sort_order, @sort_order);
+ local($filesubject, $prevfilesubject) = ('', '');
+
+ if (-z $indexfile) {
+ warn("$0: aborted. $indexfile is zero length.\n");
+ exit 0;
+ };
+ open(INDEX,"<$indexfile") || die("Cannot open $indexfile");
+ binmode INDEX;
+ ($prevurl, $prevfile, $prevsubject) = ("", "", "");
+ @sort_order = ("") x 3;
+ while (<INDEX>) {
+ chop if (/\n$/);
+ $url = $_;
+ ($filehead, $file, $subject) = /^(.*)\/([^#]*)\#(.*)$/;
+ # Sigh, have to fold things to upper case since sort only
+ # does that, not to lower case.
+ $filehead = uc($filehead);
+ $file = uc($file);
+ $subject = uc($subject);
+ $filesubject = "$file#$subject";
+
+ # verification
+ die ("Bad index entry: $_") if (!defined($file) || !defined($subject));
+ @old_sort_order = @sort_order;
+ @sort_order = ($subject, $filehead, $file);
+ foreach $i (0..$#sort_order) {
+ last if ($sort_order[$i] gt $old_sort_order[$i]);
+ die ("Index is not in sorted order (entries $i).\n\t$sort_order[$i]\n\t$old_sort_order[$i]\n")
+ if ($sort_order[$i] lt $old_sort_order[$i])
+ };
+
+ # Skip repeated entries.
+ if ($filesubject eq $prevfilesubject) {
+ $count_i{$filesubject}++;
+ next;
+ };
+
+ # Record the links.
+ $url_i{$filesubject} = $url;
+ if ($prevsubject eq $subject) {
+ $link_i{$filesubject,'prev'} = $prevfilesubject;
+ $link_i{$prevfilesubject,'next'} = $filesubject;
+ } else {
+ $link_i{$filesubject,'prev'} = 'none';
+ $link_i{$prevfilesubject,'next'} = 'none';
+ };
+ # Count entries per-file.
+ $count_i{$filesubject} = 1;
+ ($prevurl, $prevfile, $prevsubject, $prevfilesubject) =
+ ($url, $file, $subject, $filesubject);
+ };
+ # Close the last pointer and hacks for null pointers.
+ $link_i{$prevfilesubject,'next'} = 'none';
+ $url_i{'none'} = 'none';
+ $count_i{'none'} = 1;
+ close (INDEX);
+}
+
+
+#
+# Go through a particular file
+# and update its prev/next pointers.
+#
+sub reindex_file {
+ local ($fullfile) = @_;
+ local (@data, $change, $mode, $subject);
+ local ($mode_lookheader, $mode_expectdash, $mode_expectprev, $mode_expectnext) = (0..99);
+ local(@olddata);
+ local (@data, $data, $error);
+ local ($subject_length, $found_expected_label);
+ local (%subject_count) = ();
+
+ local($file) = ($fullfile);
+ $file =~ s@.*/([^/]+)@$1@; # basename
+
+ open(FILE,"<$fullfile") || die("Cannot open $file");
+ @olddata = <FILE>;
+ close(FILE);
+ # $file = uc($file);
+ $change = 0;
+ $mode = $mode_lookheader;
+ #
+ # Scan through the file, looking for headers.
+ # There is some context senstivity using $mode.
+ #
+ foreach (@olddata) {
+ if ($mode == $mode_lookheader) {
+ if (!/^(\* .*)$/) {
+ # skip simple data
+ push (@data, $_);
+ next;
+ } else {
+ # header
+ $subject = uc($1);
+ $filesubject = "$file#$subject";
+ push (@data, $_);
+ $subject_length = length($_) - 1;
+ $subject_count{$subject}++;
+ $mode = $mode_expectdash;
+ next;
+ };
+ } elsif ($mode == $mode_expectdash) {
+ if (/^\-+$/) {
+ # Check and fix dash length.
+ if (length($_)-1 != $subject_length) {
+ $_ = ("-" x $subject_length) . "\n";
+ $change++;
+ };
+ push (@data, $_);
+ $mode = $mode_expectprev;
+ next;
+ } else {
+ # warn("warning: subject <$subject> missing dashes in $file.\n") if (!/^\*/);
+ push (@data, $_);
+ $mode = $mode_lookheader;
+ next;
+ };
+ } elsif ($mode == $mode_expectprev) {
+ $found_expected_label = (/^prev: \<(.*)\>$/) ? 1 : 0;
+ push (@data, &new_link('prev', $file, $subject, $subject_count{$subject}));
+ $change++ if (!$found_expected_label ||
+ ($found_expected_label && $data[$#data] ne $_));
+ $mode = $mode_expectnext;
+ if ($found_expected_label) { next; } else { redo; };
+ } elsif ($mode == $mode_expectnext) {
+ $found_expected_label = (/^next: \<(.*)\>$/) ? 1 : 0;
+ push (@data, &new_link('next', $file, $subject, $subject_count{$subject}));
+ $change++ if (!$found_expected_label ||
+ ($found_expected_label && $data[$#data] ne $_));
+ $mode = $mode_lookheader;
+ if ($found_expected_label) { next; } else { redo; };
+ } else {
+ die ("bad mode: $mode");
+ };
+ die("end of loop reached unexpectedly.");
+ };
+ close (FILE);
+
+ return if (!$change);
+
+ warn("Updating file $file.\n") if ($verbose);
+ warn(" writing backup file ${fullfile}~.\n") if ($verbose);
+ open(BFILE, ">$fullfile~") || die("Cannot write backup file $fullfile~.\n");
+ $data = join("", @olddata);
+ $error = syswrite(BFILE, $data, length($data));
+ die("Backup file failed.\n") unless ($error = length($data));
+
+ open (FILE, ">$fullfile") || goto abort;
+ $data = join("", @data);
+ $error = syswrite(FILE, $data, length($data));
+ goto abort unless ($error == length($data));
+ close (FILE) || goto abort;
+ return;
+
+abort:
+ close (FILE); # ignore error
+ warn ("Aborting changes to file $file.\n");
+ rename("$fullfile~", "$fullfile") ||
+ die("Could not back-out changes to $file. Old data saved in $file~.");
+ return;
+}
+
+
+sub new_link {
+ local ($direction, $file, $subject, $srcposition) = @_;
+ local($filesubject) = "$file#$subject";
+ local($other_count);
+
+ # First handle ignorance.
+ return &format_url($direction,'none')
+ if (!defined($link_i{$filesubject,$direction}));
+
+ # See if we're in the same file.
+ if (($direction eq 'prev' && $srcposition > 1) ||
+ ($direction eq 'next' && $srcposition < $count_i{$filesubject})) {
+
+ return &format_url($direction, $url_i{$filesubject},
+ $srcposition + $direction_delta{$direction});
+
+ } else {
+ # In a different file. Does the other file have multple entries?
+ $other_count = $count_i{ $link_i{$filesubject,$direction} };
+ if ($other_count != 1) {
+
+ return &format_url($direction,
+ $url_i{ $link_i{$filesubject,$direction} },
+ ( $direction eq 'prev' ? $other_count : 1));
+
+ } else {
+ # Different file with only one entry.
+ return &format_url($direction,
+ $url_i{ $link_i{$filesubject,$direction} } );
+ };
+ };
+}
+
+sub format_url {
+ local($direction, $url, $count) = @_;
+ $url =~ s/\#\*/#$count*/ if (defined($count));
+ return "$direction: <$url>\n";
+}
+
+## substutite for "uc", if you want to back-port to perl4.
+# sub tolower {
+# local ($s) = @_;
+# $s =~ tr/a-z/A-Z/;
+# return $s;
+# }