1# Require the version 1.12 of pod2ipf, see
2# ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl/scripts
3use strict;
4
5my @files;
6
7foreach my $dir (qw(. pTk DupName)) {
8  opendir D, $dir or die "opendir $dir: $!";
9  push @files, map "$dir/$_", grep /\.pod$/, readdir D;
10  closedir D or die "closedir $dir: $!";
11}
12
13my %files;
14my %cats;
15my %alias = qw(./option.pod Tk::option ./options.pod Tk::options);
16
17for my $file (@files) {
18  open F, $file or die "open `$file': $!";
19  while (<F>) {
20    next unless /^=for\s+(category|pm)\s*(.*?)\s*$/m;
21    if ($1 eq 'pm') {
22      my $f = $2;
23      warn "Found alias $f for $file\n";
24      $f =~ s,/,::,g;	# Tk/Widget.pm
25      $f =~ s/\.pm$//;
26      $alias{$file} = $f;
27      next;
28    }
29    $cats{$file} = $2;
30  }
31  close F or die "close: $!";
32}
33
34my @known_cats = ( 'Introduction' ,
35		   'Creating and Configuring Widgets',
36		   'Tk Widget Classes',
37		   'Binding Events and Callbacks',
38		   'Tk Image Classes',
39		   'Tix Extensions',
40		   'Derived Widgets',
41		   'Tk Generic Methods',
42		   'Tk Geometry Management',
43		   'User Interaction',
44		   'Popups and Dialogs',
45		   'Implementation',
46		   'Experimental Modules',
47		   'Other Modules and Languages',
48		   'C Programming',
49#		   'Perl/Tk Constructs',
50#		   'Tk Generic Methods',
51#		   'Tk User Interaction',
52#		   'Partially Converted Methods',
53#		   'Tix Extensions',
54#		   'Tk Geometry Management',
55#		   'Tk Selection Handling',
56#		   'Tk Image Classes',
57#		   'Tk Library Procedures',
58#		   'Tk Modules',
59		 );
60my %known_cat;
61
62@known_cat{@known_cats} = (1) x 100;
63foreach my $file (@files) {
64  my $cat = $cats{$file};
65  push @known_cats, $cat unless exists $known_cat{$cat};
66  $known_cat{$cat} = 1;
67  $files{$cat} ||= [];
68  push @{$files{$cat}}, $file;
69}
70
71my @file_args = '--title=Perl/Tk Reference';
72push @file_args, qw(--by-files --nofaqs --debug --about --believe-pod-name);
73for my $cat (@known_cats) {
74  next unless defined $files{$cat};
75  push @file_args, "--section-name=$cat",
76    map {
77      ("--file=$_",
78       ($alias{$_} ? "--alias=$alias{$_}" : ()))
79    } sort @{$files{$cat}};
80}
81
82print STDERR join ' ', 'pod2ipf', @file_args , "\n";
83system 'pod2ipf', @file_args and die "\$?=$?, $!";
84