ch6.htm

《Perl 5 Unreleased》

51              my
$self = shift;<BR>
52&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;confess
&quot;wrong type&quot; unless ref $self;<BR>
53&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my
$value = shift;<BR>
54&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;confess
&quot;Hey dude! We are making this readonly!\n&quot;;<BR>
55&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return
$value;<BR>
56&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
<BR>
57<BR>
58 #<BR>
59 # DESTROY this<BR>
60 # This method will be triggered when the tied variable needs
to be<BR>
61 # destructed. This method can be just empty for most classes
since<BR>
62 # Perl's garbage collection will.<BR>
63 #<BR>
64<BR>
65 sub DESTROY {<BR>
66&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my
$self = shift;<BR>
67&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;confess
&quot;wrong type&quot; unless ref $self;<BR>
68&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print
&quot;\nKnot::&nbsp;&nbsp;unknotted!\n&quot;;<BR>
69&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
<BR>
70<BR>
71 #<BR>
72 # The obligatory ending true statement.<BR>
73 #<BR>
74 1;</FONT></TT>
</BLOCKQUOTE>
<HR>
<P>
<TT><FONT FACE="Courier">Knot.pm</FONT></TT> defines the package
in line 10 and imports the <TT><FONT FACE="Courier">Carp</FONT></TT>
and <TT><FONT FACE="Courier">strict</FONT></TT> packages in lines
11 and 12, respectively. Line 74 terminates the module.
<P>
Lines 19 through 26 define the <TT><FONT FACE="Courier">TIESCALAR</FONT></TT>
function. The <TT><FONT FACE="Courier">TIESCALAR</FONT></TT> function
behaves a lot like the constructor of an object in Perl. It creates
an associative array and returns a reference to this array after
a call to the <TT><FONT FACE="Courier">bless()</FONT></TT> function.
(<A HREF="ch5.htm" tppabs="http://www.mcp.com/815097600/0-672/0-672-30891-6/ch5.htm" >See Chapter 5</A>, &quot;Object-Oriented Programming
in Perl,&quot; for more information on <TT><FONT FACE="Courier">bless</FONT></TT>-ing
objects.)
<P>
The <TT><FONT FACE="Courier">FETch</FONT></TT> method starts at
line 35. The <TT><FONT FACE="Courier">FETch</FONT></TT> method
is called every time the tied variable is read from. The only
argument to the <TT><FONT FACE="Courier">FETch</FONT></TT> method
is a reference to the object itself. At line 37, the class type
is confirmed, although it's not absolutely necessary to do this.
Lines 39 through 41 return the current date and time for the value
of the tied variable.
<P>
The <TT><FONT FACE="Courier">STORE</FONT></TT> method is defined
from line 50 through 56. In this case, we do not let values of
the arguments that are passed in be assigned to anything because
we want to make this value a read-only variable. You can easily
modify this function to take some other action than what's shown
in this example. The <TT><FONT FACE="Courier">FETch</FONT></TT>
method takes only two arguments: a reference to itself and a value
that is being assigned. The <TT><FONT FACE="Courier">confess()</FONT></TT>
call is from within the <TT><FONT FACE="Courier">Carp</FONT></TT>
module.
<P>
The <TT><FONT FACE="Courier">DESTROY</FONT></TT> method is called
when the tied variable is destroyed. Normally, this function is
empty. For this example, there is a <TT><FONT FACE="Courier">print</FONT></TT>
statement to show where the <TT><FONT FACE="Courier">DESTROY</FONT></TT>
function is called.
<H2><A NAME="TyingtoanArray"><FONT SIZE=5 COLOR=#FF0000>Tying
to an Array</FONT></A></H2>
<P>
An array variable can be tied to a class in the same manner as
a scalar can be tied to a class. The real difference is that the
input parameters to the methods now need an index used to address
a value in array. A class implementing an ordinary array must
have these methods:
<UL>
<LI><TT><FONT FACE="Courier">TIEARRAY classname, LIST</FONT></TT>
<LI><TT><FONT FACE="Courier">FETch this, key</FONT></TT>
<LI><TT><FONT FACE="Courier">STORE this, key, value</FONT></TT>
<LI><TT><FONT FACE="Courier">DESTROY this</FONT></TT>
</UL>
<P>
The <TT><FONT FACE="Courier">FETch</FONT></TT>, <TT><FONT FACE="Courier">DESTROY</FONT></TT>,
and <TT><FONT FACE="Courier">STORE</FONT></TT> methods have the
same names as those for scalars. However, the name of the constructor
is different-it's called <TT><FONT FACE="Courier">TIEARRAY</FONT></TT>.
Let's define a new array type called <TT><FONT FACE="Courier">Cuboid</FONT></TT>,
which has its first five indexes provide special functions. The
first three indexes are written to as the height, width, and depth
of a cuboid. The next two indexes contain the volume and surface
area of the cuboid and are made read-only. The rest of the array
can be made into a bounded array to allow a user to store his
or her own values. As soon as a value is stored in the <TT><FONT FACE="Courier">Cuboid</FONT></TT>
array, the values of items at index <TT><FONT FACE="Courier">3</FONT></TT>
and <TT><FONT FACE="Courier">4</FONT></TT> are recalculated to
provide the latest volume and surface area of a cuboid.
<P>
Listing 6.3 illustrates how to use this array. 
<HR>
<BLOCKQUOTE>
<B>Listing 6.3. Using the </B><TT><B><FONT FACE="Courier">Cuboid.pm</FONT></B></TT><B>
module.<BR>
</B>
</BLOCKQUOTE>
<BLOCKQUOTE>
<TT><FONT FACE="Courier">&nbsp;1 #!/usr/bin/perl<BR>
&nbsp;2<BR>
&nbsp;3 push(@Inc,&quot;.&quot;);
<BR>
&nbsp;4 use Cuboid;<BR>
&nbsp;5<BR>
&nbsp;6 tie @myCube, 'Cuboid', 3;<BR>
&nbsp;7<BR>
&nbsp;8 $myCube[0] = 2;<BR>
&nbsp;9 $myCube[1] = 3;<BR>
10 $myCube[2] = 4;<BR>
11<BR>
12 for ($i=0; $i &lt; 5; $i++) {<BR>
13&nbsp;&nbsp;&nbsp;&nbsp; print &quot; myCube[$i] = $myCube[$i]
\n&quot;;<BR>
14 }<BR>
15</FONT></TT>
</BLOCKQUOTE>
<HR>
<P>
Here is the output of this code.
<BLOCKQUOTE>
<TT><FONT FACE="Courier">array will be 8 elements long<BR>
[STORE 2 at 0]<BR>
[STORE 3 at 1]<BR>
[STORE 4 at 2]<BR>
&nbsp;myCube[0] = 2<BR>
&nbsp;myCube[1] = 3<BR>
&nbsp;myCube[2] = 4<BR>
&nbsp;myCube[3] = 24<BR>
&nbsp;myCube[4] = 52</FONT></TT>
</BLOCKQUOTE>
<P>
Now let's examine the <TT><FONT FACE="Courier">Cuboid.pm</FONT></TT>
module, which is presented in Listing 6.4.
<HR>
<BLOCKQUOTE>
<B>Listing 6.4. The </B><TT><B><FONT FACE="Courier">Cuboid.pm</FONT></B></TT><B>
module.<BR>
</B>
</BLOCKQUOTE>
<BLOCKQUOTE>
<TT><FONT FACE="Courier">&nbsp;1 # ------------------------------------------------------------
<BR>
&nbsp;2 package Cuboid;<BR>
&nbsp;3 use Carp;<BR>
&nbsp;4 use strict;<BR>
&nbsp;5<BR>
&nbsp;6 #<BR>
&nbsp;7 # The constructor
for this class.<BR>
&nbsp;8 # ------------------------------------------------------------
<BR>
&nbsp;9 # Array[0] = ht;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
read write<BR>
10 # Array[1] = wd;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
read write<BR>
11 # Array[2] = dp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
read write<BR>
12 # Array[3] = volume;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; read
only<BR>
13 # Array[4] = surfaceArea;&nbsp;&nbsp;read only<BR>
14 # Array[5...maxsize] = read/write values for the user;<BR>
15 # ------------------------------------------------------------
<BR>
16<BR>
17 my $SACRED = 5;<BR>
18<BR>
19 sub TIEARRAY {<BR>
20<BR>
21&nbsp;&nbsp;&nbsp;&nbsp; my $class = shift;<BR>
22&nbsp;&nbsp;&nbsp;&nbsp; my $maxsize = shift;<BR>
23<BR>
24&nbsp;&nbsp;&nbsp;&nbsp; #<BR>
25&nbsp;&nbsp;&nbsp;&nbsp; # Bailout if the array is not tied
correctly.<BR>
26&nbsp;&nbsp;&nbsp;&nbsp; #<BR>
27&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;confess
&quot;usage: tie(\@ary, 'Cuboid', maxsize)&quot;<BR>
28&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if
@_ || $maxsize =~ /\D/;<BR>
29&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$maxsize
+= $SACRED;<BR>
30&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print
&quot;array will be $maxsize elements long\n&quot;;<BR>
31&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return
bless {<BR>
32&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;MAXSIZE
=&gt; $maxsize,<BR>
33&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ARRAY
=&gt; [0,0,0,0,0],<BR>
34&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
$class;<BR>
35&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
<BR>
36<BR>
37 # FETch this, index<BR>
38 # This method will be triggered every time an individual element
the tied<BR>
39 # array is accessed (read). It takes one argument beyond its
self<BR>
40 # reference: the index whose value we're trying to fetch.<BR>
41 #<BR>
42 sub FETch {<BR>
43&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my($self,$ndx)
= @_;<BR>
44&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if
($ndx &gt; $self-&gt;{MAXSIZE}) {<BR>
45&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;confess
&quot;Error Out of Bounds: $ndx &gt; $self-&gt;{MAXSIZE}&quot;;
<BR>
46&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
<BR>
47&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return
$self-&gt;{ARRAY}[$ndx];<BR>
48&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
<BR>
49<BR>
50 # STORE this, index, value<BR>
51 # This method will be called whenever an element in the tied
array<BR>
52 # is written to. It takes three arguments: a reference to itself,
<BR>
53 # the index to store stuff at, and the value to store at the
index.<BR>
54 #<BR>
55 # The items at [3] and [4] are not allowed to be written to.
<BR>
56 #<BR>
57 sub STORE {<BR>
58&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my($self,
$ndx, $value) = @_;<BR>
59&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print
&quot;[STORE $value at $ndx]\n&quot;;<BR>
60&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if
($ndx &gt; $self-&gt;{MAXSIZE} ) {<BR>
61&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;confess
&quot;Error Out Of Bounds: $ndx &gt; $self-&gt;{MAXSIZE}&quot;;
<BR>
62&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
<BR>
63&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if (($ndx ==
3) || ( $ndx == 4))&nbsp;&nbsp;{<BR>
64&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;confess
&quot;Cannot store in read only area: $ndx&quot;;<BR>
65&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
<BR>
66&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;{ARRAY}[$ndx]
= $value;<BR>
67&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
$self-&gt;{ARRAY}[3]&nbsp;&nbsp;=<BR>
68&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;($self-&gt;{ARRAY}[0]
* $self-&gt;{ARRAY}[1] * $self-&gt;{ARRAY}[2]) ;<BR>
69&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
$self-&gt;{ARRAY}[4] =<BR>
70&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;($self-&gt;{ARRAY}[0]
* $self-&gt;{ARRAY}[1])&nbsp;&nbsp;+<BR>
71&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;($self-&gt;{ARRAY}[1]