[Date Prev][Date Next][Thread Prev][Thread Next]
[Search]
[Date Index]
[Thread Index]
[MacPerl] fill_macperl_help.plx revisited
Maybe Vicky would like to add this to the contributions archive? :)
#!perl -w
# fill_macperl_help_rev.plx
# original 'fill_macperl_help.plx'
# by Chris Nandor
# pudge@pobox.com, Friday, March 5, 1999
# revisited and revised by
# Peter Hartmann
# hphartmann@arcormail.de, Sunday, September 4, 1999
# From Chris' original posting
# "I got tired of not having my MacPerl modules and docs installed into
# pod and site_perl in my MacPerl Help file for use by Shuck. So I
# wrote this. It copies your old MacPerl Help file to the Docs directory
# (creating it if necessary), then runs through lib, pod, and site_perl
# in succession. You might not like the ordering I use, or you might
# have other folders to add, so adjust it to suit your needs."
# Which is what I did :)
# The new version...
# € adds two new submenus for the modules in the lib and site_perl
# folders
# € rejects .pm files that come without a pod documentation
# € puts the http links in a submenu at the bottom of the original menu
# and adds links to macperl.com, the MacPerl mailing list search site,
# and MacPerl - Power and Ease
# € it backups the original menu to safely allow multiple runs, whenever
# something new is installed
# € quits Shuck, too, even if it wasn't running at all...
# € cleans up redundant code
# € adds a couple of comments, since I initially had difficulties to
# understand what was going on in the original ;)
# CAUTION!
# I suggest that you work on a virgin help file, i.e. the backup in
# the Docs folder if you used Chris' version before with the line
#
# $MPH{' MENU'} =~
# s|^(.*)\t(.*/((?:mac)?perl[^/]*)\.pod)$|$1 ($3)\t$2|mg;
#
# not commented out. You will definitely run into trouble otherwise.
#
# The present version will not cause any problems with multiple runs
# since it uses the backuped version of the menu, provided the first
# run of this script was done on the default MacPerl Help file.
# No responsibility taken. Use at own risk.
# Bug reports and modfications welcome.
use DB_File;
use File::Copy;
use File::Find;
use Mac::AppleEvents::Simple;
use strict;
use vars qw($MPD $CWD %DATA %MPH @libpod @sppod $new $temp);
$MPD = $ENV{MACPERL};
my $file = "${MPD}MacPerl Help"; # data stored in Help file, a DBM
my $oldf = "${MPD}Docs:MacPerl Help.old";
my $OLDLINKS = <<OLDENDTAG;
MacPerl Homepage\thttp://www.iis.ee.ethz.ch/~neeri/macintosh/perl.html
The MacPerl Pages (PTF)\thttp://www.ptf.com/macperl/
OLDENDTAG
my $NEWLINKS = <<NEWENDTAG;
MacPerl Links\t!
MacPerl Homepage\thttp://www.iis.ee.ethz.ch/~neeri/macintosh/perl.html
The MacPerl Pages (PTF)\thttp://www.ptf.com/macperl/
MacPerl.com\thttp://www.macperl.com
Search MacPerl Mailing Lists\thttp://bumppo.net/search/macperl.html
MacPerl - Power and Ease\thttp://www.macperl.com/ptf_book/\n
NEWENDTAG
unless (-e "${MPD}Docs:") {
mkdir("${MPD}Docs:", 0755) or die $!;
}
unless (-e $oldf) { # backup help database if backup does not exist
copy($file, $oldf) or die $!;
}
# tie database to a hash
tie(my %MPH, 'DB_File', $file, O_RDWR, 0644) or die $!;
# search lib, pod, and site_perl folders
# pod found later will override those found earlier
for $CWD ("${MPD}lib:", "${MPD}pod:", "${MPD}site_perl:") {
find(\&get_pods, $CWD);
}
set_pods();
# build the new submenus from the info retrieved
my $MENU = "Lib Modules\t!\n";
$MENU .= join("\n", sort {uc($a) cmp uc($b)} @libpod) . "\n\n";
$MENU .= "Site_Perl Modules\t!\n";
$MENU .= join("\n", sort {uc($a) cmp uc($b)} @sppod) . "\n\n";
# if there is no backup of the virgin menu in store
if (!exists $MPH{' OLDMENU'}){
# assume the active menu is unaltered and back it up
$temp = $MPH{' OLDMENU'} = $MPH{' MENU'};
} else {
# assume the active menu was altered by a previous run
# and restore the backup
$temp = $MPH{' OLDMENU'};
}
# set the new pod submenus
$temp =~ s/(^Perl FAQ\t!$)/$MENU$1/m;
# set the new http links submenu
# note the \Q - hadn't seen that before...
$temp =~ s/\Q$OLDLINKS/$NEWLINKS/;
# fix pod menu items to have name of file in menu item
# comment out if you don't want it
# In the original version adds a new instance of the file name everytime
# it is run. Now, since the original menu is backuped, no problem.
$temp =~ s|^(.*)\t(.*/((?:mac)?perl[^/]*)\.pod)$|$1 ($3)\t$2|mg;
# I don't know why but this has to be done directly before untieing
# if I do more than one =~ or = on $MPH{' MENU'} consecutively,
# I get an uninitialized value error (!?)
# Cost me a couple of hours to find the culprit. Still don't know
# what happens...
$MPH{' MENU'} = $temp;
untie(%MPH);
do_event(qw/aevt quit …uck/); #quit Shuck; not really nice, though
MacPerl::Quit(2); # quit MacPerl app, too
# this handler checks a folder for .pod or .pm files
# and keeps a temporary database of lookup terms and relative paths
# which will be used for constucting pod URLs later
sub get_pods {
#only accept .pod or pm
return unless /\.p(od|m)$/;
my $name = $File::Find::name; # get path to the file
# get name of file (relative to $CWD)
(my $pod = $name) =~ s/^$CWD//;
# bring it ito the package FOLDER::MODULE format
# but .pod or .pm is still appended
$pod =~ s/:/::/g;
# get path to file (relative to $MPH)
(my $new = $name) =~ s/^$MPD//;
# save relative path to $MPH in temp hash
$DATA{$pod} = $new;
}
# this handler checks the temporary database for items to use in
# the new submenus and populates the MacPerl help database
# with new entries for cmd-click or cmd-H lookups
sub set_pods {
# I don't think the sort is really necessary
for my $pod (sort keys %DATA) {
# get the relative path for each lookup term but left in
# for nicer results when printing
local $new = $DATA{$pod};
# only handle .pm for the menu
if ($new =~ /\.pm$/){
# these already have their own submenu
next if ($new =~ /^lib:Mac:/i);
# does this .pm contain any pod? If not, we don't want it
next unless check_pm("${MPD}$new");
# remove the suffix from the lookup term
$pod =~ s/\.pm$//;
# translate delimiter for use in pod URL
$new =~ tr|:|/|;
# optionally print what we got here
# print "$pod\n$new\n";
# push menu items of the form 'lookup term\tpod:PODURL'
# in lists according to their origin
if ($new =~ m|^lib/|){push (@libpod, "$pod\tpod:$new")}
if ($new =~ m|^site_perl/|){push (@sppod, "$pod\tpod:$new")}
} else {
# we have a .pod here
$pod =~ s/\.pod$//;
$new =~ tr|:|/|;
# optionally print what we got here
# print "$pod\n$new\n";
}
# put lookup term and pod URL into the MacPerl help database
$MPH{$pod} = "pod:$new";
}
}
# this handler checks if a module file contains any pod
# since we don't want the menu populated with dead links
sub check_pm {
my $testfile = shift;
# open the file in question for reading
open(TESTFILE, $testfile) or die "Can't open $testfile: $!";
while (<TESTFILE>){
# if there is a header tag somewhere, assume it contains pod
if (/^=HEAD1\s/i){
close TESTFILE;
return 1; # found pod
}
}
close TESTFILE;
return 0; # no pod in this file
}
__END__
__Peter Hartmann ________
mailto:hphartmann@arcormail.de
===== Want to unsubscribe from this list?
===== Send mail with body "unsubscribe" to macperl-request@macperl.org