ch18.htm

《Perl 5 Unreleased》

 24     $i2 = Invest::Stock('symbol'
=&gt; 'INTC');&nbsp;&nbsp;&nbsp;&nbsp; <BR>
&nbsp;25&nbsp;&nbsp;&nbsp;&nbsp; $i3 = Invest::Stock('symbol'
=&gt; 'MSFT', 'shares' =&gt; '10');&nbsp;&nbsp;&nbsp;&nbsp; <BR>
&nbsp;26<BR>
&nbsp;27&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$port-&gt;Invest::AddItem($i1);
<BR>
&nbsp;28&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$port-&gt;Invest::AddItem($i2);
<BR>
&nbsp;29&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$port-&gt;Invest::AddItem($i3);
<BR>
&nbsp;30<BR>
&nbsp;31&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$port-&gt;showPortfolio();
<BR>
&nbsp;32&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$port-&gt;savePortfolio(&quot;myStocks&quot;);
<BR>
&nbsp;33<BR>
&nbsp;34 =head1 DESCRIPTION<BR>
&nbsp;35<BR>
&nbsp;36 This module provides a short example of generating a
letter for a<BR>
&nbsp;37 friendly neighborbood loan shark.<BR>
&nbsp;38<BR>
&nbsp;39 The code begins after the &quot;cut&quot; statement.
<BR>
&nbsp;40 =cut<BR>
&nbsp;41<BR>
&nbsp;42 @EXPORT = qw( new, AddItem, showPortfolio, savePortfolio,
<BR>
&nbsp;43&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;reportPortfolio,
<BR>
&nbsp;44&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;restorePortfolio,
PrintMe);<BR>
&nbsp;45<BR>
&nbsp;46 my %portfolio = {};<BR>
&nbsp;47 my $portIndex = 0;<BR>
&nbsp;48<BR>
&nbsp;49 sub Invest::new {<BR>
&nbsp;50&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my
$this = shift;<BR>
&nbsp;51&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my
$class = ref($this) || $this;<BR>
&nbsp;52&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my
$self = {};<BR>
&nbsp;53&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;bless
$self, $class;<BR>
&nbsp;54&nbsp;&nbsp;&nbsp;&nbsp; $portIndex = 0;<BR>
&nbsp;55&nbsp;&nbsp;&nbsp;&nbsp; # printf &quot;\n Start portfolio&quot;;
<BR>
&nbsp;56&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return
$self;<BR>
&nbsp;57 }<BR>
&nbsp;58<BR>
&nbsp;59 sub Invest::AddItem {<BR>
&nbsp;60&nbsp;&nbsp;&nbsp;&nbsp; my ($type,$stock) = @_;<BR>
&nbsp;61&nbsp;&nbsp;&nbsp;&nbsp; $portfolio{$portIndex} = $stock;
<BR>
&nbsp;62&nbsp;&nbsp;&nbsp;&nbsp; # print &quot;\nAdded &quot;.&nbsp;&nbsp;$stock-&gt;{'shares'}
. &quot; shares of &quot; . $stock-&gt;{'symbol'};<BR>
&nbsp;63&nbsp;&nbsp;&nbsp;&nbsp; $portIndex++;<BR>
&nbsp;64 }<BR>
&nbsp;65<BR>
&nbsp;66 sub Invest::showPortfolio&nbsp;&nbsp;{<BR>
&nbsp;67&nbsp;&nbsp;&nbsp;&nbsp; printf &quot;\n Our Portfolio
is:&quot;;<BR>
&nbsp;68&nbsp;&nbsp;&nbsp;&nbsp; my ($key, $i);<BR>
&nbsp;69&nbsp;&nbsp;&nbsp;&nbsp; while (($key,$i) = each(%portfolio))
{<BR>
&nbsp;70&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print
&quot;\n &quot;.&nbsp;&nbsp;$i-&gt;{'shares'} . &quot; shares
of &quot; . $i-&gt;{'symbol'};<BR>
&nbsp;71&nbsp;&nbsp;&nbsp;&nbsp; }<BR>
&nbsp;72&nbsp;&nbsp;&nbsp;&nbsp; print &quot;\n&quot;;<BR>
&nbsp;73 }<BR>
&nbsp;74<BR>
&nbsp;75 sub Invest::reportPortfolio {<BR>
&nbsp;76&nbsp;&nbsp;&nbsp;&nbsp; my $hdrfmt = $~;<BR>
&nbsp;77&nbsp;&nbsp;&nbsp;&nbsp; my $topfmt = $^;<BR>
&nbsp;78&nbsp;&nbsp;&nbsp;&nbsp; my $pageCt = $=;<BR>
&nbsp;79&nbsp;&nbsp;&nbsp;&nbsp; my $lineCt = $-;<BR>
&nbsp;80&nbsp;&nbsp;&nbsp;&nbsp; my $sym;<BR>
&nbsp;81&nbsp;&nbsp;&nbsp;&nbsp; my $shr;<BR>
&nbsp;82&nbsp;&nbsp;&nbsp;&nbsp; my ($key, $i);<BR>
&nbsp;83<BR>
&nbsp;84&nbsp;&nbsp;&nbsp;&nbsp; $~ = &quot;PORT_RPT&quot;;<BR>
&nbsp;85&nbsp;&nbsp;&nbsp;&nbsp; $^ = &quot;PORT_RPT_TOP&quot;;
<BR>
&nbsp;86<BR>
&nbsp;87 format PORT_RPT_TOP =<BR>
&nbsp;88<BR>
&nbsp;89&nbsp;&nbsp;&nbsp;&nbsp; Report<BR>
&nbsp;90 STOCK&nbsp;&nbsp;&nbsp;&nbsp; SHARES<BR>
&nbsp;91 =====&nbsp;&nbsp;&nbsp;======<BR>
&nbsp;92 .<BR>
&nbsp;93<BR>
&nbsp;94 format PORT_RPT =<BR>
&nbsp;95 @&lt;&lt;&lt;&lt;&nbsp;&nbsp;&nbsp;@&lt;&lt;&lt;&lt;
<BR>
&nbsp;96 $sym, $shr<BR>
&nbsp;97 .<BR>
&nbsp;98&nbsp;&nbsp;&nbsp;&nbsp; # note how the code is intermingled
with the format!<BR>
&nbsp;99&nbsp;&nbsp;&nbsp;&nbsp; while (($key,$i) = each(%portfolio))
{<BR>
100&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$shr
= $i-&gt;{'shares'};<BR>
101&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$sym
= $i-&gt;{'symbol'};<BR>
102&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;write
;<BR>
103<BR>
104&nbsp;&nbsp;&nbsp;&nbsp; }<BR>
105<BR>
106&nbsp;&nbsp;&nbsp;&nbsp; $= = $pageCt;<BR>
107&nbsp;&nbsp;&nbsp;&nbsp; $- = $lineCt;<BR>
108&nbsp;&nbsp;&nbsp;&nbsp; $~ = $hdrfmt;<BR>
109&nbsp;&nbsp;&nbsp;&nbsp; $^ = $topfmt;<BR>
110 }<BR>
111<BR>
112 sub PrintMe {<BR>
113&nbsp;&nbsp;&nbsp;&nbsp; my $this = shift;<BR>
114&nbsp;&nbsp;&nbsp;&nbsp; print &quot;\n Class : $$this&quot;;&nbsp;&nbsp;&nbsp;&nbsp;
<BR>
115 }<BR>
116<BR>
117 sub savePortfolio {<BR>
118&nbsp;&nbsp;&nbsp;&nbsp; my ($this, $filename) = @_;<BR>
119&nbsp;&nbsp;&nbsp;&nbsp; my %dummy;&nbsp;&nbsp;&nbsp;&nbsp;
<BR>
120&nbsp;&nbsp;&nbsp;&nbsp; my $a;<BR>
121&nbsp;&nbsp;&nbsp;&nbsp; my ($key, $val);<BR>
122&nbsp;&nbsp;&nbsp;&nbsp; dbmopen(%dummy,$filename,0666);<BR>
123&nbsp;&nbsp;&nbsp;&nbsp; while (($key,$val) = each(%portfolio))
{<BR>
124&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$a =
&quot;$key:&quot; . $val-&gt;{'type'} . &quot;:&quot; . $val-&gt;{'symbol'}
. &quot;:&quot; . $val-&gt;{'shares'};<BR>
125&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print
&quot;\n Writing $key $a&quot;;<BR>
126&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$dummy{$key}
= $a;<BR>
127&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print
&quot;\n Writing $dummy{$key}&quot;;<BR>
128&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}<BR>
129&nbsp;&nbsp;&nbsp;&nbsp; dbmclose(%dummy);<BR>
130 }<BR>
131<BR>
132 sub restorePortfolio {<BR>
133&nbsp;&nbsp;&nbsp;&nbsp; my ($this, $filename) = @_;<BR>
134&nbsp;&nbsp;&nbsp;&nbsp; my %dummy;&nbsp;&nbsp;&nbsp;&nbsp;
<BR>
135&nbsp;&nbsp;&nbsp;&nbsp; my ($key, $val);<BR>
136&nbsp;&nbsp;&nbsp;&nbsp; my ($ndx,$sec,$sym,$shr);<BR>
137&nbsp;&nbsp;&nbsp;&nbsp; my $a;<BR>
138&nbsp;&nbsp;&nbsp;&nbsp; local $i1;<BR>
139&nbsp;&nbsp;&nbsp;&nbsp; dbmopen(%dummy,$filename,0666);<BR>
140&nbsp;&nbsp;&nbsp;&nbsp; while (($key,$val) = each(%dummy))
{<BR>
141&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$a =
$dummy{$key};<BR>
142&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;($ndx,$sec,$sym,$shr)
= split(':',$a);<BR>
143&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# print
&quot;Read back $ndx,$sec,$sym,$shr \n&quot;;<BR>
144&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if ($sec
eq 'Fund')<BR>
145&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
{<BR>
146&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
$i1 = Invest::Fund::new('Invest::Fund',<BR>
147&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'symbol'
=&gt; &quot;$sym&quot;, 'shares' =&gt; &quot;$shr&quot;);<BR>
148&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
}<BR>
149&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;else
<BR>
150&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
{<BR>
151&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
$i1 = Invest::Stock::new('Invest::Stock',<BR>
152&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'symbol'
=&gt; &quot;$sym&quot;, 'shares' =&gt;&quot;$shr&quot;);<BR>
153&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
}<BR>
154&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$this-&gt;Invest::AddItem($i1);
<BR>
155&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$this-&gt;Invest::showPortfolio;
<BR>
156&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}<BR>
157&nbsp;&nbsp;&nbsp;&nbsp; dbmclose(%dummy);<BR>
158 }<BR>
159<BR>
160 1;</FONT></TT>
</BLOCKQUOTE>
<HR>
<P>
Line 8 is where the <TT><FONT FACE="Courier">require</FONT></TT>
statement is used to implement the <TT><FONT FACE="Courier">AnyDBM_FILE</FONT></TT>
support. Lines 17 through 19 use other packages as well. 
<H2><A NAME="WhatIstheDBIPackage"><FONT SIZE=5 COLOR=#FF0000>What
Is the DBI Package?</FONT></A></H2>
<P>
The database interface (DBI) package for Perl is the implementation
of the DBI Application Program Interface (API) specification written
by Tim Bunce (<TT><FONT FACE="Courier">[e-mail]</FONT></TT>).
The DBI package API is designed specifically for use with Perl.
The set of functions and variables in the DBI package provide
a consistent interface to the application using it. The strong
point of the DBI package API, in addition to its broad set of
available functions, is that it completely isolates the using
application from the internal implementation of the underlying
database. 
<P>
The DBI specification exists at various sites in the CPAN archives,
but the latest version (v0.6) is not up to date. The best source
of information is to look in the source files for a DBI package
itself. The entire specification is good for getting an idea of
how everything is intended to work together. However, the interface
has changed considerably since the specification was released.
Check out the file <TT><FONT FACE="Courier">dbispec.v06</FONT></TT>
in compressed form at <TT><FONT FACE="Courier">ftp.demon.co.uk</FONT></TT>
in the <TT><FONT FACE="Courier">/pub/perl/db</FONT></TT> directory.
<P>
The DBI specification started out as DBperl back in 1992 as a
team effort from several Perl enthusiasts. Here are the initial
contributors to the specification for each type of database:<P>
<CENTER>
<TABLE BORDERCOLOR=#000000 BORDER=1 WIDTH=80%>
<TR VALIGN=TOP><TD WIDTH=171>infoperl (Informix)</TD><TD WIDTH=398>Kurt Andersen (<TT><FONT FACE="Courier">[e-mail]</FONT></TT>)
</TD></TR>
<TR VALIGN=TOP><TD WIDTH=171>interperl (Interbase)</TD><TD WIDTH=398>Buzz Moschetti (<TT><FONT FACE="Courier">[e-mail]</FONT></TT>)
</TD></TR>
<TR VALIGN=TOP><TD WIDTH=171>oraperl (Oracle)</TD><TD WIDTH=398>Kevin Stock (<TT><FONT FACE="Courier">[e-mail]</FONT></TT>)
</TD></TR>
<TR VALIGN=TOP><TD WIDTH=171>sybperl (Sybperl)</TD><TD WIDTH=398>Michael Peppler (<TT><FONT FACE="Courier">[e-mail]</FONT></TT>)
</TD></TR>
<TR VALIGN=TOP><TD WIDTH=171>sqlperl/ingperl (Ingres)</TD><TD WIDTH=398>Ted Mellon (<TT><FONT FACE="Courier">[e-mail]</FONT></TT>) and Tim Bunce
</TD></TR>
</TABLE></CENTER>
<P>
<P>
The original DBI specification was edited by Kurt Anderson. In
1994, Tim Bunce took over the editing and maintenance of the specification
in addition to the DBI and <TT><FONT FACE="Courier">DBD::Oracle</FONT></TT>
package development. The specification and related files are copyrighted
by Tim Bunce.
<P>
The original specification was edited by Kurt Anderson from the
discussions on the mailing list. In 1993, Tim Bunce took over
the editing and maintenance of the specification and in 1994 started
the development of the DBI and <TT><FONT FACE="Courier">DBD::Oracle</FONT></TT>
modules. The DBI specification and modules are copyrighted by
Tim Bunce but are freely available to all with the same terms
as Perl. (Tim is the technical director of the software systems
house, Paul Ingram Group in Surrey, England. Tim can be reached
at <TT><FONT FACE="Courier">[e-mail]</FONT></TT>, but
DBI related mail should be sent to the <TT><FONT FACE="Courier">[e-mail]</FONT></TT>
mailing list.)
<P>
The DBI is not related to any one specific database because it
serves as an intermediary between a program and one or more <TT><FONT FACE="Courier">DBD::*</FONT></TT>
driver modules. <TT><FONT FACE="Courier">DBD::</FONT></TT> modules
are drivers written to support a specific database back-end. The
<TT><FONT FACE="Courier">DBI::</FONT></TT> module manages all
installed <TT><FONT FACE="Courier">DBD::</FONT></TT> drivers in
your system. You can load and use more than one <TT><FONT FACE="Courier">DBD::</FONT></TT>
module at the same time.
<P>
<TT><FONT FACE="Courier">DBD::</FONT></TT> modules are written
in such a way that they may be copied and customized to suit your
specific needs. For example, the <TT><FONT FACE="Courier">DBD::Oracle</FONT></TT>
module served as the starting point for Alligator Descartes, another
well-known pioneer in developing database interfaces for Perl,
to develop <TT><FONT FACE="Courier">DBD::</FONT></TT> modules
for other databases. He has written two copyrighted documents
on how to develop your own driver from <TT><FONT FACE="Courier">DBD::</FONT></TT>
modules. These documents are located on the Web site <TT><FONT FACE="Courier">www.hermetica.com</FONT></TT>
in the <TT><FONT FACE="Courier">technologia/DBI</FONT></TT> directory.
<H3><A NAME="AvailablePackages">Available Packages</A></H3>
<P>
Some of <TT><FONT FACE="Courier">DBI::</FONT></TT> packages available
on the Internet are listed here; you can get the latest versions
of these files from the Internet CPAN sites:
<UL>