[Date Prev][Date Next][Thread Prev][Thread Next]
[Search]
[Date Index]
[Thread Index]
[MacPerl] fill_macperl_help_rev.plx, v. 0.2
Sorry for having to post this again. This version fixes an algorithmic problem that caused .pod contained outside the pod folder in the MacPerl folder to be ignored. Didn't realize that there are .pod files in lib and site_perl, too. Always dropped .pod from hand installed modules into the main pod folder. Which was bad... But thanks to CPAN-Mac, the old memory hog, ... ;)
#!perl -w
# fill_macperl_help_rev.plx
# version 0.2
# original 'fill_macperl_help.plx'
# by Chris Nandor
# pudge@pobox.com, Friday, March 5, 1999
# revisited and revised by
# Peter Hartmann
# hphartmann@arcormail.de, Monday, September 6, 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 ;)
# Changes in Version 0.2
# € fixes an algorithmic problem that caused .pod contained outside
# ${MPD}pod to be ignored
# € Sunday was September *5* :)
# 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, but wait a minute,
# it sorts moduleX.pm before moduleX.pod, so that the latter
# overrides the former
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
# is this one of those that are in the "${MPD}pod" folder
# if so, we don't want it
next if ($new =~ /^pod:/i);
$pod =~ s/\.pod$//;
$new =~ tr|:|/|;
# optionally print what we got here
# print "$pod\n$new\n";
# no need to check the contents: assume .pod contains pod
if ($new =~ m|^lib/|){push (@libpod, "$pod\tpod:$new")}
if ($new =~ m|^site_perl/|){push (@sppod, "$pod\tpod:$new")}
}
# 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