ch13_16.htm

By Tom Christiansen and Nathan Torkington ISBN 1-56592-243-3 First Edition, published August 1998

><A
CLASS="title"
NAME="ch13-chap13_tie_1"
>Tie Example: Make a Hash That Always Appends</A
></H3
><P
CLASS="para"
><A
CLASS="indexterm"
NAME="ch13-idx-1000004692-0"
></A
>The class shown below produces a hash whose keys accumulate in an array.</P
><PRE
CLASS="programlisting"
>#!/usr/bin/perl 
# <A
CLASS="indexterm"
NAME="ch13-idx-1000004713-0"
></A
>appendhash_demo - show magic hash that autoappends
use Tie::AppendHash;
tie %tab, 'Tie::AppendHash';

$tab{beer} = &quot;guinness&quot;;
$tab{food} = &quot;potatoes&quot;;
$tab{food} = &quot;peas&quot;;

while (my($k, $v) = each %tab) {
    print &quot;$k =&gt; [@$v]\n&quot;;
}</PRE
><P
CLASS="para"
>Here is the result:</P
><PRE
CLASS="programlisting"
><B
CLASS="emphasis.bold"
>food =&gt; [potatoes peas]</B
>
<B
CLASS="emphasis.bold"
>beer =&gt; [guinness]</B
></PRE
><P
CLASS="para"
>To make this class easy, we will use the boilerplate hash tying module from the standard distribution, shown in <A
CLASS="xref"
HREF="ch13_16.htm#ch13-15202"
TITLE="Tie::AppendHash"
>Example 13.5</A
>. To do this, we load the Tie::Hash module and then inherit from the Tie::StdHash class. (Yes, those are different names. The file <EM
CLASS="emphasis"
>Tie/Hash.pm</EM
> provides both the Tie::Hash and Tie::StdHash classes, which are slightly different.)</P
><DIV
CLASS="example"
><H4
CLASS="example"
><A
CLASS="title"
NAME="ch13-15202"
>Example 13.5: Tie::AppendHash</A
></H4
><PRE
CLASS="programlisting"
>package Tie::AppendHash;
use strict;
use Tie::Hash;
use Carp;
use vars qw(@ISA);
@ISA = qw(Tie::StdHash);
sub STORE {
    my ($self, $key, $value) = @_;
    push @{$self-&gt;{$key}}, $value;
} 
1;</PRE
></DIV
></DIV
><DIV
CLASS="sect2"
><H3
CLASS="sect2"
><A
CLASS="title"
NAME="ch13-chap13_tie_2"
>Tie Example: Case-Insensitive Hash</A
></H3
><P
CLASS="para"
><A
CLASS="indexterm"
NAME="ch13-idx-1000006808-0"
></A
>Here's a fancier hash tie called Tie::Folded. It provides a hash with case-insensitive keys.</P
><PRE
CLASS="programlisting"
>#!/usr/bin/perl 
# <A
CLASS="indexterm"
NAME="ch13-idx-1000004715-0"
></A
>folded_demo - demo hash that magically folds case
use Tie::Folded;
tie %tab, 'Tie::Folded';

$tab{VILLAIN}  = &quot;big &quot;; 
$tab{herOine}  = &quot;red riding hood&quot;;
$tab{villain} .= &quot;bad wolf&quot;;   

while ( my($k, $v) = each %tab ) {
    print &quot;$k is $v\n&quot;;
}</PRE
><P
CLASS="para"
>The following is the output of this demo program:</P
><PRE
CLASS="programlisting"
><B
CLASS="emphasis.bold"
>heroine is red riding hood</B
>
<B
CLASS="emphasis.bold"
>villain is big bad wolf</B
></PRE
><P
CLASS="para"
>Because we have to trap more accesses, the class in <A
CLASS="xref"
HREF="ch13_16.htm#ch13-20857"
TITLE="Tie::Folded"
>Example 13.6</A
> is slightly more complicated than the one in <A
CLASS="xref"
HREF="ch13_16.htm#ch13-15202"
TITLE="Tie::AppendHash"
>Example 13.5</A
>.</P
><DIV
CLASS="example"
><H4
CLASS="example"
><A
CLASS="title"
NAME="ch13-20857"
>Example 13.6: Tie::Folded</A
></H4
><PRE
CLASS="programlisting"
>package Tie::Folded;
use strict;
use Tie::Hash;
use vars qw(@ISA);
@ISA = qw(Tie::StdHash);
sub STORE {
    my ($self, $key, $value) = @_;
    return $self-&gt;{lc $key} = $value;
    } 
sub FETCH {
    my ($self, $key) = @_;
    return $self-&gt;{lc $key};
} 
sub EXISTS {
    my ($self, $key) = @_;
    return exists $self-&gt;{lc $key};
} 
sub DEFINED {
    my ($self, $key) = @_;
    return defined $self-&gt;{lc $key};
} 
1;<A
CLASS="indexterm"
NAME="ch13-idx-1000006068-0"
></A
></PRE
></DIV
></DIV
><DIV
CLASS="sect2"
><H3
CLASS="sect2"
><A
CLASS="title"
NAME="ch13-chap13_tie_3"
>Tie Example: Hash That Allows Look-Ups by Key or Value</A
></H3
><P
CLASS="para"
>Here is a hash that lets you look up members by key or by value. It does this by having a store method that not only uses the key to store the value, it also uses the value to store the key.</P
><P
CLASS="para"
>Normally there could be a problem if the value being stored were a reference, since you can't normally use a <A
CLASS="indexterm"
NAME="ch13-idx-1000006817-0"
></A
>reference as a key. The standard distribution comes with the Tie::RefHash class that avoids this problem. We'll inherit from it so that we can also avoid this difficulty.</P
><PRE
CLASS="programlisting"
>#!/usr/bin/perl -w
# <A
CLASS="indexterm"
NAME="ch13-idx-1000004717-0"
></A
>revhash_demo - show hash that permits key *or* value lookups
use strict;
use Tie::RevHash;
my %tab;
tie %tab, 'Tie::RevHash';
%tab = qw{
    Red         Rojo
    Blue        Azul
    Green       Verde
};
$tab{EVIL} = [ &quot;No way!&quot;, &quot;Way!!&quot; ];

while ( my($k, $v) = each %tab ) {
    print ref($k) ? &quot;[@$k]&quot; : $k, &quot; =&gt; &quot;,
        ref($v) ? &quot;[@$v]&quot; : $v, &quot;\n&quot;;
} </PRE
><P
CLASS="para"
>When run, <I
CLASS="filename"
>revhash_demo</I
> produces this:</P
><PRE
CLASS="programlisting"
><B
CLASS="emphasis.bold"
>[No way! Way!!] =&gt; EVIL</B
>
<B
CLASS="emphasis.bold"
>EVIL =&gt; [No way! Way!!]</B
>
<B
CLASS="emphasis.bold"
>Blue =&gt; Azul</B
>
<B
CLASS="emphasis.bold"
>Green =&gt; Verde</B
>
<B
CLASS="emphasis.bold"
>Rojo =&gt; Red</B
>
<B
CLASS="emphasis.bold"
>Red =&gt; Rojo</B
>
<B
CLASS="emphasis.bold"
>Azul =&gt; Blue</B
>
<B
CLASS="emphasis.bold"
>Verde =&gt; Green</B
></PRE
><P
CLASS="para"
>The module is shown in <A
CLASS="xref"
HREF="ch13_16.htm#ch13-33223"
TITLE="Tie::RevHash"
>Example 13.7</A
>. Notice how small it is!</P
><DIV
CLASS="example"
><H4
CLASS="example"
><A
CLASS="title"
NAME="ch13-33223"
>Example 13.7: Tie::RevHash</A
></H4
><PRE
CLASS="programlisting"
>package Tie::RevHash;
use Tie::RefHash;
use vars qw(@ISA);
@ISA = qw(Tie::RefHash);
sub STORE {
    my ($self, $key, $value) = @_;
    $self-&gt;SUPER::STORE($key, $value);
    $self-&gt;SUPER::STORE($value, $key);
}

sub DELETE {
    my ($self, $key) = @_;
    my $value = $self-&gt;SUPER::FETCH($key);
    $self-&gt;SUPER::DELETE($key);
    $self-&gt;SUPER::DELETE($value);
}

1;<A
CLASS="indexterm"
NAME="ch13-idx-1000006111-0"
></A
></PRE
></DIV
></DIV
><DIV
CLASS="sect2"
><H3
CLASS="sect2"
><A
CLASS="title"
NAME="ch13-chap13_tie_4"
>Tie Example: Handle That Counts Access</A
></H3
><P
CLASS="para"
><A
CLASS="indexterm"
NAME="ch13-idx-1000004700-0"
></A
>Here's an example of tying a filehandle:</P
><PRE
CLASS="programlisting"
>use Counter;
tie *CH, 'Counter';
while (&lt;CH&gt;) {
    print &quot;Got $_\n&quot;;
} </PRE
><P
CLASS="para"
>When run, that program keeps printing <CODE
CLASS="literal"
>Got</CODE
> <CODE
CLASS="literal"
>1</CODE
>, <CODE
CLASS="literal"
>Got</CODE
> <CODE
CLASS="literal"
>2</CODE
>, and so on until the universe collapses, you hit an interrupt, or your computer reboots, whichever comes first. Its simple implementation is shown in <A
CLASS="xref"
HREF="ch13_16.htm#ch13-36823"
TITLE="Counter"
>Example 13.8</A
>.</P
><DIV
CLASS="example"
><H4
CLASS="example"
><A
CLASS="title"
NAME="ch13-36823"
>Example 13.8: Counter</A
></H4
><PRE
CLASS="programlisting"
>package Counter;
sub TIEHANDLE {
    my $class = shift;
    my $start = shift;
    return bless \$start =&gt; $class;
} 
sub READLINE {
    my $self = shift;
    return ++$$self;
} 
1;</PRE
></DIV
></DIV
><DIV
CLASS="sect2"
><H3
CLASS="sect2"
><A
CLASS="title"
NAME="ch13-chap13_tie_5"
>Tie Example: Multiple Sink Filehandles</A
></H3
><P
CLASS="para"
>Finally, here's an example of a tied handle that implements a <EM
CLASS="emphasis"
>tee</EM
>-like functionality by twinning standard out and standard error:</P
><PRE
CLASS="programlisting"
>use Tie::Tee;
tie *TEE, 'Tie::Tee', *STDOUT, *STDERR;
print TEE &quot;This line goes both places.\n&quot;;</PRE
><P
CLASS="para"
>Or, more elaborately:</P
><PRE
CLASS="programlisting"
>#!/usr/bin/perl
# demo_tietee
use Tie::Tee;
use Symbol;

@handles = (*STDOUT);
for $i ( 1 .. 10 ) {
    push(@handles, $handle = gensym());
    open($handle, &quot;&gt;/tmp/teetest.$i&quot;);
} 

tie *TEE, 'Tie::Tee', @handles;
print TEE &quot;This lines goes many places.\n&quot;;</PRE
><P
CLASS="para"
>The <EM
CLASS="emphasis"
>Tie/Tee.pm</EM
> file is shown in <A
CLASS="xref"
HREF="ch13_16.htm#ch13-36731"
TITLE="Tie::Tee"
>Example 13.9</A
>.</P
><DIV
CLASS="example"
><H4
CLASS="example"
><A
CLASS="title"
NAME="ch13-36731"
>Example 13.9: Tie::Tee</A
></H4
><PRE
CLASS="programlisting"
>package Tie::Tee;

sub TIEHANDLE {
    my $class   = shift;
    my $handles = [@_];

    bless $handles, $class;
    return $handles;
}

sub PRINT {
    my $href = shift;
    my $handle;
    my $success = 0;

    foreach $handle (@$href) {
        $success += print $handle @_;
    }

    return $success == @$href;
}                                     

1;<A
CLASS="indexterm"
NAME="ch13-idx-1000006714-0"
></A
><A
CLASS="indexterm"
NAME="ch13-idx-1000006714-1"
></A
><A
CLASS="indexterm"
NAME="ch13-idx-1000006714-2"
></A
><A
CLASS="indexterm"
NAME="ch13-idx-1000006714-3"
></A
><A
CLASS="indexterm"
NAME="ch13-idx-1000006714-4"
></A
></PRE
></DIV
></DIV
><DIV
CLASS="sect2"
><H3
CLASS="sect2"
><A
CLASS="title"
NAME="ch13-pgfId-1000000533"
>See Also</A
></H3
><P
CLASS="para"
>The <CODE
CLASS="literal"
>tie</CODE
> function in <I
CLASS="filename"
>perlfunc </I
>(1); <I
CLASS="filename"
>perltie </I
>(1); the section on "Using Tied Variables" in <A
CLASS="olink"
HREF="../prog/ch05_01.htm"
>Chapter 5</A
> of <A
CLASS="citetitle"
HREF="../prog/index.htm"
TITLE="Programming Perl"
><CITE
CLASS="citetitle"
>Programming Perl</CITE
></A
></P
></DIV
></DIV
><DIV
CLASS="htmlnav"
><P
></P
><HR
ALIGN="LEFT"
WIDTH="684"
TITLE="footer"><TABLE
WIDTH="684"
BORDER="0"
CELLSPACING="0"
CELLPADDING="0"
><TR
><TD
ALIGN="LEFT"
VALIGN="TOP"
WIDTH="228"
><A
CLASS="sect1"
HREF="ch13_15.htm"
TITLE="13.14. Overloading Operators"
><IMG
SRC="../gifs/txtpreva.gif"
ALT="Previous: 13.14. Overloading Operators"
BORDER="0"></A
></TD
><TD
ALIGN="CENTER"
VALIGN="TOP"
WIDTH="228"
><A
CLASS="book"
HREF="index.htm"
TITLE="Perl Cookbook"
><IMG
SRC="../gifs/txthome.gif"
ALT="Perl Cookbook"
BORDER="0"></A
></TD
><TD
ALIGN="RIGHT"
VALIGN="TOP"
WIDTH="228"
><A
CLASS="chapter"
HREF="ch14_01.htm"
TITLE="14. Database Access"
><IMG
SRC="../gifs/txtnexta.gif"
ALT="Next: 14. Database Access"
BORDER="0"></A
></TD
></TR
><TR
><TD
ALIGN="LEFT"
VALIGN="TOP"
WIDTH="228"
>13.14. Overloading Operators</TD
><TD
ALIGN="CENTER"
VALIGN="TOP"
WIDTH="228"
><A
CLASS="index"
HREF="index/index.htm"
TITLE="Book Index"
><IMG
SRC="../gifs/index.gif"
ALT="Book Index"
BORDER="0"></A
></TD
><TD
ALIGN="RIGHT"
VALIGN="TOP"
WIDTH="228"
>14. Database Access</TD
></TR
></TABLE
><HR
ALIGN="LEFT"
WIDTH="684"
TITLE="footer"><FONT
SIZE="-1"
></DIV<!-- LIBRARY NAV BAR --> <img src="../gifs/smnavbar.gif" usemap="#library-map" border="0" alt="Library Navigation Links"><p> <a href="copyrght.htm">Copyright &copy; 2002</a> O'Reilly &amp; Associates. All rights reserved.</font> </p> <map name="library-map"> <area shape="rect" coords="1,0,85,94" href="../index.htm"><area shape="rect" coords="86,1,178,103" href="../lwp/index.htm"><area shape="rect" coords="180,0,265,103" href="../lperl/index.htm"><area shape="rect" coords="267,0,353,105" href="../perlnut/index.htm"><area shape="rect" coords="354,1,446,115" href="../prog/index.htm"><area shape="rect" coords="448,0,526,132" href="../tk/index.htm"><area shape="rect" coords="528,1,615,119" href="../cookbook/index.htm"><area shape="rect" coords="617,0,690,135" href="../pxml/index.htm"></map> </BODY
></HTML
>