#!/usr/bin/perl -w

#
# mkprevnext
# $Id: mkprevnext,v 1.22 2007/02/23 05:15:17 johnh Exp $
#
# Copyright (C) 1994-1996,2012  Free Software Foundation, Inc.
# 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;
# }