Database Programming with Perl #!/usr/bin/perl use strict; print "\nSaid the Llama to the Lama:\n"; my (@Llama, %answers, @llama, @questions) = map{ print;$_ }(); die "seeking a llama to share pipe!\n" unless $Llama[0]=~/Find/; print "\nSaid the Lama to the Llama:\n"; my$karma=0 ;for ( @Llama ){chomp; ; chomp; s/Fi/Fou/;s/−/−−/; ;/ /; my ( $lama, $llama ) = ($‘,$’); s/ //g for( $lama , $llama); $|=0;push @questions,$llama unless $llama=~ /^$/ ; push @llama,# $lama unless $lama=~ /^$/} %answers = map { $_ , 0, scalar reverse( split // ) ,0 }@questions;my @karma=llama( @llama);my @dharma = llama(map { ( ’ ’) x $_ . $llama[$_]. (’ ’) x (1* $#llama −$_)}(0..$#llama)); my @lama=map{$a = $_;;;;; s/( *)(\w+)( *)/$3$2$1/; $a}@dharma; my %find = (lama => \@llama,dharma =>\@karma,karma =>\@dharma ,llama=> \@lama); sub llama{map{$|++; my $grazing= $_ ;join( ’’, map{ ( split //,$_[ $_ ]) [$grazing] } (0..$#_ ))}(0.. ( length($_[0])−1))}sub dharma{my @llama = @{$_[0]} ;[map{s/[a−z]/\*/g;; ; $_}@llama ] };; my %llama= map{$_,dharma($find{$_}) } ( keys %find );; sub karma { my $reasons=shift ;; ; ; my @answers = @{ $find{ "$reasons" } };; for my $questions (keys%answers){next if $answers{ $questions }; study $questions;for (0.. $#answers ) { if ( $answers[ $_]=~/$questions/){my($soul ,$seeks , $to_know )=($‘,$’ ,$&) ;s/\w/\*/g for ($seeks, $to_know, $soul);$llama{ $reasons} −>[$_]=$soul . $questions .$seeks;$karma ++;$answers{ $questions} ++ ; $answers{ reverse( split//,$to_know)}++ }}}};for(keys %find){ karma($_ )};
[email protected] =map{$a= $_;$a=~s/./\*/g;$a} (@llama); for my $karma(keys %llama){ $llama {$karma}=[ llama( @{$llama{$karma}})] if $karma=~/.{5}/ ;for(0 .. $#{$llama{$karma}}){ $llama{$karma}−>[$_] =~s/ //g;
[email protected] =split//, $dali[$_];my @lAma= split//,$llama{$karma}−>[$_];$dali[$_]= join(’’,map{($lAma[$_] ne ’*’) ? $lAma[$_]:$Lama[$_]}(0..$#lAma));}}my @answer=map { s/(.)/$1 /g ;s/\*/ /g; ($_,’ ’x(length($_)))}(@dali);my($llama,$lama)=sort($#questions, $#answer) ; for (0..$lama) {print $answer[$_]," ",$questions[$_],"\n" } Jacinta Richardson Paul Fenwick Database Programming with Perl by Jacinta Richardson and Paul Fenwick Copyright © 2005-2007 Jacinta Richardson Copyright © 2005-2007 Paul Fenwick Copyright © 2005-2007 Perl Training Australia Cover artwork Copyright(c) 2001 by Frank Booth. Used with permission. Conventions used throughout this text are based upon the conventions used in the Netizen training ma