Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!sun-barr!newstop!texsun!vector!egsner!mic!convex!convex.com!tchrist From: tchrist@convex.com (Tom Christiansen) Newsgroups: comp.lang.perl Subject: Diffs from last month's FAQ posting Message-ID: <109692@convex.convex.com> Date: 2 Dec 90 04:37:23 GMT Sender: usenet@convex.com Reply-To: tchrist@convex.com (Tom Christiansen) Organization: Convex Computer Corp, Richardson, TX Lines: 271 1c1 < [Last changed: $Date: 90/11/06 15:00:03 $ by $Author: tchrist $] --- > [Last changed: $Date: 90/12/01 22:32:09 $ by $Author: tchrist $] 43a44,47 > 22) How can I manipulate fixed-record-length files? > 23) How can I make a file handle local to a subroutine? > 24) How can I extract just the unique elements of an array? > 25) How can I call alarm() from Perl? 169c173,174 < if you have problems, post to comp.lang.perl about them. --- > if you have problems, post to comp.lang.perl about them if you don't > find any clues in the README file. 238a244,246 > You should also be aware that while in the shells, embedding > single quotes will protect variables, in Perl, you'll need > to escape the dollar signs. 239a248,251 > Shell: foo=`cmd 'safe $dollar'` > Perl: $foo=`cmd 'safe \$dollar'`; > > 273a286,289 > Two of Perl's strongest points are its associative arrays and > its regular expressions. They can dramatically speed up your > code when applied properly. > 326c342 < expensive . If the variable to be interpolated doesn't change over the --- > expensive. If the variable to be interpolated doesn't change over the 361a378 > } 384,386c401,404 < you can't get one, *AND* you have GNU emacs working on your machine, < you might take its unexec() function and patch your version of < Perl to call unexec() instead of abort(). --- > you can't get one, *AND* you have a GNU emacs working on your machine > that can clone itself, then you might try taking its unexec() > function and compiling Perl with -DUNEXEC, which will make Perl > call unexec() instead of abort(). 443,444c461,463 < You can use the multi-dimensional array emulation of $a{'x','y','z'}, < or you can make an array of names of arrays and eval it. --- > Remember that Perl isn't about nested data structures, but rather flat > ones, so if you're trying to do this, you may be going about it the > wrong way. You might try parallel arrays with common subscripts. 445a465,468 > But if you're bound and determined, you can use the multi-dimensional > array emulation of $a{'x','y','z'}, or you can make an array of names > of arrays and eval it. > 460a484,487 > You could take a look at recurse.pl package posted by Felix > Lee , which lets you > simulate vectors and tables (lists and associative arrays) > by using type glob references and some pretty serious wizardry. 461a489 > 507,509d534 < At the risk of deadlock, it is possible to use a fork, two pipe < calls, and an exec to manually set up the two-way pipe. < 511c536,537 < avoid the deadlock problem. --- > avoid the deadlock problem. See the expect.pl package released > by Randal Schwartz for ways to do this. 512a539,542 > At the risk of deadlock, it is theoretically possible to use a > fork, two pipe calls, and an exec to manually set up the two-way > pipe. (BSD system may use socketpair() in place of the two pipes, > but this is not as portable.) 513a544,617 > Here's one example of this that assumes it's going to talk to > something like adb, both writing to it and reading from it. This > is presumably safe because you "know" that commands like adb will > read a line at a time and output a line at a time. Programs like > sort that read their entire input stream first, however, are quite > apt to cause deadlock. > > Use this way: > > require 'open2.pl'; > $child = &open2(RDR,WTR,"some cmd to run and its args"); > > Unqualified filehandles will be interpreteed in their caller's package, > although &open2 lives in its open package (to protect its state data). > It returns the child process's pid if successful, and generally > dies if unsuccessful. You may wish to change the dies to warnings, > or trap the call in an eval. You should also flush STDOUT before > calling this. > > # &open2: tom christiasen, > # > # usage: $pid = open2('rdr', 'wtr', 'some cmd and args'); > # > # spawn the given $cmd and connect $rdr for > # reading and $wtr for writing. return pid > # of child, or 0 on failure. > # > # WARNING: this is dangerous, as you may block forever > # unless you are very careful. > # > # $wtr is left unbuffered. > # > # abort program if > # rdr or wtr are null > # pipe or fork or exec fails > > package open2; > $fh = 'FHOPEN000'; # package static in case called more than once > > sub main'open2 { > local($kidpid); > local($dad_rdr, $dad_wtr, $cmd) = @_; > > $dad_rdr ne '' || die "open2: rdr should not be null"; > $dad_wtr ne '' || die "open2: wtr should not be null"; > > # force unqualified filehandles into callers' package > local($package) = caller; > $dad_rdr =~ s/^[^']+$/$package'$&/; > $dad_wtr =~ s/^[^']+$/$package'$&/; > > local($kid_rdr) = ++$fh; > local($kid_wtr) = ++$fh; > > pipe($dad_rdr, $kid_wtr) || die "open2: pipe 1 failed: $!"; > pipe($kid_rdr, $dad_wtr) || die "open2: pipe 2 failed: $!"; > > if (($kidpid = fork) < 0) { > die "open2: fork failed: $!"; > } elsif ($kidpid == 0) { > close $dad_rdr; close $dad_wtr; > open(STDIN, ">&$kid_rdr"); > open(STDOUT, ">&$kid_wtr"); > print STDERR "execing $cmd\n"; > exec $cmd; > die "open2: exec of $cmd failed"; > } > close $kid_rdr; close $kid_wtr; > select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe > $kidpid; > } > 1; # so require is happy > > 552a657,774 > > > 22) How can I manipulate fixed-record-length files? > > The most efficient way is using unpack and unpack. This is faster > than using substr. Here is a sample chunk of code to break up and > put back together again some fixed-format input lines, in this > case, from ps. > > # sample input line: > # 15158 p5 T 0:00 perl /mnt/tchrist/scripts/now-what > $ps_t = 'A6 A4 A7 A5 A*'; > open(PS, "ps|"); > while () { > ($pid, $tt, $stat, $time, $command) = unpack($ps_t, $_); > for $var ('pid', 'tt', 'stat', 'time', 'command' ) { > print "$var: <", eval "\$$var", ">\n"; > } > print 'line=', pack($ps_t, $pid, $tt, $stat, $time, $command), "\n"; > } > > 23) How can I make a file handle local to a subroutine? > > You use the type-globbing *VAR notation. Here is some code to > cat an include file, calling itself recursively on nested local > include files (i.e. those with include "file" not include ): > > sub cat_include { > local($name) = @_; > local(*FILE); > local($_); > > warn "\n"; > if (!open (FILE, $name)) { > warn "can't open $name: $!\n"; > return; > } > while () { > if (/^#\s*include "([^"]*)"/) { > &cat_include($1); > } else { > print; > } > } > close FILE; > } > > > > 24) How can I extract just the unique elements of an array? > > There are several possible ways, depending on whether the > array is ordered and you wish to preserve the ordering. > > a) If @in is sorted, and you want @out to be sorted: > > $prev = 'nonesuch'; > @out = grep($_ ne $prev && (($prev) = $_), @in); > > This is nice in that it doesn't use much extra memory, > simulating uniq's behavior of removing only adjacent > duplicates. > > b) If you don't know whether @in is sorted: > > undef %saw; > @out = grep(!$saw{$_}++, @in); > > c) Like (b), but @in contains only small integers: > > @out = grep(!$saw[$_]++, @in); > > d) A way to do (b) without any loops or greps: > > undef %saw; > @saw{@in} = (); > @out = sort keys %saw; # remove sort if undesired > > e) Like (d), but @in contains only small positive integers: > > undef @ary; > @ary[@in] = @in; > @out = sort @ary; > > > 25) How can I call alarm() from Perl? > > It's due out as a built-in in an up-coming patch. Until > then, if you have itimers on your system, you can use this. > It takes a floating-point number representing how long > to delay until you get the SIGALRM, and returns a floating- > point number representing how much time was left in the > old timer, if any. Note that the C function uses integers, > but this one doesn't mind fractional numbers. > > # alarm; send me a SIGALRM in this many seconds (fractions ok) > # tom christiansen > sub alarm { > local($ticks) = @_; > local($in_timer,$out_timer); > local($isecs, $iusecs, $secs, $usecs); > > local($SYS_setitimer) = 83; # require syscall.ph > local($ITIMER_REAL) = 0; # require sys/time.ph > local($itimer_t) = 'L4'; # confirm with sys/time.h > > $secs = int($ticks); > $usecs = ($ticks - $secs) * 1e6; > > $out_timer = pack($itimer_t,0,0,0,0); > $in_timer = pack($itimer_t,0,0,$secs,$usecs); > > syscall($SYS_setitimer, $ITIMER_REAL, $in_timer, $out_timer) > && die "alarm: setitimer syscall failed: $!"; > > ($isecs, $iusecs, $secs, $usecs) = unpack($itimer_t,$out_timer); > return $secs + ($usecs/1e6); > } Brought to you by Super Global Mega Corp .com