The Perl Journal One-Liners

TPJ One-Liner #40

A name game.
<$1$2 $1$2 $1o $1$2 / Bonana-Fanna-Fo-F$2 / 
Fe Fi Mo M$2 / $1$2!>i;

Courtesy Sean M. Burke

TPJ One-Liner #41

Extracting balanced parentheses from a string
use strict
              ;sub                  pars
            {my(                     $l,$r
          )=map{                       "\Q$_"
        }split//                        ,shift;
      my(@s,@r                            ,$i,$o,
     $v);for(                             split/([
    $l$r])/,                                shift){
    /$l/and                                $s[++$o]=
   ++$i;for                                $v(1..$o)#
   {$r[$v].=                              $_ if$s[$v]
    >0}/$r/and                            $s[(grep##
     $s[$_]==                            $i,0..$#s)
      [0]]=-$i         ,--$i<0&&        last;}($i=
        shift)?        wantarray       ?@r[grep
          -$s[$_       ]==$i,0..       $#s]:$r
            [$i]:      splice@r,      1;}$,
              ="\n"     ;print       pars
                 (@      ARGV       )#

pars('()', "(123 (456) (789) 0)") 

gives you the parenthesized substrings in order of appearance:
(123 (456) (789) 0),(456),(789)
pars('()', "(123 (456) (789) 0)", 2)

in a list context gives you list of substrings, opened on level 2:

in scalar context gives you the second substring:

Courtesy Paul Clinger

TPJ One-Liner #42

Extract unique elements from a list given a key function
sub unique (&@) {
  my($c,%hash) = shift;
  grep { not $hash{&$c}++ } @_

@list = unique { $_       } @list;  
# Remove duplicate strings from @list.

@obj  = unique { $_->name } @obj;   
# Only include one object for 
# for each name.

Courtesy Don Schwarz

TPJ One-Liner #43

Seven "Magic Cards." Have a friend think of a number from 1 to 100. Give them cards one at a time and ask if their number is on the card. Mentally sum the first digits of each card with a "yes" answer. Go into trance, say the magic word "Ultrix!" and announce their number. Known to win bar bets.
for $a(0..6){$b=1;for $c(1..100){if($c&2**$a){printf
"%3d ",$c;print"\n"if!($b++%10)}}print"\n\n\n"}

Courtesy Bill Huston