The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/local/bin/new/perl -w

use strict;

use File::Find;
use File::Copy;
use blib;
my %file;
my @files;
my %cat;
my @cat;        

sub category
{
 my ($cat,$file) = @_;
 unless (exists $cat{$cat})
  {
   $cat{$cat} = []; 
   push(@cat,$cat); 
  }
 if (defined $file)
  {
   if (exists $file{$file})
    {
     if ($file{$file} ne $cat)
      {
       warn "$file already in $file{$file} not $cat\n";
      }
    }
   else
    {
     $file{$file} = $cat;
     push(@{$cat{$cat}},$file) 
    }
  }
}

@ARGV = ("Tk.cmd") if (!@ARGV && -r "Tk.cmd");

if (@ARGV)
 {                    
  my $sec;
  while (<>)
   {
    if (/^beginBookmark\s+'(.*)'\s*$/i)
     { 
      $sec = $1;
      category($sec);
     }
    elsif (/^file\s+(\S+)/)
     {                  
      my $file = $1;                   
      if (-f $file)
       {
        category($sec,$file);
       }
      else
       {
        warn "Cannot find $file\n";
       }
     }
   }
 }

find(sub { 
          $File::Find::prune = 1 if /\b(blib|doc|pod[3n])\b/;
          push(@files,$File::Find::name) if /\.(pod|pm)$/
         }, 
     '..');

foreach my $file (sort @files)
 {
  my $seen = 0;
  my $pod  = 0;
  open(F,"$file") || die "Cannot open $file:$!";
  while (<F>)
   {
    if (/^=for\s+category\s+(.*)$/)
     {
      category($1,$file);
      $seen = 1;
      last;
     }
    if (/^=head1\s*NAME/)
     {
      $pod = 1;
     }
   }
  category('Other Documents',$file) if ($pod && !$seen);
  if (!$pod && $file =~ /\.pm$/)
   {

   }
  close(F);
 }

if (-f "Tk.cmd")
 {
  copy("Tk.cmd","Tk.cmd.old");
 }

system("p4",'edit',"Tk.cmd") if (-e 'Tk.cmd' && !-w 'Tk.cmd');                                

open(CMD,">Tk.cmd") || die "Cannot open Tk.cmd:$!";


eval { require Tk };

print CMD <<END;
# This is a command file for pod2ps
# 
cover true                 
booktitle 'Perl/Tk Reference'
release 'Version Tk$Tk::VERSION'
author 'Nick Ing-Simmons'
linkbox off color
pagesize a4
output tkman.ps 
path .
END

foreach my $cat (@cat)
 {
  print CMD "beginBookmark '$cat'\n";
  foreach my $file (@{$cat{$cat}})
   {
    print CMD "file $file '' '$cat' ''\n";
   }
  print CMD "endBookmark\n";
 }

print CMD <<END;
ToC 1
END