#! /usr/local/bin/perl

# genindex [key] regexp pod-file

# This utility looks for a "=for genindex ..." in the given pod file and replaces
# the next paragraph with a newly generated index of all "=item regexp ..."  with
# the part matching regexp becoming the index item.

# Optional key is perl code that can manipulate $str which is initialized to uc $_[0].
# The result determines the sort order and the 1st char is the bold caption.

# The =for line should contain the full command, so this regenerates them all:
# rm index; eval "$(fgrep genindex *.pod| cut -d\  -f2-)"
# for f in *.po; do mv $f ${f}d; done

use Pod::Html qw(anchorify);

BEGIN {
    if( @ARGV == 3 ) {
	my $key = shift;
	eval q! sub key { my $str = uc $_[0]; ! . $key . q!; $str } !;
    } else {
	eval q{ sub key { (my $str = uc( $_[0] ) . " $_[0]") =~ tr/A-Za-z0-9? //cd; $str } };
    }
    die $@ if $@;
}

my $re = shift;
my $want_amp = ord( $re ) == ord '&';



chop( my $out = my $in = $ARGV[0] );
open my $fh, '>', $out;
select $fh;

my $base = substr $in,0, -4;

my $lastname;
sub linktag {
    my $txt = $_[0];
    $txt = "I<$txt>" if $want_amp && ord( $txt ) != ord '&';
    $lastname ||= anchorify Pod::Html::fragment_id Pod::Html::depod( $_[0] . $_[1] ), -generate;
    $_[2] ? "L<C<$txt>|$base/$lastname>" : $txt eq $lastname ? "L</$txt>" : "L<$txt|/$lastname>";
}

open INDEX, '>>index';


my( $index, %item, @text );
while( <> ) {
    if( $index ) {
	push @text, $_;
	s/ *X<.+?>//g;
	if( /^=item (?!\*$|\d+\.?$)($re)(.*)$/o ) {
	    $item{key $1} ||= linktag $1, $2;
	    print INDEX key( $1 ) . "\t$base\t" . linktag( $1, $2, 1 ) . "\n";
	} elsif( /./ ) {	# non =item line marks end of series of =item
	    undef $lastname;
	}
    } elsif( /^=for genindex/ ) {
	$index = 1;
	print;
	<>;
	while( <> ) {
	    last if /^$/;
	}
    } else {
	print;
    }
}

my $last;
for( sort keys %item ) {
    my $this = substr $_, 0, 1;
    print !$last ? "\nB<$this:>E<nbsp>" :
	$last ne $this ? ",E<nbsp>\nB<$this:>E<nbsp>" :
	",\n  ";
    $last = $this;
    print $item{$_}#|$_>";
}

print "\n\n", @text;

close;

system "diff -u $in $out"
    or unlink $out;
