#!perl -w # fill_macperl_help.plx # pudge@pobox.com, Friday, March 5, 1999 use DB_File; use File::Copy; use File::Find; use strict; use vars qw($MPD $CWD %DATA %MPH %POD); $MPD = $ENV{MACPERL}; my $file = "${MPD}MacPerl Help"; # data stored in Help file, a DBM my $oldf = "${MPD}Docs:MacPerl Help.old"; unless (-e "${MPD}Docs:") { mkdir("${MPD}Docs:", 0755) or die $!; } unless (-e $oldf) { # copy if copy does not exist copy($file, $oldf) or die $!; } tie(my %MPH, 'DB_File', "${MPD}MacPerl Help", O_RDWR, 0644) or die $!; for $CWD ("${MPD}lib:", "${MPD}pod:", "${MPD}site_perl:") { local %DATA; find(\&get_pods, $CWD); set_pods(); if ($CWD eq "${MPD}pod:") { use Data::Dumper; %POD = %DATA; foreach (keys %POD) { if ($MPH{' MENU'} =~ /$_/) { delete $POD{$_}; } else { print "$_\n"; my $foo = $POD{$_}; $foo =~ s|pod/||; $foo =~ s/\.pod//; open(F, "$CWD$_") or die "Can't open `$_': $!"; 1 while !~ /=head1\s+NAME/; ; =~ /.*-+\s*([^()\n]+)/; $POD{$_} = ucfirst($1) . " ($foo)\tpod:$POD{$_}"; } } } } # fix pod menu items to have name of file in menu item # comment out if you don't want it $MPH{' MENU'} =~ s|^([^()]+?)\t(.*/((?:mac)?perl[^/]*)\.pod)$|$1 ($3)\t$2|mg; $MPH{' MENU'} =~ s|^(Various\t!.*?\n)(?=\n)|$1 . join("\n", sort values %POD) . "\n"|ems; #print $MPH{' MENU'}; untie(%MPH); MacPerl::Quit(2); # quit MacPerl app, important ... quit Shuck manually, too sub get_pods { return unless /\.p(od|m)$/; my($dir, $name) = ($File::Find::dir, $File::Find::name); (my $pod = $name) =~ s/^$CWD//; # get name of file $pod =~ s/:/::/g; # (relative to $CWD) (my $new = $name) =~ s/^$MPD//; # get path to file $new =~ tr|:|/|; # (relative to $MPD) $pod =~ s/^Mac::Glue::glues::/Mac::Glue::/; # special case $DATA{$pod} = $new; # save name in temp hash } sub set_pods { # this is in a separate directory to make sure # that pod overrides pm. for my $pod (sort keys %DATA) { (my $new = $DATA{$pod}) =~ tr|:|/|; $pod =~ s/\.p(od|m)$//; $MPH{$pod} = "pod:$new"; } } __END__