Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!swrinde!ucsd!ucbvax!unisoft!seer!bll
From: bll@seer.UUCP (Brad Lanam)
Newsgroups: comp.lang.perl
Subject: Tom Christiansen's man program no longer works with pl28
Summary: unable to find entry in database.
Keywords: perl pl28 man xenix
Message-ID: <578@seer.UUCP>
Date: 5 Sep 90 03:05:18 GMT
Organization: Brad Lanam  Alamo, CA
Lines: 128


    I just brought perl up to patchlevel 28, and everything except
Tom Christiansen's man program seems to work.  It can't seem to find
anything in the dbm database.  I rebuilt the database, but that didn't
help.  He uses those eval things...  I can't figure out how to print
out what is in the dbm array.

    Has anyone else had this problem?
    I'm running Xenix 2.3.2.

    Thanx
    -- Brad

--
Until the next disk seek...
   -- Brad Lanam    ...!uunet!{seeker|unisoft}!seer!bll    bll@seer.uucp
--

    The pertinent sections:

sub fetch {
    local($key,$root) = @_;
    local(%recursed);

    return $dbmopened{$root}
	? &quick_fetch($key,$dbm{$root})
	: &slow_fetch($key,$root);
}

sub quick_fetch {
    local($key,$array) = @_;
    local(@retlist) = ();
    local(@tmplist) = ();
    local($_, $entry);

#############  this line doesn't find a thing ##########

    return @retlist unless $entry = eval "\$$array".'{$key};';

    if ($@) { chop $@; die "bad eval: $@"; }

    @tmplist = split(/\002/, $entry);
    for (@tmplist) {
	if (/\001/) {
	    push(@retlist, $_);
	} else {
	    push(@retlist, &quick_fetch($_,$array))
		unless $recursed{$_}++;
	# explain and diction are near duplicate man pages referencing
	# each other, requiring this check.  one should be removed
	}
    }
    return @retlist;
}

# --------------------------------------------------------------------------
sub find_files {
    local($target) = @_;
    local($root, $entry);
    local(@retlist) = ();
    local(@tmplist) = ();
    local(@entries) = ();
    # globals: $vars, $called_before, %dbm

    $vars = 'dbm00';

    if (!$hard_way && !$called_before++) {
	# generate dbm names
	for $root (@MANPATH) {
	    $dbm{$root} = $vars++; # magic incr
	    $string = "dbmopen($dbm{$root},\"$root/whatis\",0644);";
	    unless (-f "$root/whatis.pag" && eval $string) {
		if ($@) {
		    chop $@;
		    warn "Can't eval $string: $@";
		} else {
		    warn "No dbm file for $root/whatis: $!\n";
		}
		$status = 1;
		next;
	    }
	    $dbmopened{$root} = 1;
	}
    }

    for $root (@MANPATH) {
	@tmplist = ();
	unless ($dbmopened{$root})  {
	    @tmplist = &slow_fetch($target,$root);
	} else {
	    @entries = &fetch($target,$root);
	    next if $#entries < 0;
	    for $entry (@entries) {
		($cmd, $page, $section, $desc) = split(/\001/, $entry);
		$target =~ s/([^\w])/\\$1/g;
		next unless $cmd =~ /$target/ || $page =~ /$target/;
		($stem) = $section =~ /^(.)/;

	    # Check that it exists
		if (-f "$root/man.$stem/$page.$section") {
		    push(@tmplist,  "$root/man.$stem/$page.$section");
	    # perhaps it is compressed ?
		} elsif (-f "$root/man.$stem.z/$page.$section") {
		    push(@tmplist,  "$root/man.$stem.z/$page.$section");
		} elsif (-f "$root/man.$stem/$page.$section.z") {
		    push(@tmplist,  "$root/man.$stem/$page.$section.z");
	    # perhaps a strange section (i.e. 1m)?
		} elsif (-f "$root/man.$section/$page.$section") {
		    push(@tmplist,  "$root/man.$section/$page.$section");
	    # perhaps a strange section (i.e. 1m) AND compressed?
		} elsif (-f "$root/man.$section.z/$page.$section") {
		    push(@tmplist,  "$root/man.$section.z/$page.$section");
		} elsif (-f "$root/man.$section/$page.$section.z") {
		    push(@tmplist,  "$root/man.$section/$page.$section.z");
		} else {
		    printf STDERR "%s: %s.%s has disappeared from %s/man%s\n",
				    $program, $page, $section, $root, $stem;
		    last;
		}
	    }
	}
	push(@retlist, sort bysection @tmplist);
    }
    return &trimdups(@retlist);
}
-- 
Until the next disk seek...
   -- Brad Lanam    ...!uunet!{seeker|unisoft}!seer!bll    bll@seer.uucp