Path: utzoo!mnetor!uunet!lll-winken!lll-tis!ames!mailrus!tut.cis.ohio-state.edu!bloom-beacon!oberon!sdcrdcf!otto!convex!authorplaceholder
From: tchrist@convex.UUCP
Newsgroups: comp.sources.d
Subject: Re: How are YOU using perl?
Message-ID: <90400003@convex>
Date: 6 Apr 88 17:39:00 GMT
References: <720@hadron.UUCP>
Lines: 230
Nf-ID: #R:hadron.UUCP:-72000:convex:90400003:000:6683
Nf-From: convex.UUCP!tchrist    Apr  6 12:39:00 1988


/* Written  3:23 pm  Apr  5, 1988 by klr@hadron.Sun.COM in convex:comp.sources.d */
/* ---------- "How are YOU using perl?" ---------- */
Which would be an appropriate news group for the discussion of uses of
Larry Wall's outstanding "perl" program?  I would be intersted in
learning what uses you are putting it to, and what kind of tricks have
been developed.  I am also interested in seeing how the "format"
statement has been used.  

Thanks in advance,
Kurt
/* End of text from convex:comp.sources.d */

I can't help with the format statement, but I do use perl quite a bit.
I'll supply two potentially useful scripts after this note.
The first is a script I wrote to get symbolic wait channels out of a ps
that doesn't supply such.  You will want to init $syms to be the name
of a file containing "nm -n /vmunix" output.  This script uses evals, 
subroutines, and both associative and indexed arrays.  Also, when 
have you ever seen a script do a binary search before?

The second will tell give you the synopsis section of all man pages
matching it argument.  It also spots missing cat and/or man pages.
It's also useful in telling whether you've got a local version (manl)
around.

Would anyone who gets this please reply to me by email?  My news
feed (killer) has died, so I'm forced to rely upon notes (ick) and I
suspect that they don't get out to the real world.

thanks,

--tom


Tom Christiansen              {ihnp4,uiucdcs,ut-sally,sun}!convex!tchrist 
Convex Computer Corporation   convex!tchrist@sally.utexas.edu

====================== perl script #1 ================================
#!/usr/local/bin/perl -s
#
#   script to convert wait channels from  long ps output 
#   
#   usage: $0 [-opt] [ var=val ] [ psopts ]
#
#   recognized options are:
#       -verbose    print values for ps and symbols file, also symcounts
#       -long       print sym+offset, rather than just sym+
#       -nm         run nm on vmunix, don't use default place
#
#   useful vars to set are:
#       ps="ps l /vmunix.old |"
#       ps=psfile
#       syms=../lib/oldsyms
#       syms="nm -n /vmunix.old |"
#
#   useful ps opts are:
#       x           - all my procs
#       ax          - all procs
#       axtp4       - all procs on ttyp4

# recognize short versions of options; these were set by the perl -s flag
$verbose |= $v;
$long |= $l;
$nm |= $n;

# process variable assignments  
eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;

# open files
$syms = "/tac/tac/lib/vmsyms" unless $syms;
$vmsyms = $nm ? "nm -n /vmunix|" : $syms;
$ps = "ps wwl" . join(' ',@ARGV) . " |" unless $ps;

if ( $verbose ) {
    printf stderr "ps is \"%s\"\n", $ps;
    printf stderr "vmsyms is \"%s\"\n", $vmsyms;
}

$sub = 's/^(' . ("." x ($cols ? $cols : 80)) . ').*$/$1/;';


die "$0: can't open $vmsyms: $!\n" unless open(symbols,$vmsyms);
die "$0: can't open $ps: $!\n" unless open(ps,$ps);

$| = 1;  # flush 
printf stderr "gathering vm symbols from ``%s''...", $vmsyms if $verbose;

for($ncount = 0;<symbols>;$ncount++) {
    chop;split;
    $names[$ncount] = $_[2];
    $values[$ncount] = hex($_[0]);
} 

printf stderr "found %d of them.\n",$ncount if $verbose;


$_ = <ps>;
s/^........//;
s/(STAT)/    $1/;
s/ (TIME)/$1/;
print;

while(<ps>) {
    s/^........//;
    split(' ');
    if ($_[8] !~ /^[a-f0-9]*$/) {
        s/(..........:)/   $1/;
        eval $sub;
        print;
        next;
    } 
    chop;
    $front = $_;
    $back = $_;
    eval sprintf ('$front =~ s/%s.*//;',$_[8]);
    $front =~ s/ *$/  /;
    eval sprintf ('$back =~ s/.*%s//;',$_[8]);
    $addr = do get_name (hex($_[8]));
    $_ = sprintf( "%s%-10s%s", $front,$addr,$back);
    eval $sub;
    printf "%s\n",$_;
} 

#   do binary search on values[] array to find name.  
#   store hits in hits{} array for quicker subsequent lookups
sub get_name {
    $it = $_[0];
    if ( $hits{$it} ) {
        $hits{$it};
    } else  {
        $left = 0;
        $right = $ncount-1;
        do {
            $targ = int(($left+$right)/2);
            if ( $it < $values[$targ] ) {
                $right = $targ-1;
            } else {
                $left = $targ + 1;
            } 
        } until ( $it == $values[$targ] || $left > $right );
        if ( $it != $values[$targ] ) {
            sprintf(($long||$l) ? "%s+%x" : "%s+", 
                $names[$right],$it-$values[$right]);
        }  else {
            $hits{$it} = $names[$targ];
        }
    }
} 
====================== perl script #2 ================================
#!/usr/local/bin/perl

die "usage: $0 manpage ..." unless $#ARGV > -1;

while ( $arg = shift ) {
    @manfiles = split(' ',`ls /usr/man/man?/$arg.* 2> /dev/null`);
    if ($?) {
        print stderr "no manpages for $arg\n";
        next;
    } 
    @catfiles = split(' ',`ls /usr/man/cat?/$arg.* 2> /dev/null`);
    if ($?) {
        print stderr "no catpages for $arg\n";
        next;
    } 


    if ( $#manfiles > $#catfiles ) {
        print stderr 
            "$0: WARNING! missing cat pages for `$arg' from sections: ";
        @tman = @manfiles;
        while ($shouldbe = shift(@tman)) {
            $found = 0;
            $shouldbe =~ s/^.*\///;
            @tcat = @catfiles;
            while ($reallyis = shift(@tcat)) {
                $reallyis =~ s/^.*\///;
                $found = 1 if ( $shouldbe eq $reallyis );
            }
            if ( ! $found ) {
                $shouldbe =~ s/.*\.//;
                print stderr "$shouldbe ";
            }
        }
        print stderr "\n";
    }


    while ( $file = shift(@catfiles) ) {
        if ( ! open(page,$file) ) {
            print stderr "couldn't open $file for read\n";
            next;
        } 
        if ( ! $opened ) {
            $opened++;
            die "can't open ul" unless open (ul, "|ul");
            select(ul);
            $| = 1;
        }
        $base = $file;
        $base =~ s/.*\.//;
        print ",$arg($base):";

        $gotname = 0;
        while ( ($_ = <page>) !~ /SYNOPSIS/ ) { 
            if (/NAME/) {
                $snarfed = 0;
                while (( $_ = <page> ) !~ /^\n/) {
                    chop;
                    chop if /-$/;
                    if (! $snarfed ) {
                        s/[^-]*-//;
                        $snarfed ++;
                    } else {
                        s/^[    ]*//;
                    } 
                    printf "%s", $_;
                }
            } 
        }
        print "\n+";

        while ( ($_ = <page>) !~ /^[A-Z]/ ) {
            next if /INTRODUCTION/;
            last if /DESCRIPTION/;
            print; 
        } 
        close page;
    }
}
close ul if $opened;