[comp.lang.perl] Data Structures

rbj@uunet.UU.NET (Root Boy Jim) (01/29/91)

Someome awhile back mentioned wanting arrays of filehandles.

A more general question is "what about arrays of arrays"?
For example, how would I implement trees without this?

I know I can build strings and eval them. Kluge.
And I can look up a Knuth algorithm for simulating
them with numeric indices, ala Fortran. No dice.
Finally, I can build string representations of
how they would look in lisp and manipulate them
with LISP-oid functions. But I want primitives in perl.

Arrays are often referred to as lists in the manual.
However, imagine how useful LISP would be without
the capability to nest them.
-- 

	Root Boy Jim Cottrell <rbj@uunet.uu.net>
	Close the gap of the dark year in between

tchrist@convex.COM (Tom Christiansen) (01/29/91)

From the keyboard of rbj@uunet.UU.NET (Root Boy Jim):
:Someome awhile back mentioned wanting arrays of filehandles.

:A more general question is "what about arrays of arrays"?

The FAQ gives both eval the string and deref the *ref method.

:For example, how would I implement trees without this?

Tree can be implemented using assoc arrays.  Your pointers are symbolic,
not literal.  I've used this to make both simply N-way trees as well as
generalized graph traversal programs.  There is a nice example of doing
this on page 53 of the Perl book.

My programs read data in the form

	boss peon

where these are typically either user names or machine names.  (A machine
is another's boss if the hosts.equiv or /.rhosts let's you in without a
password.)   I use this to generate org charts, security penetration
paths, and other interesting things.  It even does "find shortest route"
and "find first route" graph traversals.

The programs follow.  You'll have to munge the pathnames, plus give decent
data, to get anything interesting out of them.  One thing to do is 
gather a bunch of hosts.equiv files and append the current hostname
to each line, and then cat these together as the data file.

I think this could have been done using only one set of pointers, but for
some reason I used two:  one for the boss pointers, another for the peon
pointers.

Read the NOTES section for the boss man page.

--tom

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
#	boss
#	boss.1
#	netwalk
# This archive created: Mon Jan 28 16:50:50 1991
export PATH; PATH=/bin:/usr/bin:$PATH
echo shar: "extracting 'boss'" '(3659 characters)'
if test -f 'boss'
then
	echo shar: "will not over-write existing file 'boss'"
else
sed 's/^	X//' << \SHAR_EOF > 'boss'
	X#!/usr/bin/perl 
	X#
	X# boss, peon - who works for whom
	X#
	X# tom christiansen, 25 Oct
	X#
	X# given a data file with (peon boss) pairs, 
	X# fetch peons of a given boss, or boss of a
	X# given peon boss.  recurse all the way with -r,
	X# limit depth with -2, -3, etc.  
	X
	X
	X$DATA = "/usr/spool/globdata/etc/reports_to";
	X
	Xsub usage {
	X    print STDERR <<EOM;
	Xusage: $0 [-$opts] [user ...]
	X	-#	recursion depth
	X	-r 	recurse all the way
	X	-b	boss
	X	-e	empl (also -p)
	X	-a	list all
	X	-s	sort
	X	-v	verbose
	X	-d	debug
	X	-B	rebuild databases
	X	-F db	alternate database
	XEOM
	X    exit 2;
	X} 
	X
	XMAIN: {
	X
	X    do 'getopts.pl' || die "can't do getopts.pl: " . ($@? $@ : $!); 
	X    $opts = 'vasbBepdr123456789F:';
	X    &Getopts($opts) || &usage;
	X
	X    if ($opt_r) {
	X	$maxdepth = 100;
	X    } else {
	X	for $i (reverse 1..9) {
	X	    if (eval "defined \$opt_$i") {
	X		$maxdepth = $i;
	X		last;
	X	    } 
	X	} 
	X    }
	X
	X    $sort = $opt_s;
	X    $debug = $opt_d;
	X    $verbose = $opt_v;
	X    $listall = $opt_a;
	X
	X    $want = 'boss' if $opt_b;
	X    $want = 'peon' if $opt_p || $opt_e; 
	X    $rebuild = $opt_B;
	X
	X    if ($0 =~ m#/?boss[^/]*$#) {
	X	$want = 'boss';
	X    } elsif ($0 =~ m#/?(empl|peon)[^/]*$#) {
	X	$want = 'peon';
	X    } elsif (!$want) {
	X	warn "$0: neither boss nor empl specified\n";
	X	&usage;
	X    } 
	X
	X    if ($listall && @ARGV) {
	X	warn "$0: explicit list conflict with request to list all\n";
	X	&usage;
	X    } 
	X
	X    $DATA = $opt_F || $ENV{'peersfile'} || $DATA;
	X
	X    &init;
	X
	X    *which = eval "*$want";	# create alias
	X
	X    if ($listall) {
	X	@ARGV = sort grep (!/ /,keys %which);
	X	$verbose = 1;
	X    } 
	X
	X    for $target (@ARGV) {
	X	 local(%duplicate);
	X	 if (!defined $boss{$target} && !defined $peon{$target}) {
	X	    warn "$0: $target unknown\n";
	X	    next;
	X	 } 
	X	 @list = &traverse($target);
	X	 @list = sort @list if $sort;
	X	 print "$target: " if $verbose;
	X	 print join(' ',@list) if @list;
	X	 print "\n" if $verbose || @list;
	X    } 
	X
	X    exit 0;
	X}; # end main
	X
	Xsub traverse {
	X    local(%seen, @who, $user, @newlist, @tmplist);
	X
	X    $depth++;
	X
	X    @who = @_;
	X
	X    foreach $user (@who) {
	X	next if $duplicate{$user}++;
	X
	X	@tmplist = split(' ',$which{$user});
	X	print "$depth $want of $user is <@tmplist>\n"
	X	    if $debug && @tmplist;
	X
	X	push (@tmplist, &traverse(@tmplist)) if $maxdepth > $depth;
	X	push(@newlist,@tmplist);
	X    } 
	X
	X    print "$depth returning $want of <@who> as <@newlist>\n" 
	X	if $debug && @newlist && @who == 1;
	X
	X    $depth--;
	X
	X    return grep(!$seen{$_}++,@newlist);
	X} 
	X
	Xsub rebuild {
	X    warn "$0: rebuilding DB from $DATA\n";
	X    &opendb('writing');
	X    %boss = %peon = ();
	X    open DATA || die "can't open $DATA: $!";
	X    while (<DATA>) {
	X	split;
	X	next if $#_ > 1;
	X	($peon, $boss) = @_;
	X	$peon{$boss} .= ' ' . $peon;
	X	$boss{$peon} .= ' ' . $boss;
	X    } 
	X    &closedb;
	X}
	X
	Xsub init {
	X
	X    local($data_age, $base, $page);
	X    
	X    $data_age = &age($DATA);
	X    $bage     = &age("$DATA.boss.pag");
	X    $page     = &age("$DATA.peon.pag");
	X
	X    if ($rebuild || ($bage < $data_age) || ($page < $data_age)) {
	X	&rebuild;
	X    }
	X    &opendb('reading');
	X} 
	X
	Xsub closedb {
	X    dbmclose(boss) || die "$0: can't dbmclose boss: $!\n";
	X    dbmclose(peon) || die "$0: can't dbmclose peon: $!\n";
	X} 
	X
	Xsub opendb {
	X    local($mode) = @_;
	X
	X    do _opendb('boss');
	X    do _opendb('peon');
	X} 
	X
	Xsub _opendb {
	X    local($what) = @_;
	X    local($file) = $DATA . '.' . $what;
	X
	X    if ($mode eq 'writing') {
	X	for $ext ('pag', 'dir') {
	X	    open(FILE, ">$file.$ext") || die "can't write $file.$ext\n";
	X	    close FILE;
	X	}
	X    } 
	X
	X    eval <<EO_EVAL;
	X	dbmopen($what, "$file", \$mode eq 'writing' ? 0644 : 0444) 
	X	    || die "$0: can't dbmopen $file for \$mode: \$!\n";
	XEO_EVAL
	X    die $@ if $@;
	X
	X} 
	X
	Xsub age { 
	X    return (stat($_[0]))[9];
	X}
SHAR_EOF
if test 3659 -ne "`wc -c < 'boss'`"
then
	echo shar: "error transmitting 'boss'" '(should have been 3659 characters)'
fi
chmod 775 'boss'
fi
echo shar: "extracting 'boss.1'" '(5967 characters)'
if test -f 'boss.1'
then
	echo shar: "will not over-write existing file 'boss.1'"
else
sed 's/^	X//' << \SHAR_EOF > 'boss.1'
	X.TH BOSS 1L "Convex Local"
	X.de T           \" switch to typewriter font
	X.ft TA          \" probably want CW if you don't have TA font
	X..
	X.\"
	X.de TY          \" put $1 in typewriter font
	X.if t .T
	X.\"	.if n ``\c
	X\\$1\c
	X.if t .ft P
	X.\"	.if n \&''\c
	X\\$2
	X..
	X.\"
	X.de M           \" man page reference
	X\\fI\\$1\\fR\\|(\\$2\)\\$3
	X..
	X.de CL		\" indent arg in typewriter font
	X.if t .sp .5
	X.ti +5n
	X.TY "% \\$1"
	X.sp
	X.ne 3
	X..
	X.SH NAME
	Xboss, peon \- consult employee reporting structure
	X.SH SYNOPSIS
	X[
	X.B boss 
	X| 
	X.B peon 
	X]
	X[
	X.B \-vasbBepdr
	X] [ \-n
	X] [
	X.B \-F 
	X.I file
	X] [
	X.I user 
	X\&...]
	X.SH DESCRIPTION
	XThese are really hard links to just one program.  This 
	Xprogram consults a 
	Xdatabase 
	Xgenerate from the Human Resources
	Xcontaining information about who works for whom (and vice versa) and prints out 
	Xthe corresponding information for the specified users.  When invoked as 
	Xboss,
	Xit reports whom they work for.  When invoked as
	Xpeon,
	Xit report who works for them.
	X.PP
	XThis data is stored in a 
	X.M dbm 3X
	Xdatabase that is automatically
	Xrebuilt when out of date.
	X.PP
	XSee the NOTES section for other interesting uses of this program.
	X.SH OPTIONS
	X.TP 
	X.B \-v
	XList the name of the user with his boss/peon.
	X.TP
	X.B \-r
	XRecurse on all users
	X.TP 
	X\-n
	XLimit recursion depth to level 
	X.I n
	Xwhere 
	X.I n
	Xis between 1 and 9.
	X.TP 
	X.B \-a
	XList all bosses or peons in the entire database.
	XAssumes
	X.B \-v
	Xoption.
	X.TP 
	X.B \-s 
	XSort all users' return values; useful for getting
	Xalphabetized list of your peons. This doesn't make
	Xsense with the 
	X.B \-r
	Xoption though.
	X.TP 
	X.B \-d
	XPrint debugging information at each level 
	Xof recursion.  This is fun to watch.
	X.TP 
	X.BI \-F file
	XConsult an alternate database file.
	X.TP
	X.B \-B
	XRebuild database even if it's not out of date.
	X.TP 
	X.B \-b
	XAssume 
	X.I boss
	Xmode.
	X.TP 
	X.B \-p
	XAssume 
	X.I peon
	Xmode.  
	X.TP 
	X.B \-e
	XSame as \-p.
	X.SH EXAMPLES
	XTo find out everyone who works for you:
	X.CL "peon $USER"
	XTo mail all your direct reports:
	X.CL "mail `peon $USER`"
	XTo see who all your bosses are up the ladder:
	X.CL "boss -r $USER"
	XTo see who your peers are:
	X.CL  "peon `boss $USER`"
	XTo see who Frank's first two levels of 
	Xreports are:
	X.CL "peon -2 marshall"
	XTo see all of Engineering (and enjoy watching the recursion):
	X.CL "peon -r marshall"
	XTo count how many people work for Bob:
	X.CL "peon -r paluck | wc -w"
	XTo list all managers (everyone with peons):
	X.CL "peon -a"
	XTo see the bosses of everyone logged in:
	X.CL "boss -v `u | tr ' ' '\e12' | uniq`"
	X.SH ENVIRONMENT
	XThe 
	X.B $peersfile
	Xenvironment variable (note lower case) can be set
	Xto the path of an alternate data file.  The default
	Xpath is /usr/spool/globdata/etc/reports_to if
	Xnot set.
	X.SH FILES
	X.nf
	X.ta \w'/usr/spool/globdata/etc          'u
	X/usr/spool/globdata/etc	directory where HR files reside
	Xreports_to	text version of database
	Xreports_to.boss.{pag,dir}	dbm version of boss pointers
	Xreports_to.peon.{pag,dir}	dbm version of peon pointers
	X.fi
	X.SH "SEE ALSO"
	X.M perl 1 ,
	X.M dbm 3X ,
	X.M netwalk 8L
	X.SH DIAGNOSTICS
	XBesides those messages issued by the debugging flag,
	Xthe following diagnostics may occur:
	X.sp
	X.TY "can't do getopts.pl"
	X.in +5n
	XThe 
	X.I perl
	Xlibrary file was missing.
	X.in -5n
	X.sp
	X.TY "Usage: ...."
	X.in +5n
	XAn incorrect option was invoked.
	X.in -5n
	X.sp
	X.TY "neither boss nor peon specified"
	X.in +5n
	Xargv[0] was neither boss nor peon, nor was 
	Xa mode option specified.
	X.in -5n
	X.sp
	X.TY "explicit list conflict with request to list all"
	X.in +5n
	XYou asked for all users with the
	X.B \-a
	Xflag, but gave a list of them on the command line as well.
	X.in -5n
	X.sp
	X.TY "username unknown"
	X.in +5n
	XThe username specified was not in the database.
	X.in -5n
	X.sp 
	X.TY "rebuilding DB from file"
	X.in +5n
	XThe database was out of date with respect to the 
	Xtextfile, so it is automatically rebuilt.  
	X.in -5n
	X.sp
	X.TY "can't open file: error message"
	X.in +5n
	XThe indicated file could not be opened for
	Xthe indicated reason.
	X.in -5n
	X.sp 
	XA few other obvious error messages may occur
	Xif an I/O error is encountered when opening
	Xor creating the database.
	X.SH RESTRICTIONS
	XThe only way to get a usage message is by passing
	Xa bad option.  This is because things like 
	X.TY  "peon `peon $USER`"
	Xshould be allowed to return nothing with no failure
	Xif you have no peons with peons of their own.
	X.PP
	XThis program is written in the 
	X.I perl
	Xprogramming language, so 
	X.I perl
	Xmust be installed on your system for it to run.
	X.PP
	XThe names of certain famous personages are hardwired
	Xinto this man page.  This is ok, as we don't expect
	Xthem to be leaving any time real soon now.
	X.SH BUGS
	XThe database is only as right as what HR gives us.
	XIf there is an error concerning the reporting structure,
	Xyou should contact HR about the discrepancy.
	X.PP
	XAs dumped by HR, the database is sometimes out 
	Xof whack.  Running 
	X.TY "boss -B"
	Xwill fix this.  It's much faster to run it on 
	X.I globhost
	Xhowever.
	X.SH NOTES
	XThis is actually a general-purpose, graph-navigation program with
	Xproper checks for cycles in the graph.  
	XThe database is generated from a text file consisting of 
	Xline with ordered pairs of names of the form ``peon boss''.
	XThis means several 
	Xthings.  There is no reason a person can't be his own boss:
	Xlook at Bob Paluck, for example.  Furthermore, any user
	Xcan have multiple bosses and multiple peons.
	X.PP
	XMore interestingly,
	Xthis also means that you can store keep own database
	Xof graph data for arbitrary purposes.  Another very
	Xuseful application 
	Xis to keep a data file consisting of pairs of hosts.
	XThe first entry in the line, the peon, would the host that 
	Xtrusts the second host.  These could be generated
	Xfrom 
	X.I hosts.equiv
	Xor 
	X.I .rhosts
	Xfiles.  The
	X.M netwalk 8L
	Xprogram can be used to traverse this graph to find
	Xsecurity holes and other intersting things.
	X.PP
	XNo one should take offense at the use of the words ``boss''
	Xand ``peon''.  They simply represent the two directional links
	Xin a graph structure, of which the employee org chart is but
	Xone example.
	X.SH AUTHOR
	XTom Christiansen
	X.I <tchrist@convex.com>
SHAR_EOF
if test 5967 -ne "`wc -c < 'boss.1'`"
then
	echo shar: "error transmitting 'boss.1'" '(should have been 5967 characters)'
fi
chmod 664 'boss.1'
fi
echo shar: "extracting 'netwalk'" '(2917 characters)'
if test -f 'netwalk'
then
	echo shar: "will not over-write existing file 'netwalk'"
else
sed 's/^	X//' << \SHAR_EOF > 'netwalk'
	X#!/usr/local/bin/perl
	X
	Xsub usage {
	X    print STDERR <<EOM;
	Xusage: $0 [-asmv] [-F dbase] from to ...
	X	-s	shortest path only (else first found)
	X	-v	verbosely list nodes visited and pathlenth
	X	-a 	is for all hosts
	X	-m	compute all paths between listed nodes
	X	-q	quiet; print nothing if no match
	X	-F db	alternate database
	XEOM
	X    exit 1;
	X} 
	X
	Xdo 'getopts.pl' || die "can't do getopts.pl: ".($@?$@:$!);
	X
	X&Getopts('vmqasF:') || &usage;
	X
	X($debug, $allflag, $shortest, $many, $quiet) = 
	X    ($opt_v, $opt_a, $opt_s, $opt_m, $opt_q);
	X
	X&usage if @ARGV != 2 && !$many && !$allflag;
	X&usage if @ARGV == 1 && $many;
	X
	X$DATA = $opt_F || $ENV{'peersfile'} || 'hpeers';
	X
	Xdbmopen(peon,"$DATA.peon",0444) || die "can't dbmopen $DATA.peon: $!";
	Xdbmopen(boss,"$DATA.boss",0444) || die "can't dbmopen $DATA.boss: $!";
	X
	Xif ($allflag) {
	X    warn "-a assumes all nodes\n" if @ARGV;
	X    @srcs = @dsts = keys %peon;
	X} elsif ($many) {
	X    @srcs = @dsts = @ARGV;
	X} else {
	X    @srcs = shift;
	X    @dsts = shift;
	X} 
	X
	X
	X$| = 1;
	X
	Xfor $src (@srcs) {
	X    for $dst (@dsts) {
	X	local(%seen, @list, $visits, $depth, $node_min, $best_min);
	X	$best_min = 999;
	X
	X	next if $src eq $dst;
	X
	X	$ot = &time;
	X	($ou, $os) = times;
	X
	X	@list = &findpath($src, $dst);
	X
	X	if (@list) {
	X	    print join(' -> ', @list), "\n";
	X	    &timing if $debug;
	X	} elsif (!$quiet) {
	X	    print "$src cannot reach $dst\n";
	X	    &timing if $debug;
	X	} 
	X    } 
	X} 
	X
	X# for milliseconds; otherwise would use built-in time.
	Xsub time {
	X    local($SYS_gettimeofday, $timeval, $timezone, $sec, $usec);
	X
	X    $SYS_gettimeofday = 116;  # should be from sys/syscalls.h 
	X
	X    $timeval = $timezone = ("\0" x 4) x 2;
	X
	X    syscall($SYS_gettimeofday, $timeval, $timezone) 
	X	 && die "gettimeofday failed: $!";
	X
	X    ($sec, $usec) = unpack("L2", $timeval);
	X    return $sec +  $usec/1e6;
	X} 
	X
	Xsub timing {
	X    local($t, $u, $s);
	X    $t = &time;
	X    ($u, $s) = times;
	X
	X    printf "[ visited %4d nodes, hops = %2d, time = %5.3fr %5.3fu %5.3fs ]\n\n",
	X		$visits, $#list > 0 ? $#list : 0, $t - $ot, $u - $ou, $s - $os;
	X} 
	X
	Xsub findpath {
	X    local($src,$dst) = @_;
	X
	X    local($_, @targ, @kids, $child);
	X    local(%isaw, @best_path);
	X    local($node_min) = 999;
	X
	X    $visits++;
	X
	X    if ( (++$depth > $best_min && $shortest) ||
	X	     !defined $boss{$dst} || $seen{$src}++ ) {
	X	--$depth;
	X	return ();
	X    } 
	X
	X    if ($src eq $dst) {
	X        --$depth;
	X	return ($dst);
	X    } 
	X
	X    @kids = split(' ',$peon{$src});
	X
	X    if (@targ = grep($_ eq $dst,@kids)) {
	X        --$depth;
	X	return ($src, $targ[0]);
	X    }
	X
	X    for $child (@kids) {
	X
	X	%isaw = %seen;
	X	@path = &findpath($child,$dst);
	X	%seen = %isaw;
	X
	X	$seen{$child}++;
	X
	X	if (@path) {
	X	   if ($shortest) {
	X	       if (@path < $node_min) {
	X		    $best_min = $depth + @path;
	X		    @best_path = ($src, @path);
	X		    $node_min = @best_path;
	X	       } 
	X	   } else {
	X	       --$depth;
	X	       return ($src, @path);
	X	    }
	X	} 
	X    }
	X
	X    --$depth;
	X    return $shortest ? @best_path : ();
	X} 
SHAR_EOF
if test 2917 -ne "`wc -c < 'netwalk'`"
then
	echo shar: "error transmitting 'netwalk'" '(should have been 2917 characters)'
fi
chmod 775 'netwalk'
fi
exit 0
#	End of shell archive
--
"Hey, did you hear Stallman has replaced /vmunix with /vmunix.el?  Now
 he can finally have the whole O/S built-in to his editor like he
 always wanted!" --me (Tom Christiansen <tchrist@convex.com>)