#!/usr/bin/perl -w
use strict;

use constant EXTENSION => '.bak';

my %OUT = ( 'OUT' => 1 );
my %SRC = ( 'src' => 1, 'PRE' => 1 );

my %TYPE = (
  'Output' => \%OUT,
  'Output = Source' => \%OUT,
  'Output = Command' => \%OUT,
  'Source' => \%SRC,
  'Command' => \%SRC
);

my $oldargv;
my $nr;
my $index_formalpara;
my $index_title;
my @line;
my $prefix;
my $postfix;

sub get_location($)
{
  my $file_name = shift;

  return $1 if ($file_name =~ m/^&config\.([A-Z]+);/);
  return $1 if ($file_name =~ m/^(src|etc)\//);
  return undef;
}

sub new_file()
{
  my $backup = $ARGV . EXTENSION;
  unlink $backup;
  rename($ARGV, $backup);
  open(ARGVOUT, ">$ARGV");
  select(ARGVOUT);
  $oldargv = $ARGV;

  $nr = -1;
  $index_title = undef;
  undef @line;
}

LINE: while(<>)
{
  if (!defined($oldargv))
  {
    new_file;
  }
  elsif ($ARGV ne $oldargv)
  {
    print @line;
    new_file;
  }
  $line[++$nr] = $_;
  if (m/^\s*<formalpara[\s>]/)
  {
    $index_formalpara = $nr;
    next LINE;
  }
  if (m/^(\s*<title>\s*)([^<:]+):\s*([^<]*)(<\/title>.*)/)
  {
    if (defined($index_formalpara) && $nr - 1 == $index_formalpara)
    {
      $index_title = $nr;
      $prefix = $1 . $2;
      my $type_name = $2;
      my $file_name = $3;
      $postfix = $4;

      my $type = $TYPE{$type_name};
      if (!defined($type))
      {
	printf STDERR "%s (%d): Invalid file type [%s]\n",
	  $ARGV, $nr, $type_name;
      }
      else
      {
        my $location = get_location($file_name);
	if (!defined($location))
	{
          printf STDERR "%s (%d): Invalid location [%s]\n",
	    $ARGV, $nr, $file_name;
	}
	elsif (!defined($$type{$location}))
	{
          printf STDERR "%s (%d): Invalid location [%s] for type [%s]\n",
	    $ARGV, $nr, $location, $type_name;
        }
      }

      # printf STDERR "%s (%d): [%s] [%s]\n", $ARGV, $nr, $prefix, $postfix;
      next LINE if (!($prefix =~ m/\s-\s/));
    }
    # printf STDERR "%s (%d): %s", $ARGV, $nr, $line[$nr];
    $index_title = undef;
    next LINE;
  }
  if (m/fileref="\.\.\/([^"]+)"/ && defined($index_title))
  {
    my $file = $1;
    $file =~ s/\.\.\///g;
    $line[$index_title] = "$prefix: $file$postfix\n";
    $index_title = undef;
  }
}
print @line;
