r2205 - in packages: . libnet-z3950-perl libnet-z3950-perl/branches
libnet-z3950-perl/branches/upstream
libnet-z3950-perl/branches/upstream/current
libnet-z3950-perl/branches/upstream/current/Z3950
libnet-z3950-perl/branches/upstream/current/doc
libnet-z3950-perl/branches/upstream/current/samples
libnet-z3950-perl/branches/upstream/current/yazwrap
gregor herrmann
gregoa-guest at costa.debian.org
Sat Feb 25 20:49:24 UTC 2006
Author: gregoa-guest
Date: 2006-02-25 20:48:55 +0000 (Sat, 25 Feb 2006)
New Revision: 2205
Added:
packages/libnet-z3950-perl/
packages/libnet-z3950-perl/branches/
packages/libnet-z3950-perl/branches/upstream/
packages/libnet-z3950-perl/branches/upstream/current/
packages/libnet-z3950-perl/branches/upstream/current/COPYING
packages/libnet-z3950-perl/branches/upstream/current/Changes
packages/libnet-z3950-perl/branches/upstream/current/MANIFEST
packages/libnet-z3950-perl/branches/upstream/current/MANIFEST.SKIP
packages/libnet-z3950-perl/branches/upstream/current/Makefile.PL
packages/libnet-z3950-perl/branches/upstream/current/README
packages/libnet-z3950-perl/branches/upstream/current/Z3950.pm
packages/libnet-z3950-perl/branches/upstream/current/Z3950.xs
packages/libnet-z3950-perl/branches/upstream/current/Z3950/
packages/libnet-z3950-perl/branches/upstream/current/Z3950/APDU.pm
packages/libnet-z3950-perl/branches/upstream/current/Z3950/Connection.pm
packages/libnet-z3950-perl/branches/upstream/current/Z3950/Manager.pm
packages/libnet-z3950-perl/branches/upstream/current/Z3950/Record.pm
packages/libnet-z3950-perl/branches/upstream/current/Z3950/ResultSet.pm
packages/libnet-z3950-perl/branches/upstream/current/Z3950/ScanSet.pm
packages/libnet-z3950-perl/branches/upstream/current/Z3950/Tutorial.pm
packages/libnet-z3950-perl/branches/upstream/current/ccl.qual
packages/libnet-z3950-perl/branches/upstream/current/doc/
packages/libnet-z3950-perl/branches/upstream/current/doc/Albums
packages/libnet-z3950-perl/branches/upstream/current/doc/Makefile
packages/libnet-z3950-perl/branches/upstream/current/doc/gui.html
packages/libnet-z3950-perl/branches/upstream/current/doc/htmlify
packages/libnet-z3950-perl/branches/upstream/current/doc/index.html
packages/libnet-z3950-perl/branches/upstream/current/doc/style.css
packages/libnet-z3950-perl/branches/upstream/current/doc/todo.html
packages/libnet-z3950-perl/branches/upstream/current/doc/visit.html
packages/libnet-z3950-perl/branches/upstream/current/samples/
packages/libnet-z3950-perl/branches/upstream/current/samples/ISBNs
packages/libnet-z3950-perl/branches/upstream/current/samples/README
packages/libnet-z3950-perl/branches/upstream/current/samples/batch-isbn.pl
packages/libnet-z3950-perl/branches/upstream/current/samples/canonical.pl
packages/libnet-z3950-perl/branches/upstream/current/samples/fetch1.pl
packages/libnet-z3950-perl/branches/upstream/current/samples/multiplex.pl
packages/libnet-z3950-perl/branches/upstream/current/samples/scan.pl
packages/libnet-z3950-perl/branches/upstream/current/samples/simple.pl
packages/libnet-z3950-perl/branches/upstream/current/test.pl
packages/libnet-z3950-perl/branches/upstream/current/typemap
packages/libnet-z3950-perl/branches/upstream/current/yazwrap/
packages/libnet-z3950-perl/branches/upstream/current/yazwrap/Makefile.PL
packages/libnet-z3950-perl/branches/upstream/current/yazwrap/connect.c
packages/libnet-z3950-perl/branches/upstream/current/yazwrap/receive.c
packages/libnet-z3950-perl/branches/upstream/current/yazwrap/send.c
packages/libnet-z3950-perl/branches/upstream/current/yazwrap/util.c
packages/libnet-z3950-perl/branches/upstream/current/yazwrap/yazwrap.h
packages/libnet-z3950-perl/branches/upstream/current/yazwrap/ywpriv.h
packages/libnet-z3950-perl/tags/
Log:
[svn-inject] Installing original source of libnet-z3950-perl
Added: packages/libnet-z3950-perl/branches/upstream/current/COPYING
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/COPYING 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/COPYING 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,340 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
Added: packages/libnet-z3950-perl/branches/upstream/current/Changes
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/Changes 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/Changes 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,493 @@
+$Id: Changes,v 1.75 2005/07/27 12:32:53 mike Exp $
+
+Revision history for Perl extension Net::Z3950.
+
+0.50 Wed Jul 27 13:28:03 BST 2005
+ - Correct the ResultSet::present() fix that was supposed to be
+ in the previous release: that code inadvertently always
+ returned undef in asynchronous mode.
+ - "ywpriv.h" now #undefines "list", which the Perl development
+ header files inexplicably and inexcusably #define to
+ "Perl_list".
+ - "ywpriv.h" now #undefines "open", which Solaris 9 #defines
+ (I really can't believe this) to "open64". Maybe Sun would
+ like me to go round their place and dump a load of _my_ crap
+ in _their_ workspace?
+ - New querytype "cql" can be used to pass CQL queries,
+ untranslated, straight through to the server. Use like:
+ $conn->search(cql => "au=(kernighan and richie)")
+
+0.49 Thu Apr 21 11:06:02 BST 2005
+ - Change to the ResultSet::present() API in asynchronous mode:
+ returns 1 if new requests were queued, 0 if all of the
+ requested records had already been queued. (No changes to
+ its usage in synchronous mode.)
+ - yazwrap/send.c no longer includes <yaz/log.h> (not needed,
+ generates warning)
+
+0.48 Tue Apr 19 22:36:45 2005
+ - Patches supplied by Jan Bauer Nielsen <jbn at dtv.dk> to
+ interpret otherInformation packets, in search responses,
+ containing a search-info report of subquery counts.
+ - Patches supplied by Myron Turner <mturner at Ms.UManitoba.CA>
+ to protect the Net::Z3950 module against certain classes of
+ badly-behaved server.
+ - Bring "samples/multiplex.pl" up to date, illustrating the
+ use of this module to run sequences of queries against
+ multiple servers in parallel.
+
+0.47 Tue Jan 4 22:15:07 2005
+ - The "connection refused" condition is now handled more
+ gracefully, so that there is no error message emitted by
+ Event.pm, just an undefined value returned and $! set to
+ ECONNREFUSED.
+ - Improve many of the comments on this subject.
+
+0.46 Mon Nov 22 23:42:40 2004
+ - Use the MARC::Record module for rendering MARC records
+ instead of the older, unsupported and possibly buggy
+ MARC.pm.
+
+ WARNING: This change is backwards incompatible, but that
+ incompatibility will only affect you if you're relying on
+ the precise formatting of $rec->render() on MARC records.
+
+0.45 Mon Nov 1 09:13:51 2004
+ - Support for "charset" and "language" options added by Adam
+ Dickmeiss.
+
+0.44 Fri May 7 18:00:54 2004
+ Note that this release consists entirely of
+ backwards-incompatible changes to new functionality introduced
+ in 0.43, the previous release. If you use Scan, then all your
+ Scan code must change; if you do not use Scan, then this
+ release will not affect you at all.
+ - Change scan-option names to be ZOOM-compliant.
+ - Introduce a new enumeration, Net::Z3950::ScanStatus
+ - Add a new class, Net::Z3950::ScanSet, representing the
+ results of a Scan operation. This is compliant with the
+ ZOOM Abstract API, and supports much nicer client code than
+ the previous release:
+ $ss = $conn->scan('@attr 1=1003 kern');
+ $status = $ss->status();
+ print $ss->errmsg()
+ if $status == Net::Z3950::ScanSet::Failure;
+ $count = $ss->size();
+ ($term, $hits) = $ss->term(0);
+ The scanResponse APDU, which used to be returned from the
+ scan() method, is still available via the scanResponse()
+ method, but there is no reason for new code to call this.
+ - Complete rewrite of the sample client "scan.pl" to use the
+ new API.
+
+0.43 Thu May 6 14:19:56 2004
+ - Add support for Scan, using code contributed by Jan Bauer
+ Nielsen <jbn at dtv.dk>, somewhat tidied up. Use it like this:
+ $apdu = $conn->scan('@attr 1=1003 kern');
+ $status = $apdu->scanStatus();
+ if ($status == 6) print Dumper($apdu->diag());
+ $count = $apdu->numberOfEntriesReturned();
+ $term = $apdu->entries()->[0]->termInfo()->term()->general();
+ $hits = $apdu->entries()->[0]->termInfo()->globalOccurrences();
+ Subsequent releases will support more corners of the Scan
+ specification (e.g. displayTerm and friends), and present a
+ much nicer API with a ZOOM-like ScanSet object. See
+ http://zoom.z3950.org/api/zoom-1.4.html#3.6
+ - Included in the "samples" directory is a simple scanning
+ client program, "scan.pl".
+
+0.42 Wed Mar 31 13:06:09 2004
+ - Add support for Unix-domain sockets: use "unix" as the
+ hostname, and the path to the socket file as the port, in
+ the connection constructor. Like this:
+ $conn = new Net::Z3950::Connection("unix", "/tmp/socket");
+
+0.41 Wed Mar 17 13:33:43 2004
+ - When Net::Z3950::Manager::wait() times out, it now returns
+ an undefined value rather than, as in v0.40, the timeout
+ value. This code is now tested, thanks to Rick Jansen.
+ - Minor changes to some of the logic in ResultSet.pm
+
+0.40 Tue Mar 16 13:57:33 2004
+ - A timeout may be set for a Net::Z3950::Manager's wait() by
+ setting that manager's "timeout" option to the maximum
+ number of seconds to wait. Donald Knuth once wrote,
+ "Beware: this code has not been tested, only proved
+ correct." _This_ code improves on Knuth in that it has been
+ neither tested _nor_ proved correct. However, I give you my
+ solemn promise that I think it probably works, as likely as
+ not.
+
+0.39 Fri Dec 19 16:08:35 2003
+ - Recognise record-syntax names such as "USMARC" as well as
+ enumerators such as Net::Z3950::RecordSyntax::USMARC, in
+ accordance with what's specified in v1.4 of the ZOOM AAPI.
+ Such names are recgonised case- and hyphen-insensitively, so
+ "GRS-1" and "grs1" are equivalent.
+ - Add "XML" as an alias for the "TEXT_XML" record-syntax.
+ - Handle the ZOOM AAPI's standard options "pass" and "group"
+ in preference to the old options "password" and "groupid"
+ (although these are still also recognised, for the benefit
+ of old applications.)
+ - Handle the ZOOM AAPI's standard option "async" in preference
+ to the old "type" with _value_ "async" (although that's
+ still also recognised, for the benefit of old applications.)
+ - Makefile.PL includes support for and instructions about
+ building against a YAZ in a non-standard place ("non-root
+ install").
+ - Another slight refinement to samples/simple.pl's
+ diagnostics.
+ - Documentation for diagnostic methods now includes a link to
+ the BIB-1 diagnostics web-page.
+
+0.38 Fri Oct 24 13:28:42 2003
+ - Fix a silly bug in Net::Z3950::Record::OPAC::rawdata(),
+ spotted by Kristina Long. It was trying to return $$this,
+ like the opaque-array-of-bytes record-types such as USMARC,
+ whereas in fact $this is itself a Perl structure
+ representing the record.
+ - Add a kludge to patch over anti-social behaviour from
+ servers that sometimes return USMARC records when asked for
+ OPAC records: the returned record is wrapped in an otherwise
+ empty OPAC record structure.
+
+0.37 Tue Sep 16 15:14:40 2003
+ - Remove a pair of extraneous declarations (copied from
+ "yaz/include/yaz/z-opac.h" for reference) at the end of
+ translateHoldingsAndCirc(). On recent GCC versions, such as
+ mine, they were pointless but harmless; but older versions,
+ such as the one in Debian/stable, croak if you mix
+ statements and declarations.
+ - Improve behaviour when a server unilaterally closes the
+ connection while we're waiting for a Init response.
+ Previously, this would cause a segmentation fault; now you
+ get errno set to 104 (ECONNRESET) which is pretty close.
+ - Improve the OPAC record renderer in Z3950/Record.pm so that
+ it walks more of the OPAC-record structure. As well as
+ being prettier, this is better documentation-by-example of
+ how to use the record structure.
+
+0.36 Fri Sep 12 23:47:00 2003
+ - Add support for the OPAC record syntax: OPAC records are now
+ translated into self-describing Perl data-structures,
+ blessed into the class Net::Z3950::Record::OPAC. There is a
+ rudimentary renderer included in that class, but
+ sophisticated applications will want to deal with the data
+ structure itself. To see it in action, use something like:
+ $ perl samples/simple.pl alpha.calarts.edu 210 \
+ MARION fruit preferredRecordSyntax 35
+ WARNING: for some servers, e.g. troy.lib.sfu.ca:210/innopac,
+ you MUST request elementSetName "F", otherwise you'll just
+ be fed USMARC records whatever your preferredRecordSyntax.
+ - Deal better with unrecognised or malformed APDUs from the
+ server, e.g. library.ucfv.bc.ca:2200/unicorn when asked
+ for the USMARC record found by "@attr 1=4 time". Now, the
+ operation fails with diagnostic code 1001 (Malformed APDU).
+ - Change all <mike at tecc.co.uk> addresses to
+ <mike at indexdata.com>. (This change is well overdue, since I
+ changed jobs seven months ago!)
+ - Fix reference for PQF in the YAZ manual.
+
+0.35 Fri Jun 27 10:48:03 2003
+ - Fix all non-US MARC record-types to return raw data from the
+ rawdata() method rather than, as before, the render()
+ method.
+ - Add a new delete() method to Net::Z3950::ResultSet
+
+0.34 Mon May 12 10:17:07 2003
+ - Slightly more robust cleanup in Manager::forget()
+ - Make samples/simple.pl a little less simple(!) by making a
+ manager so that pre-connection options such as
+ authentication parameters can be set.
+ - In Makefile.PL, LIBS and INC are now both set via yaz-config,
+ so you don't need to mess with that file before building.
+ (Adam Dickmeiss)
+ - The INC is now inherited by yazwrap/Makefile.PL, so that
+ this file also does not need to be edited. (Adam Dickmeiss)
+ - CCFLAGS is no longer set in the yazwrap directory. I only
+ did that in order to add "-Wall", which is pleasant luxury
+ but not really necessary; and doing so caused problems as
+ other, default, components of that setting were discarded on
+ some platforms. (Adam Dickmeiss)
+ - Add support for the MAB record syntax, thanks to Heiko
+ Jansen <JANSEN at hbz-nrw.de>
+
+0.33 Thu Apr 3 09:10:16 2003
+ - Add explicit statement of GPL licence.
+ No code changes at all.
+
+0.32 Tue Jan 21 16:46:23 2003
+ - Remove the old, unnecessary and confusing code that patched
+ around the absence of cs_look() and cs_rcvconnect() in YAZ.
+ In fact, they've both been there since version 1.8 (the one
+ that introduced ZOOM-C), fourteen months ago. This change
+ cleans up the code and fixes an intermittent error that Dave
+ Mitchell had run into. You now need v1.8 of YAZ or newer.
+
+0.31 Wed Nov 27 12:40:50 2002
+ - Add command-line options to samples/simple.pl
+ - Add samples/canonical.pl
+ - Change the default element-set names in Manager.pm to be
+ upper-case "F" and "B" rather than "f" and "b", as specified
+ in section 3.6.2 (Composition Specification, Comp-spec
+ Omitted) of the standard.
+ http://lcweb.loc.gov/z3950/agency/markup/08.html#3.6.2
+ Even though a clarification makes it clear that element-set
+ names should be treated case-insensitively.
+ http://lcweb.loc.gov/z3950/agency/clarify/esncase.html
+ - Formally deprecate the non-working records() method of the
+ ResultSet class.
+ - When a new Connection object can't be made because of Init
+ being refused (rather than due to a lower-level error such
+ as ECONNREFUSED), $! is set to the distinguished value -1.
+ (Dave Mitchell)
+ - Neater code for connection-closing.
+ (Dave Mitchell)
+ - Fake up a diagnostic record (BIB-1 error 3, "unsupported
+ search") for servers which illegally fail to include
+ diagnostic records in the result of a failed search.
+ (Dave Mitchell)
+ - Added #include "XSUB.h" to the yazwrap directory's private
+ code, which means it now does The Right Thing when compiling
+ against a Perl build with the MULTIPLICITY flag set. This
+ means that we now build and run under cygwin on Windows 2000
+ (Dave Mitchell)
+ - Add new option "namedResultSets", initially true, which if
+ set false caters for brain-damaged servers by always using
+ the same result-set name, "default", thereby invalidating
+ previous ResultSet objects.
+ (Dave Mitchell)
+ - Documentation tweaks.
+
+0.30 Fri Jul 19 13:55:45 2002
+ Today's release is brought to you entirely by Dave Mitchell
+ <davem at fdgroup.com>, who has done an astonishing amount of
+ really useful work on Net::Z3950. Thanks, Dave!
+
+ - Added the present() method and "prefetch" option to optimise
+ multiple calls of record() in synchronous mode.
+ - Made $conn->close() actually clean up and close the connection
+ - Fixed memory leak in receive.c, decodeAPDU()
+ - Added functions to decode close request/response APDUs.
+ - Really do add ability to set custom exception-handler via
+ "die_handler" option -- I [Mike] did it wrong last time.
+ - Changed all print()s to die()s, which can be caught as
+ exceptions.
+ - Commented out a debugging warn()
+ - Added a dummy "test" target to yazwrap/Makefile.PL to stop
+ it complaining during "make test" [At last! -- Mike]
+ - Removed "debug => 5" from watcher creators.
+ - Updated the synchronous synopsis:
+ * Replaced use of records() with record(), since the former
+ is deprecated.
+ * Added error-checking, so that people who cut-and-paste the
+ synposis start off with good habits.
+ * Added $conn->close(), so people know this doesn't happen
+ automatically.
+
+0.29 Fri May 17 17:07:53 2002
+ - Add ability to set custom exception-handler via
+ 'die_handler' option.
+ - Fix dereference-undef bug occurring when performing a second
+ search on a connection without having fetched any records
+ following the first search.
+ - Cope with servers which lie about the number of records in
+ their present responses (the cads!)
+ - Fix to correctly translate OIDs in which one or more
+ components is "0".
+ All of these changes are due to Dave Mitchell
+ <davem at fdgroup.com> -- thanks, Dave!
+
+0.28 Wed Feb 27 17:28:26 2002
+ - Change representation of OIDs from blessed reference to
+ array of intergers to Boring Old String (dot-separated
+ numbers). Resulting tweaks elsewhere in the module, e.g. in
+ GRS::render()
+ - Fix Tutorial's incorrect description of the GRS-1 record
+ structure. How come no-one noticed this gross error in all
+ the time it was there?
+ - Minor fixes to the APDU class's documentation (but you
+ shouldn't be reading that anyway :-)
+ - Fix the top-level documentation file (index.html) to use the
+ same stylesheet as all the API documentation.
+
+0.27 Mon Feb 11 12:59:05 2002
+ - Incorporate a patch from Adam <adam at indexdata.dk> to allow
+ Net::Z3950 to work against servers that don't support named
+ result sets. Ah, so simple, so elegant!
+
+0.26 Fri Feb 8 16:06:15 2002
+ - OK. This time I have _really_ fixed connecting to work
+ properly either synchronously or asynchronously, and
+ slightly clarified some of the event-handling code while I
+ was at it. In particular, ECONNREFUSED is handled properly
+ now.
+ - Add AUTHOR and ABSTRACT to my Makefile.PL, as recommended in
+ passing by R. Geoffrey Avery's Lightning Talk _h2xs has
+ eXceeded its Stay_, at
+ http://www.platypiventures.com/perl/present/tpc5modules/004.html
+
+0.25 Tue Jan 29 15:56:48 2002
+ - Remove some obsolete comments (documenting bugs that are now
+ fixed!)
+ - Fix type mismatch in encode_APDU() -- we've been getting
+ away with it until now because sizeof(size_t)==sizeof(int)
+ on most systems, but not on the 64-bit DEC Alpha OSF/1.
+ - Fix daft-but-harmless bug in yazwrap/receive.c's setString()
+ functions, in which we return the value of a void function.
+ Most compilers DWIM, but not all.
+ - Add explicit casts to (char*) in yazwrap/receive.c where I'd
+ been assuming the conversion from unsigned char*. Ho hum.
+
+0.24 Wed Jan 23 11:39:32 2002
+ - Fix a truly stupid bug which prevents synchronous connection
+ from working. I missed this in 0.23 because the test script
+ -- unlike almost every other Net::Z3950 program -- uses
+ asynchronous connection. D'oh!
+
+0.23 Tue Jan 22 16:11:41 2002
+ - Handle surrogate diagnostics (e.g. bad element set name).
+ - Finally fix that stupid "No rule to make target `pure_all'"
+ message that "make test" always used to produce in the
+ yazwrap directory.
+ - Add support for retrieving HTML records: new record-syntax
+ enumeration TEXT_HTML, and a new record-type class
+ Net::Z3950::Record::HTML.
+ - Fix hanging on ECONNREFUSED.
+
+0.22 Fri Oct 19 16:37:44 2001
+ - Add rudimentary ("straight through") support for the OPAC
+ record syntax.
+ - Fix URLs for perl.z3950.org to omit obsolete /nz/ directory.
+ - Fix "make clean" in doc directory to remote the Z3950
+ subdirectory.
+ - Fix documentation stylesheet to match perl.z3950.org
+
+0.21 Thu Oct 18 14:29:06 2001
+ - Fix samples/multiplex.pl not to die when one server fails a
+ search - it just prints and error message now.
+ - Get rid of stupid "field `DESTROY' not defined" messages.
+
+0.20 Fri Oct 12 17:12:04 2001
+ - Add name() method to the Net::Z3950::Connection class.
+ - Add the wherewithal for asynchronous operations to invoke
+ callbacks when they complete
+ - Fix staggeringly stupid bug in which the synchronous
+ search() method would always expect an initResponse, so that
+ you couldn't call search() twice on one connection.
+ - Add support for the UNIMARC record syntax (required by Bath)
+ - Remove the stupid and implemented records() method from the
+ Connection class.
+ - Implement CCL qualifiers, specified in "ccl.qual" file.
+ - Improve diagnostics from APDU assembly.
+ - Fix a rather silly bug where records, once fetched, were
+ cached irrespective of their element-set name, so that
+ record fetched as 'b' and then as 'f' would appear brief.
+ - Revamp the "samples" directory: all examples now work(!)
+ - Add ZOOM references to the documentation.
+ - Minor fixes to documentation, comments, etc.
+
+ (This major revision - indicated by the increment of the
+ first-decimal-place version number - was largely motivated
+ by the October 2001 ZIG meeting's tutorial, for which I
+ prepared a simple multiplexing client, and was surprised at
+ how hard it turned out to be.)
+
+0.14 Wed Jul 18 13:25:06 2001
+ - Add support for retrieving XML records: new record-syntax
+ enumerations TEXT_XML and APPLICATION_XML, and a new
+ record-type class Net::Z3950::Record::XML.
+ - Minor fixes to documentation, comments, etc.
+
+0.13 Fri Jun 22 09:30:55 2001
+ - In yazwrap/util.c, change socklen_t to size_t since the
+ former does not seem to be defined on all platforms. In
+ particular, Solaris 2.6 uses a size_t* for the last argument
+ to getsockopt().
+
+0.12 Wed Feb 21 16:47:03 2001
+ - Change my email address and web-page in the README.
+ - Add conditionally-compiled debugging code to Yaz-wrapper.
+ - Add rudimentary support for rendering MARC records and
+ remove the MARC-related apology from the tutorial.
+ - Add note to README about "make test" error message.
+ - Add note to README about support options, including the
+ Net::Z3950 mailing list.
+
+0.11 Fri Feb 9 11:31:34 2001
+ - Fix Net::Z3950::ResultSet->record() to work correctly in
+ synchronous mode (i.e. wait for the record to become
+ available before returning.)
+ - Add rawdata() method to the various Net::Z3950::Record::*
+ classes: we now have a distinction between render() and
+ rawdata(), concepts which were previously mulched in
+ together very unhelpfully.
+ - Add Tutorial.
+ - FIRST PUBLIC RELEASE ON CPAN
+
+0.10 Wed Nov 29 16:39:47 2000
+ - Change module name from Z3950 to Net::Z3950
+
+0.04 Fri Sep 22 17:51:28 2000
+ - Fix so that diagnostics are available after search failure.
+ - Add trivial "straight through" support for USMARC and some
+ of the related record syntaxes.
+ - Support for OID-typed fields in GRS-1 records.
+ - Change default database to "Default" (it had the profoundly
+ unhelpful default of "hardwired-databaseName"!)
+ - Modify the internal class hierarchy to make MARC support
+ hang together more easily (yazwrap library now returns
+ ...::Record::<RS> objects instead of ...::APDU::<RS>)
+ - Improve diagnostics when low-level translation of C objects
+ into Perl objects fails.
+
+0.03 Thu Jun 29 15:38:33 2000
+ - First version to be held in CVS at indexdata.dk
+ - Add CVS identification headers where they're missing, fix
+ some that lacked the trailing $-sign (duh.)
+ - Fix the search() and records() wrapper methods so that much
+ simpler single-threaded clients can be easily written.
+
+0.02 Tue Jun 27 21:28:56 2000
+ - Make the $port argument optional in the Z3950::Connection
+ constructor.
+ - Add support for mnchar* (T_MNPV) to the typemap file: this
+ is a Maybe-Null PV, into which undefined values may be
+ passed yielding null pointers.
+ - Add samples/fetch1.pl, which actually works (unlike the
+ other scripts in the samples directory, which are written to
+ a pre-0.1 version of the interface.)
+ - Remove obsolete bits of the README file.
+
+0.01 Tue May 23 09:20:30 2000
+ - Originally created by h2xs 1.19
+ - 0.01 was the first numbered version. Earlier versions were
+ never assigned numbers as they never got outside the
+ author's house; this is the first one that was sent to Index
+ Data.
+
+--
+
+To be done:
+ - ### Fix so that when one of the Connection objects
+ associated with an asynchronous Manager can't connect,
+ $mgr->wait() returns a reference to that Connection, and
+ arranges for $conn->op() to return Net::Z3950::Op::Error,
+ and leaves things in a state whereby wait() can be
+ successfully re-invoked to continue the concurrent
+ operations of the remaining Connections. This is
+ potentially tricky to implement and test, and will only be
+ used by a small proportion of applications, so I am not
+ letting it delay release of other new functionality.
+ - ### Fix test.pl to work against either local or remote server.
+ - ### Make managers drop references to closed connections.
+ - ### Make $mgr->wait() finish when there are no connections left.
+ - ### Do away with the "async" option, probably. Here's what
+ it actually does when turned on (the default):
+ - Connection::new() waits for an Init response before
+ returning.
+ - ResultSet::present() (and hence ResultSet::record())
+ waits for for a Present response before returning.
+ See also the comment on the Connection::search()
+ method.
+
Added: packages/libnet-z3950-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/MANIFEST 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/MANIFEST 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,41 @@
+COPYING
+Changes
+MANIFEST
+MANIFEST.SKIP
+Makefile.PL
+README
+Z3950.pm
+Z3950.xs
+Z3950/APDU.pm
+Z3950/Connection.pm
+Z3950/Manager.pm
+Z3950/Record.pm
+Z3950/ResultSet.pm
+Z3950/ScanSet.pm
+Z3950/Tutorial.pm
+ccl.qual
+doc/Albums
+doc/Makefile
+doc/gui.html
+doc/htmlify
+doc/index.html
+doc/style.css
+doc/todo.html
+doc/visit.html
+samples/ISBNs
+samples/README
+samples/batch-isbn.pl
+samples/canonical.pl
+samples/fetch1.pl
+samples/multiplex.pl
+samples/scan.pl
+samples/simple.pl
+test.pl
+typemap
+yazwrap/Makefile.PL
+yazwrap/connect.c
+yazwrap/receive.c
+yazwrap/send.c
+yazwrap/util.c
+yazwrap/yazwrap.h
+yazwrap/ywpriv.h
Added: packages/libnet-z3950-perl/branches/upstream/current/MANIFEST.SKIP
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/MANIFEST.SKIP 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/MANIFEST.SKIP 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,11 @@
+.cvsignore
+CVS
+Z3950/CVS
+doc/.cvsignore
+doc/CVS
+doc/Z3950
+samples/CVS
+samples/nz-client
+samples/tmp
+yazwrap/.cvsignore
+yazwrap/CVS
Added: packages/libnet-z3950-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/Makefile.PL 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/Makefile.PL 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,48 @@
+# $Id: Makefile.PL,v 1.11 2004/05/07 17:00:29 mike Exp $
+
+# If you want to build this module against a YAZ build that's not been
+# installed in one of the usual places, just give a full path to where
+# your YAZ build's yaz-config script is in the line below. For example:
+# my $yazconf = "/home/me/stuff/yaz-2.0.4/yaz-config";
+
+my $yazconf = "yaz-config";
+my $yazinc = `$yazconf --cflags`;
+my $yazlibs = `$yazconf --libs`;
+if (!$yazinc || !$yazlibs) {
+ die "ERROR: Unable to call script 'yaz-config': is YAZ installed?";
+}
+
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Net::Z3950',
+ 'VERSION_FROM' => 'Z3950.pm', # finds $VERSION
+ 'LIBS' => [ $yazlibs ], # e.g., '-lm'
+ 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
+# Some systems like to be told: 'DEFINE' => '-D_GNU_SOURCE'
+# Apparently RedHat 8.0 (but NOT 7.3) is one of these.
+ 'INC' => $yazinc,
+ 'PREREQ_PM' => { Event => 0.77 },
+ 'MYEXTLIB' => 'yazwrap/libyazwrap$(LIB_EXT)',
+ 'AUTHOR' => 'Mike Taylor <mike at perl.z3950.org>',
+ 'ABSTRACT' => 'Build clients for the Z39.50 info. retrieval protocol',
+);
+
+
+# ### I put this bit here basically because the "perlxstut" (XS
+# Tutorial) manual told me to, but frankly I don't understand
+# the MakeMaker. It seems that this is superfluous, because the
+# generated Makefile in any case recurses to yazwrap at the drop
+# of a hat -- including, for example, when doing a "make test",
+# which is _not_ what I want. Never mind, it's not the end of
+# the world.
+#
+sub MY::postamble {
+ '$(MYEXTLIB): yazwrap/Makefile
+ cd yazwrap && $(MAKE) INC=$(PASTHRU_INC) $(PASTHRU)';
+}
+
+sub MY::post_constants {
+ 'PASTHRU_INC=$(INC)'
+}
Added: packages/libnet-z3950-perl/branches/upstream/current/README
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/README 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/README 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,98 @@
+$Header: /home/cvsroot/NetZ3950/README,v 1.12 2004/11/22 22:41:17 mike Exp $
+
+Net::Z3950.pm -- What Is It?
+----------------------------
+
+This module provides a Perl interface to the Z39.50 information
+retrieval protocol (aka. ISO 23950), a mature and powerful protocol
+used in application domains as diverse as bibliographic information,
+geo-spatial mapping, museums and other cultural heritage information,
+and structured vocabulary navigation.
+
+Up to date information on this module can be found at
+ http://perl.z3950.org/
+
+The Net::Z3950 module is free software, as described at
+ http://www.fsf.org/philosophy/free-sw.html
+It is made available under the GNU General Public Licence, version 2:
+see the file COPYING for details. (This is made explicit as of
+release 0.33, but it was always the intention.)
+
+Net::Z3950.pm is an implementation of the Perl binding for ZOOM, the
+Z39.50 Obejct Orientation Model. Bindings for the same abstract API
+are available in other languages including C, C++, Java, Tcl, Visual
+Basic, Python and Scheme. There's more about ZOOM, including the
+specification, at
+ http://zoom.z3950.org/
+
+
+Building and Installation
+-------------------------
+
+There are two (or three, depending on how you count them)
+prerequisites to building the Net::Z3950 module:
+
+ 1. You'll need the Event module (a generic event loop). I've
+ tested only with version 0.77 of Event, but later versions
+ will most likely be fine; in fact, earlier version probably
+ will be too, since I don't do anything clever with it.
+
+ 2. You'll also need version 1.8 or later of Index Data's Yaz
+ toolkit, a set of C routines for manipulating, sending and
+ receiving the Z39.50 data structures. You can find it at
+ http://indexdata.dk/yaz/
+
+ 3. The third dependency is an optional one, on the MARC::Record
+ module. This is required by the Net::Z3950::Record::MARC
+ class's render() method, but if you're not going to call that,
+ you don't need the MARC::Record module, so it's not listed as
+ a prerequisite in the Makefile.PL.
+
+After installing any prerequisites, you know the drill:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+Now What?
+---------
+
+All of the documentation except this file is in the "doc"
+subdirectory. Run "make" there to regenerate the HTML versions of the
+POD documents, and start reading at doc/index.html.
+
+
+Support
+-------
+
+Informal support is available directly from the author (see below) but
+since ``you get what you pay for'' and I'm doing it for free, there
+are of course no guarantees!
+
+In general a better option is to join the Net::Z3950 mailing list at
+ http://www.indexdata.dk/mailman/listinfo/net-z3950
+and discuss in that forum any problems you may encounter. I read this
+list, so I will see your messages; but you may get better help from
+others who have run into similar difficulties.
+
+For those who require it, it's possible to buy professional,
+commercial support for this module, with well-defined support levels
+and response times, from Index Data, in collaboration with whom I
+wrote this module. See
+ http://perl.z3950.org/support/contract.html
+or email <info at indexdata.dk> for details.
+
+
+Author
+------
+
+Mike Taylor <mike at perl.z3950.org>
+ http://www.miketaylor.org.uk/
+
+With lots of help, encouragement, design input, etc. from
+
+Sebastian Hammer <quinn at indexdata.dk> and
+Adam Dickmeiss <adam at indexdata.dk>
+ http://indexdata.dk/
Added: packages/libnet-z3950-perl/branches/upstream/current/Z3950/APDU.pm
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/Z3950/APDU.pm 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/Z3950/APDU.pm 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,781 @@
+# $Header: /home/cvsroot/NetZ3950/Z3950/APDU.pm,v 1.13 2005/04/19 21:36:35 mike Exp $
+
+package Net::Z3950::APDU;
+use strict;
+use vars qw($AUTOLOAD @FIELDS);
+
+
+=head1 NAME
+
+Net::Z3950::APDU - Read-only objects representing decoded Z39.50 APDUs
+
+=head1 SYNOPSIS
+
+I<You probably shouldn't be reading this!>
+
+ package Net::Z3950::APDU::SomeSpecificSortOfAPDU;
+ use Net::Z3950::APDU;
+ @ISA = qw(Net::Z3950::APDU);
+ @FIELDS = qw(names of APDU fields);
+
+=head1 DESCRIPTION
+
+This class provides a trivial base for the various read-only APDUs
+implemented as a part of the Net::Z3950 module. Its role is simply to
+supply named methods providing read-only access to the same-named
+fields. The set of fields is specified by the derived class's
+package-global C<@FIELDS> array.
+
+I<You don't need to understand or use this class in order to use the
+Net::Z3950 module. It's purely an implementation detail. In fact, I
+probably should never even have written this documentation. Forget I
+said anything. Go and read the next section.>
+
+=cut
+
+sub AUTOLOAD {
+ my $this = shift();
+
+ my $class = ref $this;
+ my $fieldname;
+ ($fieldname = $AUTOLOAD) =~ s/.*:://;
+ die "class $class -- field `$fieldname' not defined"
+ if !grep { $_ eq $fieldname } $class->_fields();
+
+ return $this->{$fieldname};
+}
+
+sub DESTROY {
+ # Do nothing. This is only here because on some installations --
+ # I don't really have a handle on what the condition is --
+ # APDU-derived objects try to call DESTROY when they're thrown
+ # away, and that was getting translated into a call to AUTOLOAD,
+ # which was complaining "field `DESTROY' not defined". Now that
+ # we have an explicit no-opping DESTROY, that shouldn't happen.
+ #
+ # The only discussion I have found anywhere of DESTROY/AUTOLOAD
+ # interaction is this thread on comp.lang.perl.moderated:
+ # http://groups.google.com/groups?hl=en&frame=right&th=1bc05ce0aff89451&seekm=86r9qpmvbv.fsf%40lion.plab.ku.dk#link1
+}
+
+
+=head1 SUBCLASSES
+
+The following classes are all trivial derivations of C<Net::Z3950::APDU>,
+and represent specific types of APDU. Each such class is
+characterised by the set of data-access methods it supplies: these are
+listed below.
+
+Each method takes no arguments, and returns the information implied by
+its name. See the relevant sections of the Z39.50 Standard for
+information on the interpretation of this information - for example,
+section 3.2.1 (Initialization Facility) describes the elements of the
+C<Net::Z3950::APDU::InitResponse> class.
+
+I<Actually, you don't need to understand or use any of these classes
+either: they're used internally in the implementation, so this
+documentation is provided as a service to those who will further
+develop this module in the future.>
+
+=cut
+
+
+=head2 Net::Z3950::APDU::InitResponse
+
+ referenceId()
+ preferredMessageSize()
+ maximumRecordSize()
+ result()
+ implementationId()
+ implementationName()
+ implementationVersion()
+
+=cut
+
+package Net::Z3950::APDU::InitResponse;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(referenceId preferredMessageSize maximumRecordSize result
+ implementationId implementationName
+ implementationVersion);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::SearchResponse
+
+ referenceId()
+ resultCount()
+ numberOfRecordsReturned()
+ nextResultSetPosition()
+ searchStatus()
+ resultSetStatus()
+ presentStatus()
+ records()
+ additionalSearchInfo()
+
+=cut
+
+package Net::Z3950::APDU::SearchResponse;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(referenceId resultCount numberOfRecordsReturned
+ nextResultSetPosition searchStatus resultSetStatus
+ presentStatus records additionalSearchInfo);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::ScanResponse
+
+ referenceId()
+ stepSize()
+ scanStatus()
+ numberOfEntriesReturned()
+ positionOfTerm()
+ entries()
+ diag()
+
+The C<diag()> method should be consulted when C<scanStatus()> returns
+6, indicating failure; otherwise, C<entries()> may be consulted.
+
+=cut
+
+package Net::Z3950::APDU::ScanResponse;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(referenceId stepSize scanStatus
+ numberOfEntriesReturned positionOfTerm
+ entries diag);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::PresentResponse
+
+ referenceId()
+ numberOfRecordsReturned()
+ nextResultSetPosition()
+ presentStatus()
+ records()
+
+=cut
+
+package Net::Z3950::APDU::PresentResponse;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(referenceId numberOfRecordsReturned nextResultSetPosition
+ presentStatus records);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::DeleteRSResponse
+
+ referenceId()
+ deleteOperationStatus()
+
+(We don't bother to decode the rest of this APDU at the moment, since
+I bet everyone calls C<Net::Z3950::ResultSet::delete()> in void
+context. If anyone wants more information out of it, we can wire it
+through.)
+
+=cut
+
+package Net::Z3950::APDU::DeleteRSResponse;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(referenceId deleteOperationStatus);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::Close
+
+ referenceId()
+ closeReason()
+ diagnosticInformation()
+
+In addition, this class provides a method of no arguments,
+C<as_text()>, which returns a human-readable string describing the
+reason for the close.
+
+=cut
+
+package Net::Z3950::Close;
+sub Finished { 0 }
+sub Shutdown { 1 }
+sub SystemProblem { 2 }
+sub CostLimit { 3 }
+sub Resources { 4 }
+sub SecurityViolation { 5 }
+sub ProtocolError { 6 }
+sub LackOfActivity { 7 }
+sub PeerAbort { 8 }
+sub Unspecified { 9 }
+
+package Net::Z3950::APDU::Close;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(closeReason diagnosticInformation referenceId);
+sub _fields { @FIELDS };
+
+# render the info as a printable string
+
+sub as_text {
+ my $this = shift;
+ my $text = (
+ qw( Finished Shutdown SystemProblem CostLimit
+ Resources SecurityViolation ProtocolError
+ LackOfActivity PeerAbort Unspecified )
+ )[$this->{closeReason}] || '**Unknown**';
+ $text .= " ($this->{diagnosticInformation})"
+ if defined $this->{diagnosticInformation};
+ $text .= " refid[$this->{referenceId}]"
+ if defined $this->{referenceId};
+
+ $text;
+}
+
+
+=head2 Net::Z3950::APDU::NamePlusRecordList
+
+No methods - just treat as a reference to an array of
+C<Net::Z3950::APDU::NamePlusRecord>
+
+=cut
+
+package Net::Z3950::APDU::NamePlusRecordList;
+
+
+=head2 Net::Z3950::APDU::NamePlusRecord
+
+ databaseName()
+ which()
+ databaseRecord()
+ surrogateDiagnostic()
+ startingFragment()
+ intermediateFragment()
+ finalFragment()
+
+Only one of the last five methods will return anything - you can find
+out which one by inspecting the return value of the C<which()> method,
+which always takes one of the following values:
+
+=over 4
+
+=item *
+
+Net::Z3950::NamePlusRecord::DatabaseRecord
+
+=item *
+
+Net::Z3950::NamePlusRecord::SurrogateDiagnostic
+
+=item *
+
+Net::Z3950::NamePlusRecord::StartingFragment
+
+=item *
+
+Net::Z3950::NamePlusRecord::IntermediateFragment
+
+=item *
+
+Net::Z3950::NamePlusRecord::FinalFragment
+
+=back
+
+When C<which()> is C<Net::Z3950::NamePlusRecord::DatabaseRecord>, the
+object returned from the C<databaseRecord()> method will be a decoded
+Z39.50 EXTERNAL. Its type may be any of the following (and may be
+tested using C<$rec-E<gt>isa('Net::Z3950::Record::Whatever')> if necessary.)
+
+=over 4
+
+=item *
+
+Net::Z3950::Record::SUTRS
+
+=item *
+
+Net::Z3950::Record::GRS1
+
+=item *
+
+Net::Z3950::Record::USMARC and
+similarly, Net::Z3950::Record::UKMARC, Net::Z3950::Record::NORMARC, I<etc>.
+
+=item *
+
+Net::Z3950::Record::XML
+
+=item *
+
+Net::Z3950::Record::HTML
+
+=item *
+
+Net::Z3950::Record::OPAC
+
+I<### others, not yet supported>
+
+=back
+
+=cut
+
+package Net::Z3950::APDU::NamePlusRecord;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+
+ at FIELDS = qw(databaseName which databaseRecord surrogateDiagnostic
+ startingFragment intermediateFragment finalFragment);
+sub _fields { @FIELDS };
+
+# Define the NamePlusRecord class's "which" enumeration, which
+# indicates which of the possible branches contains data (i.e. it's
+# the discriminator for a union.) This must be kept synchronised with
+# the values defined in the header file <yaz/z-core.h>
+package Net::Z3950::NamePlusRecord;
+sub DatabaseRecord { 1 }
+sub SurrogateDiagnostic { 2 }
+sub StartingFragment { 3 }
+sub IntermediateFragment { 4 }
+sub FinalFragment { 5 }
+package Net::Z3950;
+
+
+=head2 Net::Z3950::APDU::SUTRS, Net::Z3950::APDU::USMARC, Net::Z3950::APDU::UKMARC, Net::Z3950::APDU::NORMARC, Net::Z3950::APDU::LIBRISMARC, Net::Z3950::APDU::DANMARC, Net::Z3950::APDU::UNIMARC, Net::Z3950::APDU::MAB
+
+No methods - just treat as an opaque chunk of data.
+
+=cut
+
+package Net::Z3950::APDU::SUTRS;
+package Net::Z3950::APDU::USMARC;
+package Net::Z3950::APDU::UKMARC;
+package Net::Z3950::APDU::NORMARC;
+package Net::Z3950::APDU::LIBRISMARC;
+package Net::Z3950::APDU::DANMARC;
+package Net::Z3950::APDU::UNIMARC;
+package Net::Z3950::APDU::MAB;
+
+
+=head2 Net::Z3950::APDU::TaggedElement;
+
+ tagType()
+ tagValue()
+ tagOccurrence()
+ content()
+
+=cut
+
+package Net::Z3950::APDU::TaggedElement;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(tagType tagValue tagOccurrence content);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::ElementData
+
+ which()
+ numeric()
+ string()
+ oid()
+ subtree()
+
+Only one of the last four methods will return anything - you can find
+out which one by inspecting the return value of the C<which()> method,
+which always takes one of the following values:
+
+=over 4
+
+=item *
+
+Net::Z3950::ElementData::Numeric
+
+=item *
+
+Net::Z3950::ElementData::String
+
+=item *
+
+Net::Z3950::ElementData::OID
+
+=item *
+
+Net::Z3950::ElementData::Subtree
+
+=item *
+
+I<### others, not yet supported>
+
+=back
+
+=cut
+
+package Net::Z3950::APDU::ElementData;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+
+ at FIELDS = qw(which numeric string oid subtree);
+sub _fields { @FIELDS };
+
+# Define the ElementData class's "which" enumeration, which indicates
+# which of the possible branches contains data (i.e. it's the
+# discriminator for a union.) This must be kept synchronised with the
+# values defined in the header file <yaz/z-grs.h> -- NOT <yaz/prt-grs.h>
+package Net::Z3950::ElementData;
+sub Numeric { 1 }
+sub String { 5 }
+sub OID { 7 }
+sub Subtree { 13 }
+package Net::Z3950;
+
+
+=head2 Net::Z3950::APDU::HoldingsData
+
+No methods - just treat as a reference to an array of objects, where
+each object is either an MARC holdings record (of type
+C<Net::Z3950::Record::USMARC> or similar) or a
+C<Net::Z3950::APDU::HoldingsAndCirc>
+
+=cut
+
+package Net::Z3950::APDU::HoldingsData;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::APDU);
+
+
+=head2 Net::Z3950::APDU::HoldingsAndCirc
+
+ typeOfRecord()
+ encodingLevel()
+ format()
+ receiptAcqStatus()
+ generalRetention()
+ completeness()
+ dateOfReport()
+ nucCode()
+ localLocation()
+ shelvingLocation()
+ callNumber()
+ shelvingData()
+ copyNumber()
+ publicNote()
+ reproductionNote()
+ termsUseRepro()
+ enumAndChron()
+ volumes()
+ circulationData()
+
+All but the last two of these have string values, although not
+necessarily human-readable strings. C<volumes()> returns a
+C<Net::Z3950::APDU::Volumes> object (note the plural in the
+type-name), and C<circulationData()> a
+C<Net::Z3950::APDU::CirculationData>.
+
+=cut
+
+package Net::Z3950::APDU::HoldingsAndCirc;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(typeOfRecord encodingLevel format receiptAcqStatus
+ generalRetention completeness dateOfReport nucCode
+ localLocation shelvingLocation callNumber shelvingData
+ copyNumber publicNote reproductionNote termsUseRepro
+ enumAndChron volumes circulationData);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::Volumes
+
+No methods - just treat as a reference to an array of
+C<Net::Z3950::APDU::Volume>
+objects.
+
+=cut
+
+package Net::Z3950::APDU::Volumes;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::APDU);
+
+
+=head2 Net::Z3950::APDU::HoldingsAndCirc
+
+ enumeration()
+ chronology()
+ enumAndChron()
+
+=cut
+
+package Net::Z3950::APDU::Volume;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(enumeration chronology enumAndChron);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::CirculationData
+
+No methods - just treat as a reference to an array of
+C<Net::Z3950::APDU::CircRecord>
+objects.
+
+=cut
+
+package Net::Z3950::APDU::CirculationData;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::APDU);
+
+
+
+=head2 Net::Z3950::APDU::HoldingsAndCirc
+
+ availableNow()
+ availablityDate()
+ availableThru()
+ restrictions()
+ itemId()
+ renewable()
+ onHold()
+ enumAndChron()
+ midspine()
+ temporaryLocation()
+
+=cut
+
+package Net::Z3950::APDU::CircRecord;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(availableNow availablityDate availableThru restrictions
+ itemId renewable onHold enumAndChron midspine
+ temporaryLocation);
+sub _fields { @FIELDS };
+
+=head2 Net::Z3950::APDU::DiagRecs
+
+No methods - just treat as a reference to an array of object
+references. The objects will typically be of class
+C<Net::Z3950::APDU::DefaultDiagFormat>, but careful callers will check
+this, since any kind of EXTERNAL may be provided instead.
+
+=cut
+
+package Net::Z3950::APDU::DiagRecs;
+
+
+=head2 Net::Z3950::APDU::DefaultDiagFormat;
+
+ diagnosticSetId()
+ condition()
+ addinfo()
+
+=cut
+
+package Net::Z3950::APDU::DefaultDiagFormat;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(diagnosticSetId condition addinfo);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::OID
+
+B<No longer exists.>
+Previously this class had no methods - calling code just treated it
+as a reference to an array of integers. However, since the only thing
+anyone (including C<Net::Z3950::Record::GRS1::render()>)
+ever did with it was smush it up into a string with
+
+ join('.', @$oidRef)
+
+we now just return the dot-separated OID string
+I<not blessed into any class>
+(because scalars can't be blessed - only I<references> to scalars,
+and we don't want the extra useless level of indirection).
+
+=cut
+
+package Net::Z3950::APDU::OID;
+
+
+=head2 Net::Z3950::APDU::ListEntries
+
+No methods - just treat as a reference to an array of
+C<Net::Z3950::APDU::Entry>
+
+=cut
+
+package Net::Z3950::APDU::ListEntries;
+
+
+=head2 Net::Z3950::APDU::Entry
+
+ termInfo()
+ surrogateDiagnostic()
+
+Usually, C<termInfo()> returns a scanned term. When it returns an
+undefined value, consult <surrogateDiagnostic()> to find out why.
+
+=cut
+
+package Net::Z3950::APDU::Entry;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(termInfo surrogateDiagnostic);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::TermInfo
+
+ term()
+ globalOccurrences()
+
+I<### Lots more to come here, including displayTerm>
+
+=cut
+
+package Net::Z3950::APDU::TermInfo;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(term globalOccurrences);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::Term
+
+ general()
+ numeric()
+ characterString()
+ oid()
+ dateTime()
+ external()
+ integerAndUnit()
+ null()
+
+At present only ``general'' terms are supported. The value of such a
+term may be obtained by calling <general()>. Terms of other types can
+not be obtained.
+
+=cut
+
+package Net::Z3950::APDU::Term;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+ at FIELDS = qw(general numeric characterString oid
+ dateTime external integerAndUnit null);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::OtherInformation
+
+No methods - just treat as a reference to an array of
+C<Net::Z3950::APDU::OtherInformationUnit>
+
+=cut
+
+package Net::Z3950::APDU::OtherInformation;
+
+=head2 Net::Z3950::APDU::OtherInformationUnit
+
+ which()
+ characterInfo()
+ binaryInfo()
+ externallyDefinedInfo
+ oid()
+
+At present only ``externallyDefinedInfo'' units are supported.
+
+=cut
+
+package Net::Z3950::APDU::OtherInformationUnit;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+
+ at FIELDS = qw(which characterInfo binaryInfo externallyDefinedInfo oid);
+sub _fields { @FIELDS };
+
+# Define the OtherInformationUnit class's "which" enumeration, which
+# indicates which of the possible branches contains data (i.e. it's
+# the discriminator for a union.)
+package Net::Z3950::OtherInformationUnit;
+sub CharacterInfo { 1 }
+sub BinaryInfo { 2 }
+sub ExternallyDefinedInfo { 3 }
+sub Oid { 4 }
+package Net::Z3950;
+
+
+=head2 Net::Z3950::APDU::SearchInfoReport
+
+No methods - just treat as a reference to an array of
+C<Net::Z3950::APDU::SearchInfoReport_s>
+
+=cut
+
+package Net::Z3950::APDU::SearchInfoReport;
+
+
+=head2 Net::Z3950::APDU::SearchInfoReport_s
+
+ fullQuery()
+ subqueryExpression()
+ subqueryCount()
+
+=cut
+
+package Net::Z3950::APDU::SearchInfoReport_s;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+
+ at FIELDS = qw(fullQuery subqueryExpression subqueryCount);
+sub _fields { @FIELDS };
+
+
+=head2 Net::Z3950::APDU::QueryExpression
+
+ which()
+ term()
+ query()
+
+At present only ``term'' query expressions are supported.
+
+=cut
+
+package Net::Z3950::APDU::QueryExpression;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+
+ at FIELDS = qw(which term query);
+sub _fields { @FIELDS };
+
+# Define the QueryExpression class's "which" enumeration, which
+# indicates which of the possible branches contains data (i.e. it's
+# the discriminator for a union.)
+package Net::Z3950::QueryExpression;
+sub Term { 1 }
+sub Query { 2 }
+package Net::Z3950;
+
+
+=head2 Net::Z3950::APDU::QueryExpressionTerm
+
+ queryTerm()
+
+=cut
+
+package Net::Z3950::APDU::QueryExpressionTerm;
+use vars qw(@ISA @FIELDS);
+ at ISA = qw(Net::Z3950::APDU);
+
+ at FIELDS = qw(queryTerm);
+sub _fields { @FIELDS };
+
+
+=head1 AUTHOR
+
+Mike Taylor E<lt>mike at indexdata.comE<gt>
+
+First version Saturday 27th May 2000.
+
+=cut
+
+
+1;
Added: packages/libnet-z3950-perl/branches/upstream/current/Z3950/Connection.pm
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/Z3950/Connection.pm 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/Z3950/Connection.pm 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,1031 @@
+# $Header: /home/cvsroot/NetZ3950/Z3950/Connection.pm,v 1.34 2005/07/27 12:25:44 mike Exp $
+
+package Net::Z3950::Connection;
+use IO::Handle;
+use Event;
+use Errno qw(ECONNREFUSED);
+use strict;
+
+
+=head1 NAME
+
+Net::Z3950::Connection - Connection to a Z39.50 server, with request queue
+
+=head1 SYNOPSIS
+
+ $conn = new Net::Z3950::Connection($hostname, $port);
+ $rs = $conn->search('au=kernighan and su=unix');
+ $sr = $conn->scan('au=kernighan and su=unix');
+ # or
+ $mgr = $conn->manager();
+ $conn = $mgr->wait();
+ if ($mgr->failed()) {
+ die "error " . $conn->errcode() .
+ "( " . $conn->addinfo() . ")" .
+ " in " . Net::Z3950::opstr($conn->errop());
+ }
+
+=head1 DESCRIPTION
+
+A connection object represents an established connection to a
+particular server on a particular port, together with options such as
+the default database in which to search. It maintains a queue of
+outstanding requests (searches executed against it, fetches executed
+against result sets instantiated against it) I<etc.>
+
+=head1 METHODS
+
+=cut
+
+
+=head2 new()
+
+ $conn = new Net::Z3950::Connection($mgr, $host, $port);
+ $conn = new Net::Z3950::Connection($host, $port);
+ $conn = new Net::Z3950::Connection($mgr, "unix", $path);
+ $conn = new Net::Z3950::Connection("unix", $path);
+
+Creates and returns a new connection, under the control of the manager
+I<$mgr>, to the server on the specified I<$host> and I<$port>. If the
+I<$port> argument is omitted, the C<z3950> service is used; if this is
+not defined, port 210 is used.
+
+The manager argument may be omitted, in which
+case, the connection is created under the control of a
+``default manager'', a reference to which may be subsequently
+retrieved with the C<manager()> method. Multiple connections made
+with no explicitly-specified manager in this way will all share the
+same implicit manager. The default manager is initially in
+synchronous mode. If you don't understand what this paragraph is on
+about, you should feel free to ignore it.
+
+Unix-domain socket connections can be made by specifying C<unix> as
+the hostname and the path to the socket file as the port.
+
+If the connection is created in synchronous mode, (or, if the
+constructor call doesn't specify a mode, if the manager controlling
+the new connection is synchronous), then the constructor does not
+return until either the connection is forged or an error occurs in
+trying to do so. (In the latter case, error information is stored in
+the manager structure.) If the connection is asynchronous, then the
+new object is created and returned before the connection is forged;
+this will happen in parallel with subsequent actions.
+
+I<This is a lie: connecting is always done synchronously.>
+
+If a connection cannot be forged, then C<$!> contains an error code
+indicating what went wrong: this may be one of the usual system error
+codes such as ECONNREFUSED (if there is no server running at the
+specified address); alternatively, it may be set to the distinguished
+value -1 if the TCP/IP connection was correctly forged, but the Z39.50
+C<Init> failed.
+
+Any of the standard options (including asynchronous
+mode) may be specified as additional arguments. Specifically:
+
+ $conn = new Net::Z3950::Connection($mgr, $host, $port, async => 1);
+
+Works as expected.
+
+=cut
+
+# PRIVATE to the new() method
+use vars qw($_default_manager);
+
+sub new {
+ my $class = shift();
+ my $mgr = shift();
+ my($host, $port);
+
+ # Explicit manager-reference is optional: was it supplied?
+ if (ref $mgr) {
+ $host = shift();
+ $port = shift();
+ } else {
+ $host = $mgr;
+ $port = shift();
+ $mgr = undef;
+ }
+ $port ||= getservbyname('z3950', 'tcp') || 210;
+ my $addr = "$host:$port";
+
+ if (!defined $mgr) {
+ # Manager either explicitly undefined or not supplied: use the
+ # default global manager -- if it doesn't exist yet, make it.
+ if (!defined $_default_manager) {
+ $_default_manager = new Net::Z3950::Manager()
+ or die "can't create default manager";
+ }
+
+ $mgr = $_default_manager;
+ }
+
+ my $cb;
+ $cb = shift() if ref $_[0] eq 'CODE';
+
+ my $this = bless {
+ mgr => $mgr,
+ host => $host,
+ port => $port,
+ resultSets => [],
+ options => { @_ },
+ refId2cb => {}, # maps reference IDs to callback functions
+ }, $class;
+
+ ### It would be nice if we could find a way to do the DNS lookups
+ # asynchronously, but even the major web browsers don't do it,
+ # so either (A) it's hard, or (B) they're lazy. Oh, or (C) of
+ # course.
+ #
+ my $cs = Net::Z3950::yaz_connect($addr)
+ or return undef; # caller should consult $!
+
+ $this->{cs} = $cs;
+ my $fd = Net::Z3950::yaz_socket($cs);
+ my $sock = new_from_fd IO::Handle($fd, "r+")
+ or die "can't make IO::Handle out of file descriptor";
+ $this->{sock} = $sock;
+
+ $this->{readWatcher} = Event->io(fd => $sock, poll => 'r', data => $this,
+ cb => \&_ready_to_read)
+ or die "can't make read-watcher on socket to $addr";
+
+ $this->{writeWatcher} = Event->io(fd => $sock, poll => 'w', data => $this,
+ parked => 1, cb => \&_ready_to_write)
+ or die "can't make write-watcher on socket to $addr";
+
+ # Arrange to have result-sets on this connection ask for extra records
+ $this->{idleWatcher} = Event->idle(data => $this, repeat => 1, parked => 1,
+ cb => \&Net::Z3950::ResultSet::_idle)
+ or die "can't make idle-watcher on socket to $addr";
+
+ # Generate the INIT request and queue it up for subsequent
+ # dispatch. The standard option names for password and group-ID
+ # (used in authentication) are "pass" and "group" (see v1.4 of the
+ # ZOOM AAPI), but pre-0.39 versions of Net::Z3950 used "password"
+ # and "groupid", so we continue to support use old option names as
+ # fallbacks in order to support old applications.
+ my $errmsg = '';
+ my $pass = $this->option('pass');
+ $pass = $this->option('password') if !defined $pass;
+ my $group = $this->option('group');
+ $group = $this->option('groupid') if !defined $group;
+ my $ir = Net::Z3950::makeInitRequest('init',
+ $this->option('preferredMessageSize'),
+ $this->option('maximumRecordSize'),
+ $this->option('user'),
+ $pass,
+ $group,
+ $this->option('implementationId'),
+ $this->option('implementationName'),
+ $this->option('implementationVersion'),
+ $this->option('charset'),
+ $this->option('language'),
+ $errmsg);
+ die "can't make init request: $errmsg" if !defined $ir;
+
+ $this->_enqueue($ir);
+ $this->{refId2cb}->{'init'} = $cb if defined $cb;
+ $mgr->_register($this);
+
+ if (!$this->option('async')) {
+ $this->expect(Net::Z3950::Op::Init, "init")
+ or return undef; # e.g. ECONNREFUSED
+
+ if (!$this->initResponse()->result()) {
+ warn "checking initResponse";
+ # Avoid having too many references hanging around, or we
+ # end up closing the file twice, as various destructors
+ # are called, and $! gets set to EBADF.
+ undef $sock;
+ $this->close();
+ $! = -1; # special errno value => init failed
+ return undef;
+ }
+ }
+
+ return $this;
+}
+
+
+# PRIVATE to the new() method, invoked as an Event->io callback
+#
+# So far as I can tell from the Event.pm documentation, and a cursory
+# reading of the rather opaque source code, it appears that the return
+# value of callbacks such as this one is ignored.
+#
+sub _ready_to_read {
+ my($event) = @_;
+ my $watcher = $event->w();
+ my $conn = $watcher->data();
+ my $addr = $conn->{host} . ":" . $conn->{port};
+
+ my $reason = 0; # We need to give $reason a value to
+ # avoid a spurious "uninitialized"
+ # warning on the next line, even
+ # though $result is a pure-result
+ # parameter to decodeAPDU()
+ my $apdu = Net::Z3950::decodeAPDU($conn->{cs}, $reason);
+ if (defined $apdu) {
+ my $refId = $conn->_dispatch($apdu, $watcher);
+ if (!defined $refId) {
+ # Unrecognised APDU -- nothing useful to do here, unless
+ # we think die()ing might be helpful?
+ return;
+ }
+
+ my $cb = $conn->{refId2cb}->{$refId};
+ #warn ref($apdu). ": refId='$refId', cb='$cb'";
+ if (defined $cb) {
+ # Application-level callback provided by caller
+ &$cb($conn, $apdu);
+ } else {
+ Event::unloop($conn);
+ }
+ return;
+ }
+
+ if ($reason == Net::Z3950::Reason::EOF) {
+ $conn->{errcode} = 100; # "Unknown error" is pathetic
+ $conn->{addinfo} = "server $addr rudely closed connection";
+ # The "errcode" and "addinfo" are currently not used on Init
+ # failure, which is the only time this is known to happen,
+ # with the server at webcat.camosun.bc.ca:2200/unicorn, so we
+ # also set $!, which is what is supposed to be consulted then.
+ $! = 104; # ECONNRESET on Linux 2.4.18 ### YMMV
+ $watcher->cancel();
+
+ } elsif ($reason == Net::Z3950::Reason::Incomplete) {
+ # Some bytes have been read into the COMSTACK (which maintains
+ # its own state), but not enough yet to make a whole APDU. We
+ # have nothing to do here -- just return to the event loop and
+ # wait until we get called again with the next chunk.
+
+ } elsif ($reason == Net::Z3950::Reason::Malformed) {
+ $conn->{errcode} = 1001; # Malformed APDU
+ $conn->{addinfo} = "client couldn't decode server response";
+ $watcher->cancel();
+
+ } elsif ($reason == Net::Z3950::Reason::BadAPDU) {
+ # This just means that although the APDU was well-formed, it's
+ # not one that we unrecognise -- for example, a Segment
+ # request. It's tempting to paper over the crack, but I think
+ # the honest thing to do at this point is croak.
+ $conn->{errcode} = 100; # "Unknown error" is a bit feeble
+ $conn->{addinfo} = "got APDU of unsupported type";
+ $watcher->cancel();
+
+ } elsif ($reason == Net::Z3950::Reason::Error) {
+ $watcher->cancel();
+ die "[$addr] system error ($!)\n";
+
+ } else {
+ # Should be impossible
+ die "decodeAPDU() failed for unknown reason: $reason\n";
+ }
+}
+
+
+# PRIVATE to the _ready_to_read() function
+#
+# Return referenceId of returned APDU or undef if unsupported.
+#
+sub _dispatch {
+ my $this = shift();
+ my($apdu, $watcher) = @_;
+ my $addr = $this->{host} . ":" . $this->{port};
+
+ if ($apdu->isa('Net::Z3950::APDU::Close')) {
+ # ### This should be handled properly -- we should send a
+ # reply, then drop the connection. Is there any better way to
+ # notify the user than just dying? Should userland code be
+ # allowed to handle this? I don't know -- DAPM.
+ $watcher->cancel();
+ die "[$addr] received close request: " . $apdu->as_text() . "\n";
+
+ } elsif ($apdu->isa('Net::Z3950::APDU::InitResponse')) {
+ $this->{op} = Net::Z3950::Op::Init;
+ $this->{initResponse} = $apdu;
+ return $apdu->referenceId();
+
+ } elsif ($apdu->isa('Net::Z3950::APDU::SearchResponse')) {
+ $this->{op} = Net::Z3950::Op::Search;
+ $this->{searchResponse} = $apdu;
+ my $which = $apdu->referenceId();
+ defined $which or die "no reference Id in search response";
+ my $rs = $this->{resultSets}->[$which]
+ and die "reference to existing result set";
+ $rs = _new Net::Z3950::ResultSet($this, $which, $apdu);
+ $this->{resultSets}->[$which] = $rs;
+ $this->{resultSet} = $rs;
+ ### Should handle piggy-backed records and NSDs
+ return $which;
+
+ } elsif ($apdu->isa('Net::Z3950::APDU::ScanResponse')) {
+ $this->{op} = Net::Z3950::Op::Scan;
+ $this->{scanResponse} = $apdu;
+ my $which = $apdu->referenceId();
+ defined $which or die "no reference Id in scan response";
+ $this->{scanSet} = _new Net::Z3950::ScanSet($this, $apdu);
+ return $which;
+
+ } elsif ($apdu->isa('Net::Z3950::APDU::PresentResponse')) {
+ $this->{op} = Net::Z3950::Op::Get;
+ $this->{presentResponse} = $apdu;
+ # refId is of the form <rsindex>-<junk>
+ my $which = $apdu->referenceId();
+ defined $which or die "no reference Id in present response";
+ # Extract initial portion, local result-set index, from refId
+ $which =~ s/-.*//;
+ my $rs = $this->{resultSets}->[$which]
+ or die "reference to non-existent result set";
+ $rs->_add_records($apdu);
+ $this->{resultSet} = $rs;
+ return $apdu->referenceId();
+
+ } elsif ($apdu->isa('Net::Z3950::APDU::DeleteRSResponse')) {
+ $this->{op} = Net::Z3950::Op::DeleteRS;
+ $this->{deleteRSResponse} = $apdu;
+ # refId is of the form <rsindex>-delete-0
+ my $which = $apdu->referenceId();
+ defined $which or die "no reference Id in deleteRS response";
+ $which =~ s/-.*//;
+ my $rs = $this->{resultSets}->[$which]
+ or die "reference to non-existent result set";
+ $this->{resultSets}->[$which] = undef; # drop reference to RS
+ $this->{deleteStatus} = $apdu->deleteOperationStatus();
+ return $apdu->referenceId();
+
+ } else {
+ die "[$addr] ignored unsupported APDU: $apdu\n";
+ }
+}
+
+
+# PRIVATE to the new() method, invoked as an Event->io callback
+sub _ready_to_write {
+ my($event) = @_;
+ my $watcher = $event->w();
+ my $conn = $watcher->data();
+ my $addr = $conn->{host} . ":" . $conn->{port};
+
+ if (!$conn->{queued}) {
+ die "Huh? _ready_to_write() called with nothing queued\n";
+ }
+
+ # We bung as much of the data down the socket as we can, and keep
+ # hold of whatever's left.
+ my $nwritten = Net::Z3950::yaz_write($conn->{cs}, $conn->{queued});
+ if ($nwritten < 0 && $! == ECONNREFUSED) {
+ $conn->_destroy();
+ Event::unloop(undef);
+ return;
+ } elsif ($nwritten < 0) {
+ $watcher->cancel();
+ die "[$addr] yaz_write() failed ($!): closing connection\n";
+ }
+
+ if ($nwritten == 0) {
+ # Should be impossible: we only get called when ready to write
+ die "[$addr] write zero bytes (shouldn't happen): never mind\n";
+ }
+
+ $conn->{queued} = substr($conn->{queued}, $nwritten);
+ if (!$conn->{queued}) {
+ # Don't bother me with select() hits when we have nothing to write
+ $watcher->stop();
+ }
+}
+
+
+# PRIVATE to the _ready_to_write() function.
+#
+# Destroys a connection object when it turns out that the connection
+# didn't get forged after all (yaz_write() fails with ECONNREFUSED,
+# indicating a failed asynchronous connection.)
+#
+sub _destroy {
+ my $this = shift();
+
+ # Do nothing for now: I'm not sure that this is the right thing.
+}
+
+=head2 option()
+
+ $value = $conn->option($type);
+ $value = $conn->option($type, $newval);
+
+Returns I<$conn>'s value of the standard option I<$type>, as
+registered in I<$conn> itself, in the manager which controls it, or in
+the global defaults.
+
+If I<$newval> is specified, then it is set as the new value of that
+option in I<$conn>, and the option's old value is returned.
+
+=cut
+
+sub option {
+ my $this = shift();
+ my($type, $newval) = @_;
+
+ my $value = $this->{options}->{$type};
+ if (!defined $value) {
+ $value = $this->{mgr}->option($type);
+ }
+ if (defined $newval) {
+ $this->{options}->{$type} = $newval;
+ }
+ return $value
+}
+
+
+=head2 manager()
+
+ $mgr = $conn->manager();
+
+Returns a reference to the manager controlling I<$conn>. If I<$conn>
+was created with an explicit manager, then this method will always
+return that function; otherwise, it returns a reference to the single
+global ``default manager'' shared by all other connections.
+
+=cut
+
+sub manager {
+ my $this = shift();
+
+ return $this->{mgr};
+}
+
+
+=head2 startSearch()
+
+ $conn->startSearch($srch);
+ $conn->startSearch(-ccl => 'au=kernighan and su=unix');
+ $conn->startSearch(-prefix => '@and @attr 1=1 kernighan @attr 1=21 unix');
+ $conn->startSearch('@and @attr 1=1 kernighan @attr 1=21 unix');
+
+Inititiates a new search against the Z39.50 server to which I<$conn>
+is connected. Since this can never fail (:-), it C<die()s> if
+anything goes wrong. But that will never happen. (``Surely the odds
+of that happening are million to one, doctor?'')
+
+The query itself can be specified in a variety of ways:
+
+=over 4
+
+=item *
+
+A C<Net::Z3950::Query> object may be passed in.
+
+=item *
+
+A query-type option may be passed in, together with the query string
+itself as its argument. Currently recognised query types are C<-ccl>
+(using the standard CCL query syntax, interpreted by the server),
+C<-ccl2rpn> (CCL query compiled by the client into a type-1 query),
+C<-prefix> (using Index Data's prefix query notation, described at
+http://indexdata.dk/yaz/doc/tools.php#PQF )
+and C<-cql> (passing a CQL query straight through to the server).
+
+=item *
+
+A query string alone may be passed in. In this case, it is
+interpreted according to the query type previously established as a
+default for I<$conn> or its manager.
+
+=back
+
+The various query types are described in more detail in the
+documentation of the C<Net::Z3950::Query> class.
+
+I<### The Query class does not yet, and might never, exist.>
+
+Some broken Z39.50 server will fault a search but not provide any
+diagnostic records. The correct fix for this problem is of course to
+poke the providers of those servers in the back of the knee with a
+teaspoon until they fix their products. But since this is not always
+practical, C<Net::Z3950> provides a dummy diagnostic record in this
+case, with error-code 3 (``unsupported search'') and additional
+information set to ``no diagnostic records supplied by server''.
+
+=cut
+
+# PRIVATE to the startSearch() and startScan() methods
+my %_queryTypes = (
+ prefix => Net::Z3950::QueryType::Prefix,
+ ccl => Net::Z3950::QueryType::CCL,
+ ccl2rpn => Net::Z3950::QueryType::CCL2RPN,
+ cql => Net::Z3950::QueryType::CQL,
+);
+
+sub startSearch {
+ my $this = shift();
+ my $query = shift();
+ my($type, $value);
+
+ if (ref $query) {
+ ### Huh? We don't actually have a *::Query type!
+ $type = $query->type();
+ $value = $query->value();
+ } else {
+ # Must be either (-querytype querystring) or just querystring
+ if ($query =~ /^-/) {
+ ($type = $query) =~ s/^-//;
+ $value = shift();
+ } else {
+ $type = $this->option('querytype');
+ $value = $query;
+ }
+ $query = undef;
+ }
+
+ my $queryType = $_queryTypes{$type};
+ die "undefined query type '$type'" if !defined $queryType;
+
+ # Generate the SEARCH request and queue it up for subsequent dispatch
+ my $rss = $this->{resultSets};
+ my $nrss = @$rss;
+ my $errmsg = '';
+ my $sr = Net::Z3950::makeSearchRequest($nrss,
+ $this->option('smallSetUpperBound'),
+ $this->option('largeSetLowerBound'),
+ $this->option('mediumSetPresentNumber'),
+ $this->option('namedResultSets') ?
+ $nrss : 'default', # result-set name
+ $this->option('databaseName'),
+ $this->option('smallSetElementSetName'),
+ $this->option('mediumSetElementSetName'),
+ $this->preferredRecordSyntax(),
+ $queryType, $value, $errmsg);
+ die "can't make search request: $errmsg" if !defined $sr;
+ $rss->[$nrss] = 0; # placeholder
+
+ $this->_enqueue($sr);
+
+ # Callback for asynchronous notification
+ my $cb = shift();
+ #warn "startSearch: cb='$cb'";
+ $this->{refId2cb}->{$nrss} = $cb if defined $cb;
+}
+
+
+=head2 startScan()
+
+ $conn->startScan($scan);
+ $conn->startScan(-prefix => '@attr 1=5 programming');
+ $conn->startScan('@attr 1=5 programming');
+
+Executes a scan against the Z39.50 server to which I<$conn> is
+connected. The scan parameters are represented by a query which is
+analysed for the term itself and the access-point in which it should
+occur. This query can be specified in the same ways as for
+C<startSearch()>.
+
+=cut
+
+sub startScan {
+ my $this = shift();
+ my $query = shift();
+ my($type, $value);
+
+ ### Too much shared code with startSearch()
+ if (ref $query) {
+ ### Huh? We don't actually have a *::Query type!
+ $type = $query->type();
+ $value = $query->value();
+ } else {
+ # Must be either (-querytype querystring) or just querystring
+ if ($query =~ /^-/) {
+ ($type = $query) =~ s/^-//;
+ $value = shift();
+ } else {
+ $type = $this->option('querytype');
+ $value = $query;
+ }
+ $query = undef;
+ }
+
+ my $queryType = $_queryTypes{$type};
+ die "undefined query type '$type'" if !defined $queryType;
+
+ # Generate the SCAN request and queue it up for subsequent dispatch
+ my $errmsg = '';
+ my $sr = Net::Z3950::makeScanRequest("scan",
+ $this->option('databaseName'),
+ $this->option('stepSize'),
+ $this->option('numberOfEntries'),
+ $this->option('responsePosition'),
+ $queryType,
+ $value,
+ $errmsg);
+ die "can't make scan request: $errmsg" if !defined $sr;
+
+ $this->_enqueue($sr);
+
+ # Callback for asynchronous notification
+ my $cb = shift();
+ $this->{refId2cb}->{'scan'} = $cb if defined $cb;
+}
+
+
+# Decode record-syntax strings into enumerators
+sub preferredRecordSyntax {
+ my $this = shift();
+
+ my $str = $this->option("preferredRecordSyntax");
+ return $str
+ if $str =~ /^\d+$/;
+
+ $str =~ s/-//;
+ $str = uc($str);
+ my $val = $Net::Z3950::RecordSyntax::map{$str};
+ die "unrecognised record-syntax name '$str'"
+ if !defined $val;
+
+ return $val;
+}
+
+
+# PRIVATE to the new(), startSearch() and startScan() methods
+sub _enqueue {
+ my $this = shift();
+ my($msg) = @_;
+
+ $this->{queued} .= $msg;
+ $this->{writeWatcher}->start();
+}
+
+
+=head2 search()
+
+ $rs = $conn->search($srch);
+
+This method performs a blocking search, returning a reference
+to the result set generated by the server. It takes the same
+arguments as C<startSearch()>
+
+=cut
+
+# ### Is there a mistake in the interface here? At fetch-time we
+# have a single ResultSet method, record(), which either starts
+# an operations or starts and finishes it, depending on whether
+# we're in async or synchronous mode. Maybe in the same way, we
+# should have a single search() method here, which behaves like
+# startSearch() when used on an asynchronous connection. More
+# likely, it's the fetch interface that's broken, and should
+# have separate sync and async methods, so that we can discard
+# the notion of a mode completely.
+#
+sub search {
+ my $this = shift();
+
+ $this->startSearch(@_);
+ if (!$this->expect(Net::Z3950::Op::Search, "search")) {
+ return undef;
+ }
+
+ # We've established that the event was a search response on $this, so:
+ return $this->resultSet();
+}
+
+
+=head2 scan()
+
+ $sr = $conn->scan($scan);
+
+This method performs a blocking scan, returning a reference
+to the scan result generated by the server. It takes the same
+arguments as C<startScan()>
+
+The returned structure is a C<Net::Z3950::APDU::ScanResponse> which
+can be pulled apart by inspection. That may not be the nicest
+possible interface.
+
+=cut
+
+sub scan {
+ my $this = shift();
+
+ $this->startScan(@_);
+ if (!$this->expect(Net::Z3950::Op::Scan, "scan")) {
+ return undef;
+ }
+
+ return $this->scanSet();
+}
+
+
+# Private method, shared with ResultSet.pm but not available to client
+# code. Used to implement synchronous operations on top of async
+# ones: waits for something to happen on $conn's manager, checks that
+# the event is on the right connection, and is the expected kind of
+# operation. Return 1 or undef for success or failure.
+#
+sub expect {
+ my $this = shift();
+ my($op, $opname) = @_;
+
+ my $conn = $this->manager()->wait();
+ # Error not associated with a connection, e.g. ECONNREFUSED
+ return undef
+ if !defined $conn;
+
+ ### We would prefer just to ignore any events on connections other
+ # than this one, but there isn't a way to do this (unless we
+ # invent one, storing other-connection events until they're
+ # requested); so, for now, you shouldn't mix synchronous and
+ # asynchronous calls unless the async ones nominate a callback.
+ die "expect() returned wrong connection!"
+ if $conn != $this;
+
+ # Error code and addinfo are already available from $this
+ return undef
+ if $this->op == Net::Z3950::Op::Error;
+
+ ### Again, we'd like to ignore this event, leaving it lying around
+ # for later; but there's no way to do it, so this has to be a
+ # fatal error.
+ die "expect() got wrong op (expected $opname)"
+ if $this->op() != $op;
+
+ return 1;
+}
+
+
+
+=head2 op()
+
+ op = $conn->op();
+ if (op == Net::Z3950::Op::Search) { # ...
+
+When a connection has been returned from the C<Net::Z3950::Manager> class's
+C<wait()> method, it's known that I<something> has happened to it.
+This method may then be called to find out what. It returns one of
+the following values:
+
+=over 4
+
+=item C<Net::Z3950::Op::Error>
+
+An error occurred. The details may be obtained via the C<errcode()>,
+C<addinfo()> and C<errop()> methods described below.
+
+=item C<Net::Z3950::Op::Init>
+
+An init response was received. The response object may be obtained
+via the C<initResponse()> method described below.
+
+=item C<Net::Z3950::Op::Search>
+
+A search response was received. The result set may be obtained via
+the C<resultSet()> method described below, or the raw APDU object may
+be obtained via C<searchResponse()>.
+
+=item C<Net::Z3950::Op::Get>
+
+One or more result-set records have become available. They may be
+obtained via the C<record()> method of the appropriate result set.
+
+=item C<Net::Z3950::Op::Scan>
+
+A scan response was received. The scan-set may be obtained via the
+C<scanSet()> method described below, or the raw APDU object may be
+obtained via C<scanResponse()>.
+
+=back
+
+=cut
+
+sub op {
+ my $this = shift();
+
+ my $op = $this->{op};
+ die "Net::Z3950::Connection::op() called when no op is stored"
+ if !defined $op;
+
+ return $op;
+}
+
+
+=head2 errcode(), addinfo(), errop(), errmsg()
+
+ if ($conn->op() == Net::Z3950::Op::Error) {
+ print "error number: ", $conn->errcode(), "\n";
+ print "error message: ", $conn->errmsg(), "\n";
+ print "additional info: ", $conn->errcode(), "\n";
+ print "in function: ", Net::Z3950::opstr($conn->errop()), "\n";
+ }
+
+When an error is known to have occurred on a connection, the error
+code (from the BIB-1 diagnosic set) can be retrieved via the
+C<errcode()> method, any additional information via the C<addinfo()>
+method, and the operation that was being attempted when the error
+occurred via the C<errop()> method. (The error operation returned
+takes one of the values that may be returned from the C<op()> method.)
+
+The meanings of the BIB-1 diagnostics are described at on the Z39.50
+Maintenance Agency web-site at
+http://lcweb.loc.gov/z3950/agency/defns/bib1diag.html
+
+As a convenience, C<$conn->errmsg()> is equivalent to
+C<Net::Z3950::errstr($conn->errcode())>.
+
+=cut
+
+sub errcode {
+ my $this = shift();
+ return $this->{errcode};
+}
+
+sub addinfo {
+ my $this = shift();
+ return $this->{addinfo};
+}
+
+sub errop {
+ my $this = shift();
+ return $this->{errop};
+}
+
+sub errmsg {
+ my $this = shift();
+ return Net::Z3950::errstr($this->errcode());
+}
+
+
+=head2 initResponse()
+
+ if ($op == Net::Z3950::Op::Init) {
+ $rs = $conn->initResponse();
+
+When a connection is known to have received an init response, the
+response may be accessed via the connection's C<initResponse()>
+method.
+
+=cut
+
+sub initResponse {
+ my $this = shift();
+ die "not init response" if $this->op() != Net::Z3950::Op::Init;
+ return $this->{initResponse};
+}
+
+
+=head2 searchResponse(), resultSet()
+
+ if ($op == Net::Z3950::Op::Search) {
+ $sr = $conn->searchResponse();
+ $rs = $conn->resultSet();
+
+When a connection is known to have received a search response, the
+response may be accessed via the connection's C<searchResponse()>, and
+the search result may be accessed via the connection's C<resultSet()>
+method.
+
+=cut
+
+sub searchResponse {
+ my $this = shift();
+ die "not search response" if $this->op() != Net::Z3950::Op::Search;
+ return $this->{searchResponse};
+}
+
+sub resultSet {
+ my $this = shift();
+ die "not search response" if $this->op() != Net::Z3950::Op::Search;
+ return $this->{resultSet};
+}
+
+
+=head2 scanResponse(), scanSet()
+
+ if ($op == Net::Z3950::Op::Scan) {
+ $sr = $conn->scanResponse();
+ $ss = $conn->scanSet();
+
+When a connection is known to have received a scan response, the
+response may be accessed via the connection's C<scanResponse()>, and
+the scan-set may be accessed via the connection's C<scanSet()>
+method.
+
+=cut
+
+sub scanResponse {
+ my $this = shift();
+ die "not scan response" if $this->op() != Net::Z3950::Op::Scan;
+ return $this->{scanResponse};
+}
+
+sub scanSet {
+ my $this = shift();
+ die "not scan response" if $this->op() != Net::Z3950::Op::Scan;
+ return $this->{scanSet};
+}
+
+
+=head2 resultSets()
+
+ @rs = $conn->resultSets();
+
+Returns a list of all the result sets that have been created across
+the connection I<$conn> and have not subsequently been deleted.
+
+=cut
+
+sub resultSets {
+ my $this = shift();
+
+ return @{$this->{resultSets}};
+}
+
+
+=head2 name()
+
+ print $conn->name();
+
+Returns a short string which can be used as the connection's "name" in
+text output.
+
+=cut
+
+sub name {
+ my $this = shift();
+
+ return $this->{host} . ':' . $this->{port};
+}
+
+
+=head2 close()
+
+ $conn->close();
+
+This lets the C<Net::Z3950> module know that you no longer want to use
+C<$conn> so it can be closed. It would be nice if this could be done
+implicitly when C<$conn> goes out of scope, as in:
+
+ {
+ $conn = new Net::Z3950::Connection($host, $port);
+ $rs = $conn->search($query);
+ print "found ", $rs->size(), " records\n";
+ }
+
+But in general this won't work, because C<$conn> is not the only
+reference to the connection object: when it goes out of scope, the
+connection is not destroyed because its manager still holds a
+reference to it. So use C<$conn->close()> (just before the close
+brace in the example above) to let the connection know it's done with.
+
+=cut
+
+sub close {
+ my $this = shift();
+
+ my $mgr = delete $this->{mgr};
+ $mgr->forget($this) if defined $mgr; ### but it should always be!
+
+ $this->{idleWatcher}->cancel() if defined $this->{idleWatcher};
+ $this->{readWatcher}->cancel() if defined $this->{readWatcher};
+ $this->{writeWatcher}->cancel() if defined $this->{writeWatcher};
+
+ # ### for a V.3 connection, we should really send a closeRequest
+ # and await a closeResponse, but thats a lot of extra coding effort
+ # for very little gain. A server that can't cope with an
+ # abrupty-severed connection isn't going to last for long in the real
+ # world....
+
+ if (defined $this->{cs}) {
+ Net::Z3950::yaz_close($this->{cs});
+ }
+
+ # lots of the elements of %$this directly or indirectly contain
+ # copies of $this. By deleting all elements from the hash, we hope
+ # to break all circular references.
+
+ %$this = ();
+ $this->{closed} = 1;
+}
+
+
+sub DESTROY {
+ my $this = shift();
+
+ #warn "destroying Net::Z3950 Connection $this";
+
+ $this->close() unless $this->{closed};
+
+}
+
+
+=head1 AUTHOR
+
+Mike Taylor E<lt>mike at indexdata.comE<gt>
+
+First version Tuesday 23rd May 2000.
+
+=head1 SEE ALSO
+
+C<Net::Z3950::Query>
+
+=cut
+
+1;
Added: packages/libnet-z3950-perl/branches/upstream/current/Z3950/Manager.pm
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/Z3950/Manager.pm 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/Z3950/Manager.pm 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,355 @@
+# $Id: Manager.pm,v 1.25 2004/11/01 09:12:23 mike Exp $
+
+package Net::Z3950::Manager;
+use Event;
+use strict;
+
+
+=head1 NAME
+
+Net::Z3950::Manager - State manager for multiple Z39.50 connections.
+
+=head1 SYNOPSIS
+
+ $mgr = new Net::Z3950::Manager(async => 1);
+ $conn = $mgr->connect($hostname, $port);
+ # Set up some more connections, then:
+ while ($conn = $mgr->wait()) {
+ # Handle message on $conn
+ }
+
+=head1 DESCRIPTION
+
+A manager object encapsulates the Net::Z3950 module's global state -
+preferences for search parsing, preferred record syntaxes, compiled
+configuration files, I<etc.> - as well as a list of references to all
+the open connections. It main role is to handle multiplexing between
+the connections that are opened on it.
+
+We would normally expect there to be just one manager object in a
+program, but I suppose there's no reason why you shouldn't make more
+if you want.
+
+Simple programs - those which therefore have no requirement for
+multiplexing, perhaps because they connect only to a single server -
+do not need explicitly to create a manager at all: an anonymous
+manager is implicitly created along with the connection.
+
+=head1 METHODS
+
+=cut
+
+
+# PRIVATE for debugging
+sub warnconns {
+ return; # Don't emit this debugging output
+ my($this) = shift;
+ my($label, @msg) = @_;
+
+ my $c = $this->{connections};
+ my $n = @$c;
+ warn "$label: $this has $n connections ($c) = { " .
+ join(", ", map { "'$_'" } @$c) . " } @msg";
+
+}
+
+
+=head2 new()
+
+ $mgr = new Net::Z3950::Manager();
+
+Creates and returns a new manager. Any of the standard options may be
+specified as arguments; in addition, the following manager-specific
+options are recognised:
+
+=over 4
+
+=item async
+
+This is 0 (false) by default, and may be set to 1 (true). The mode
+affects various details of subsequent behaviour - for example, see the
+description of the C<Net::Z3950::Connection> class's C<new()> method.
+
+=back
+
+=cut
+
+sub new {
+ my $class = shift();
+ # No additional arguments except options
+
+ my $this = bless {
+ connections => [],
+ options => { @_ },
+ }, $class;
+ $this->warnconns("creation");
+ return $this;
+}
+
+
+=head2 option()
+
+ $value = $mgr->option($type);
+ $value = $mgr->option($type, $newval);
+
+Returns I<$mgr>'s value of the standard option I<$type>, as registered
+in I<$mgr> or in the global defaults.
+
+If I<$newval> is specified, then it is set as the new value of that
+option in I<$mgr>, and the option's old value is returned.
+
+=cut
+
+sub option {
+ my $this = shift();
+ my($type, $newval) = @_;
+
+ my $value = $this->{options}->{$type};
+ if (!defined $value) {
+ $value = _default($type);
+ }
+ if (defined $newval) {
+ $this->{options}->{$type} = $newval;
+ }
+ return $value;
+}
+
+# PRIVATE to the option() method
+#
+# This function specifies the hard-wired global defaults used when
+# constructors and the option() method do not override them.
+#
+# ### Should have POD documentation for these options. At the
+# moment, the only place they're described is in the tutorial.
+#
+sub _default {
+ my($type) = @_;
+
+ # Used in Net::Z3950::Manager::wait()
+ return undef if $type eq 'die_handler';
+ return undef if $type eq 'timeout';
+
+ # Used in Net::Z3950::ResultSet::record() to determine whether to wait
+ return 0 if $type eq 'async';
+ return 'sync' if $type eq 'mode'; # backward-compatible old option
+
+ # Used in Net::Z3950::Connection::new() (for INIT request)
+ # (Values are mostly derived from what yaz-client does.)
+ return 1024*1024 if $type eq 'preferredMessageSize';
+ return 1024*1024 if $type eq 'maximumRecordSize';
+ return undef if $type eq 'user';
+ return undef if $type eq 'pass';
+ return undef if $type eq 'password'; # backward-compatible
+ return undef if $type eq 'group';
+ return undef if $type eq 'groupid'; # backward-compatible
+ # (Compare the next three values with those in "yaz/zutil/zget.c".
+ # The standard doesn't give much help, just saying:
+ # 3.2.1.1.6 Implementation-id, Implementation-name, and
+ # Implementation-version -- The request or response may
+ # optionally include any of these three parameters. They are,
+ # respectively, an identifier (unique within the client or
+ # server system), descriptive name, and descriptive version, for
+ # the origin or target implementation. These three
+ # implementation parameters are provided solely for the
+ # convenience of implementors, for the purpose of distinguishing
+ # implementations.
+ # )
+ return 'Mike Taylor (id=169)' if $type eq 'implementationId';
+ return 'Net::Z3950.pm (Perl)' if $type eq 'implementationName';
+ return $Net::Z3950::VERSION if $type eq 'implementationVersion';
+ return undef if $type eq 'charset';
+ return undef if $type eq 'language';
+
+ # Used in Net::Z3950::Connection::startSearch()
+ return 'prefix' if $type eq 'querytype';
+ return 'Default' if $type eq 'databaseName';
+ return 0 if $type eq 'smallSetUpperBound';
+ return 1 if $type eq 'largeSetLowerBound';
+ return 0 if $type eq 'mediumSetPresentNumber';
+ return 'F' if $type eq 'smallSetElementSetName';
+ return 'B' if $type eq 'mediumSetElementSetName';
+ return "GRS-1" if $type eq 'preferredRecordSyntax';
+
+ # Used in Net::Z3950::Connection::startScan()
+ return 1 if $type eq 'responsePosition';
+ return 0 if $type eq 'stepSize';
+ return 20 if $type eq 'numberOfEntries';
+
+ # Used in Net::Z3950::ResultSet::makePresentRequest()
+ return 'B' if $type eq 'elementSetName';
+
+ # Assume the server's not brain-dead unless we're told otherwise
+ return 1 if $type eq 'namedResultSets';
+
+ # etc.
+
+ # Otherwise it's an unknown option.
+ return undef;
+}
+
+
+=head2 connect()
+
+ $conn = $mgr->connect($hostname, $port);
+
+Creates a new connection under the control of the manager I<$mgr>.
+The connection will be forged to the server on the specified I<$port>
+of <$hostname>.
+
+Additional standard options may be specified after the I<$port>
+argument.
+
+(This is simply a sugar function to C<Net::Z3950::Connection->new()>)
+
+=cut
+
+sub connect {
+ my $this = shift();
+ my($hostname, $port, @other_args) = @_;
+
+ # The "indirect object" notation "new Net::Z3950::Connection" fails if
+ # we use it here, because we've not yet seen the Connection
+ # module (Net::Z3950.pm use's Manager first, then Connection). It gets
+ # mis-parsed as an application of the new() function to the result
+ # of the Connection() function in the Net::Z3950 package (I think) but
+ # that error message is immediately further obfuscated by the
+ # autoloader (thanks for that), which complains "Can't locate
+ # auto/Net::Z3950/Connection.al in @INC". It took me a _long_ time to
+ # grok this ...
+ return Net::Z3950::Connection->new($this, $hostname, $port, @other_args);
+}
+
+
+=head2 wait()
+
+ $conn = $mgr->wait();
+
+Waits for an event to occur on one of the connections under the
+control of I<$mgr>, yielding control to any other event handlers that
+may have been registered with the underlying event loop.
+
+When a suitable event occurs - typically, a response is received to an
+earlier INIT, SEARCH or PRESENT - the handle of the connection on
+which it occurred is returned: the handle can be further interrogated
+with its C<op()> and related methods.
+
+If the wait times out (only possible if the manager's C<timeout>
+option has been set), then C<wait()> returns an undefined value.
+
+=cut
+
+sub wait {
+ my $this = shift();
+
+ # The next line prevents the Event module from catching our die()
+ # calls and turning them into warnings sans bathtub. By
+ # installing this handler, we can get proper death back.
+ #
+ ### This is not really the right place to do this, but then where
+ # is? There's no single main()-like entry-point to this
+ # library, so we may as well set Event's die()-handler just
+ # before we hand over control.
+ my $handler = $this->option('die_handler');
+ $Event::DIED = defined $handler ? $handler :
+ \&Event::verbose_exception_handler;
+
+ my $timeout = $this->option("timeout");
+ # Stupid Event::loop() makes a distinction between undef and not there
+ my $conn = defined $timeout ? Event::loop($timeout) : Event::loop();
+ return ref $conn ? $conn : undef;
+}
+
+
+# PRIVATE to the Net::Z3950::Connection module's new() method
+sub _register {
+ my $this = shift();
+ my($conn) = @_;
+
+ $this->warnconns("pre-register", "adding $conn");
+ push @{$this->{connections}}, $conn;
+ $this->warnconns("post-register", "added $conn");
+}
+
+
+=head2 connections()
+
+ @conn = $mgr->connections();
+
+Returns a list of all the connections that have been opened under the
+control of the manager I<$mgr> and have not subsequently been closed.
+
+=cut
+
+sub _UNUSED_connections {
+ my $this = shift();
+
+ return @{$this->{connections}};
+}
+
+=head2 resultSets()
+
+ @rs = $mgr->resultSets();
+
+Returns a list of all the result sets that have been created across
+the connections associated with the manager I<$mgr> and have not
+subsequently been deleted.
+
+=cut
+
+sub resultSets {
+ my $this = shift();
+
+ my @rs;
+
+ foreach my $conn ($this->connections()) {
+ push @rs, @{$conn->{resultSets}};
+ }
+
+ return @rs;
+}
+
+
+### PRIVATE to the Net::Z3950::Connection::close() method.
+sub forget {
+ my $this = shift();
+ my($conn) = @_;
+
+ my $connections = $this->{connections};
+ my $n = @$connections;
+ $this->warnconns("forget()", "looking for $conn");
+ for (my $i = 0; $i < $n; $i++) {
+ if (defined $connections->[$i] && $connections->[$i] eq $conn) {
+ $this->warnconns("pre-splice", "forgetting $i of $n");
+ splice @{ $this->{connections} }, $i, 1;
+ $this->warnconns("post-splice", "forgot $i of $n");
+ return;
+ }
+ }
+
+ # This happens far too often (why?) to be allowed
+ #die "$this can't forget $conn";
+}
+
+
+sub DESTROY {
+ my $this = shift();
+
+ #warn "destroying Net::Z3950 Connection $this";
+}
+
+
+=head1 AUTHOR
+
+Mike Taylor E<lt>mike at indexdata.comE<gt>
+
+First version Tuesday 23rd May 2000.
+
+=head1 SEE ALSO
+
+List of standard options.
+
+Discussion of the Net::Z3950 module's use of the Event module.
+
+=cut
+
+1;
Added: packages/libnet-z3950-perl/branches/upstream/current/Z3950/Record.pm
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/Z3950/Record.pm 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/Z3950/Record.pm 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,478 @@
+# $Header: /home/cvsroot/NetZ3950/Z3950/Record.pm,v 1.14 2004/11/22 22:41:47 mike Exp $
+
+package Net::Z3950::Record;
+use strict;
+
+
+=head1 NAME
+
+Net::Z3950::Record - base class for records retrieved from a Z39.50 server
+
+=head1 SYNOPSIS
+
+ $rs = $conn->resultSet();
+ $rec = $rs->record($n);
+ print $rec->render();
+
+=head1 DESCRIPTION
+
+A Record object represents a record retrieved from a Z39.50 server.
+In fact, the C<Net::Z3950::Record> class itself is never instantiated:
+instead, the Net::Z3950 module creates objects of subclasses such as
+C<Net::Z3950::Record::SUTRS>, C<Net::Z3950::Record::GRS1>,
+C<Net::Z3950::Record::USMARC> and C<Net::Z3950::Record::XML>.
+This class defines a common interface which must be supported by all
+such subclasses.
+
+=head1 METHODS
+
+=cut
+
+
+=head2 nfields()
+
+ $count = $rec->nfields();
+
+Returns the number of fields in the record I<$rec>.
+
+=cut
+
+sub nfields {
+ return "[can't count fields of a Net::Z3950::Record]\n";
+}
+
+
+=head2 render()
+
+ print $rec->render();
+
+Returns a human-readable string representing the content of the record
+I<$rec> in a form appropriate to its specific type.
+
+=cut
+
+sub render {
+ return "[can't render a Net::Z3950::Record]\n";
+}
+
+
+=head2 rawdata()
+
+ $raw = $rec->rawdata();
+
+Returns the raw form of the data in the record, which will in general
+be different in form for different record syntaxes.
+
+=cut
+
+sub rawdata {
+ return "[can't return raw data for a Net::Z3950::Record]\n";
+}
+
+
+# ### Should each subclass be implemented in a file of its own?
+# Perhaps that will prove more appropriate as the number of
+# supported record syntaxes, and the number of methods defined
+# for each, increase. For now, though, it would probably be
+# overkill.
+
+=head1 SUBCLASSES
+
+=cut
+
+
+=head2 Net::Z3950::Record::SUTRS
+
+Represents a a record using the Simple Unstructured Text Record
+Syntax (SUTRS) - a simple flat string containing the record's data in
+a form suitable for presentation to humans (so that the C<render()>
+and C<rawdata()> methods return the same thing.)
+
+See Appendix REC.2 (Simple Unstructured Text Record Syntax) of the
+Z39.50 Standard for more information.
+
+=cut
+
+package Net::Z3950::Record::SUTRS;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::Record);
+
+sub nfields {
+ return 1; # by definition
+}
+
+sub render {
+ my $this = shift();
+ return $$this;
+}
+
+sub rawdata {
+ my $this = shift();
+ return $$this;
+}
+
+
+=head2 Net::Z3950::Record::GRS1
+
+Represents a record using Generic Record Syntax 1 (GRS1) - a list of
+tagged fields where each tag is made up of a tag type and tag value,
+and each field may be of any type, including numeric, string, and
+recursively contained sub-record. Fields may also be annotated with
+metadata, variant information I<etc.>
+
+See Appendix REC.5 (Generic Record Syntax 1) of the Z39.50 Standard
+for more information.
+
+=cut
+
+package Net::Z3950::Record::GRS1;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::Record);
+
+sub nfields {
+ my $this = shift();
+ return scalar @$this;
+}
+
+sub render {
+ my $this = shift();
+
+ return $this->nfields() . " fields:\n" . $this->_render1(0);
+}
+
+# PRIVATE to the render() method
+sub _render1 {
+ my $this = shift();
+ my($level) = @_;
+
+ my $res = '';
+ for (my $i = 0; $i < $this->nfields(); $i++) {
+ my $fld = $this->[$i];
+ {
+ my $type = 'Net::Z3950::APDU::TaggedElement';
+ if (!$fld->isa($type)) {
+ die "expected $type, got " . ref($fld);
+ }
+ }
+ $res .= ' ' x $level;
+ $res .= "(" . $fld->tagType() . "," . $fld->tagValue() . ")";
+ my $occurrence = $fld->tagOccurrence();
+ $res .= "[" . $occurrence . "]" if defined $occurrence;
+ $res .= " " . _render_content($level, $fld->content());
+ }
+
+ return $res;
+}
+
+# PRIVATE to the _render1() method
+sub _render_content {
+ my($level, $val) = @_;
+
+ my $which = $val->which();
+ if ($which == Net::Z3950::ElementData::Numeric) {
+ return $val->numeric() . "\n";
+ } elsif ($which == Net::Z3950::ElementData::String) {
+ return '"' . $val->string() . '"' . "\n";
+ } elsif ($which == Net::Z3950::ElementData::OID) {
+ return $val->oid() . "\n";
+ } elsif ($which == Net::Z3950::ElementData::Subtree) {
+ # ### This re-blessing is an ugly way to cope with $val
+ # being The Wrong Kind Of GRS1 Object, since it has the
+ # naughty (if not particularly malignant) side-effect of
+ # permanently changing the type of a part of the tree.
+ my $sub = $val->subtree();
+ bless $sub, 'Net::Z3950::Record::GRS1';
+ return "{\n" . $sub->_render1($level+1) . ' ' x $level . "}\n";
+ } else {
+ use Data::Dumper;
+ die "unknown ElementData which $which in data " . Dumper($val);
+ }
+}
+
+sub rawdata {
+ my $this = shift();
+ return $this; # just return the structure itself.
+}
+
+
+=head2 Net::Z3950::Record::USMARC, Net::Z3950::Record::UKMARC, Net::Z3950::Record::NORMARC, Net::Z3950::Record::LIBRISMARC, Net::Z3950::Record::DANMARC, Net::Z3950::Record::UNIMARC
+
+Represents a record using the appropriate MARC (MAchine Readable
+Catalogue) format - binary formats used extensively in libraries.
+
+For further information on the MARC formats, see the Library of
+Congress Network Development and MARC Standards Office web page at
+http://lcweb.loc.gov/marc/ and the MARC module in Ed Summers's
+directory at CPAN,
+http://cpan.valueclick.com/authors/id/E/ES/ESUMMERS/
+
+=cut
+
+package Net::Z3950::Record::USMARC;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::Record);
+
+sub nfields {
+ return 1; # This is not really true - a record
+ # is made up of several fields, but
+ # here we perpetrate the illusion of a
+ # single flat block, so that it can
+ # easily be fed to external MARC-aware
+ # software.
+}
+
+# Thanks to Dave Burgess <burgess at mitre.org> for supplying this code.
+# We pull in the MARC module with "require" rather than "use" so that
+# there's no dependency for non-MARC clients.
+#
+sub render {
+ my $this = shift();
+
+ require MARC::Record;
+ my $rec = MARC::Record->new_from_usmarc($this->rawdata());
+ return $rec->as_formatted();
+}
+
+sub rawdata {
+ my $this = shift();
+ return $$this; # Return the whole record ``as is''.
+}
+
+
+package Net::Z3950::Record::UKMARC;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::Record);
+sub nfields { return 1 }
+sub rawdata { return ${ shift() } }
+
+package Net::Z3950::Record::NORMARC;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::Record);
+sub nfields { return 1 }
+sub rawdata { return ${ shift() } }
+
+package Net::Z3950::Record::LIBRISMARC;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::Record);
+sub nfields { return 1 }
+sub rawdata { return ${ shift() } }
+
+package Net::Z3950::Record::DANMARC;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::Record);
+sub nfields { return 1 }
+sub rawdata { return ${ shift() } }
+
+package Net::Z3950::Record::UNIMARC;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::Record);
+sub nfields { return 1 }
+sub rawdata { return ${ shift() } }
+
+
+=head2 Net::Z3950::Record::XML
+
+Represents a a record using XML (Extended Markup Language), as defined
+by the W3C. Rendering is not currently defined: this module treats
+the record as a single opaque lump of data, to be parsed by other
+software.
+
+For more information about XML, see http://www.w3.org/XML/
+
+=cut
+
+package Net::Z3950::Record::XML;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::Record);
+
+sub nfields {
+ return 1; ### not entirely true
+}
+
+sub render {
+ my $this = shift();
+ return $$this;
+}
+
+sub rawdata {
+ my $this = shift();
+ return $$this;
+}
+
+
+=head2 Net::Z3950::Record::HTML
+
+Represents a a record using HTML (HyperText Markup Language), as
+defined by the W3C. Rendering is not currently defined: this module
+treats the record as a single opaque lump of data, to be handled by
+other software.
+
+For more information about HTML, see http://www.w3.org/MarkUp/
+
+=cut
+
+package Net::Z3950::Record::HTML;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::Record);
+
+sub nfields {
+ return 1; ### not entirely true
+}
+
+sub render {
+ return "[can't render a Net::Z3950::Record::HTML - not yet implemented]\n";
+}
+
+sub rawdata {
+ my $this = shift();
+ return $$this;
+}
+
+
+=head2 Net::Z3950::Record::OPAC
+
+Represents a a record using the OPAC (Online Public Access Catalogue)
+record syntax, as defined in Appendix 5 (REC) of the Z39.50 standard
+at http://lcweb.loc.gov/z3950/agency/asn1.html#RecordSyntax-opac
+
+=cut
+
+package Net::Z3950::Record::OPAC;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::Record);
+
+sub nfields {
+ return 1; ### not entirely true
+}
+
+sub render {
+ my $this = shift();
+
+ my $res;
+ my $bib = $this->{bibliographicRecord};
+ if (defined $bib) {
+ $res = "* Bibliographic record:\n";
+ $res .= $bib->render();
+ } else {
+ $res = "[no bibliographic record]\n";
+ }
+
+ my $n = $this->{num_holdingsData};
+ my $h = $this->{holdingsData};
+ foreach my $i (1 .. $n) {
+ my $hr = $h->[$i-1];
+ $res .= "* Holdings record $i of $n:\n";
+ foreach my $label (qw(typeOfRecord encodingLevel format
+ receiptAcqStatus generalRetention
+ completeness dateOfReport nucCode
+ localLocation shelvingLocation
+ callNumber shelvingData copyNumber
+ publicNote reproductionNote
+ termsUseRepro enumAndChron)) {
+ $res .= _maybeValue(1, $hr, $label);
+ }
+
+ my $cd = $hr->{circulationData};
+ my $n = @$cd;
+ foreach my $i (1 .. $n) {
+ my $cr = $cd->[$i-1];
+ $res .= "\t* Circulation record $i of $n:\n";
+ foreach my $label (qw(availableNow availablityDate
+ availableThru restrictions itemId
+ renewable onHold enumAndChron
+ midspine temporaryLocation)) {
+ $res .= _maybeValue(2, $cr, $label);
+ }
+ }
+
+ my $vols = $hr->{volumes};
+ $n = @$vols;
+ foreach my $i (1 .. $n) {
+ my $vol = $vols->[$i-1];
+ $res .= "\t* Volume record $i of $n:\n";
+ foreach my $label (qw(enumeration chronology
+ enumAndChron)) {
+ $res .= _maybeValue(2, $vol, $label);
+ }
+ }
+ }
+
+ return $res;
+}
+
+sub _maybeValue {
+ my($level, $hr, $label) = @_;
+
+ my $val = $hr->{$label};
+ return defined $val ? ("\t" x $level . "$label: $val\n") : "";
+}
+
+sub rawdata {
+ my $this = shift();
+ return $this;
+}
+
+
+=head2 Net::Z3950::Record::MAB
+
+Represents a record using the MAB record syntax (Maschinelles
+Austauschformat fuer Bibliotheken, ftp://ftp.ddb.de/pub/mab/); an
+interchange format defined by Die Deutsche Bibliothek (German National
+Library).
+
+=cut
+
+package Net::Z3950::Record::MAB;
+use vars qw(@ISA);
+ at ISA = qw(Net::Z3950::Record);
+
+sub nfields {
+ my $this = shift();
+ return $$this =~ tr/\x1E/\x1E/;
+}
+
+sub render {
+ my $this = shift();
+ my $in = $$this;
+
+ # Chop off 24-character preface
+ my $out = "### " . substr($in, 0, 24) . "\n";
+ $in = substr($in, 24);
+
+ # \x1D is the record separator: discard it
+ $in =~ s/\x1D$//;
+
+ # \x1E is the field separator
+ my @fields = split /\x1E/, $in;
+
+ foreach my $field (@fields) {
+ # If a database uses two $ instead of the correct subfield
+ # separator code \x1F we reset this.
+ $field =~ s/\$\$/\x1F/g;
+ $field =~ s/\x1F/\$/g;
+ $out .= "$field\n";
+ }
+
+ return $out;
+}
+
+sub rawdata {
+ my $this = shift();
+ return $$this;
+}
+
+
+=head2 ### others, not yet supported
+
+=cut
+
+
+=head1 AUTHOR
+
+Mike Taylor E<lt>mike at indexdata.comE<gt>
+
+First version Sunday 4th May 2000.
+
+=cut
+
+1;
Added: packages/libnet-z3950-perl/branches/upstream/current/Z3950/ResultSet.pm
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/Z3950/ResultSet.pm 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/Z3950/ResultSet.pm 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,774 @@
+# $Header: /home/cvsroot/NetZ3950/Z3950/ResultSet.pm,v 1.22 2005/04/21 11:41:23 mike Exp $
+
+package Net::Z3950::ResultSet;
+use strict;
+
+
+=head1 NAME
+
+Net::Z3950::ResultSet - result set received in response to a Z39.50 search
+
+=head1 SYNOPSIS
+
+ if ($conn->op() == Net::Z3950::Op::Search) {
+ $rs = $conn->resultSet();
+ $size = $rs->size();
+
+=head1 DESCRIPTION
+
+A ResultSet object represents the set of records found by a Z39.50
+server in response to a search. At any given time, none, some or all
+of the records may have been physcially transferred to the client; a
+cache is maintained.
+
+Note that there is no constructor for this class (or at least, none
+that I'm going to tell you about :-) ResultSet objects are always
+created by the Net::Z3950 module itself, and are returned to the caller
+via the C<Net::Z3950::Connection> class's C<resultSet()> method.
+
+=head1 METHODS
+
+=cut
+
+
+# The key data member of Result Sets is $this->{records}, which is a
+# hash mapping element-set names to caches of records represented in
+# that element set. Each such cache is an array, the elements of
+# which may contain any of the following values:
+# an undefined value (or not there at all -- off the end of the
+# array) if we don't have the record, and it's not been
+# requested yet.
+# CALLER_REQUESTED if the caller has asked for the record but we
+# don't have it and have not yet issued a Present
+# request for it.
+# RS_REQUESTED if the caller has asked for the record and we
+# don't have it, but we have issued a Present request
+# and are awaiting a response.
+# a record reference if we have the record.
+# a surrogate diagnostic if we fetched the record
+# unsuccessfully.
+# We use the slots in $this->{records} corresponding to 1-based record
+# numbers; that is, slot zero is not used at all.
+sub CALLER_REQUESTED { 1 }
+sub RS_REQUESTED { 2 }
+
+# PRIVATE to the Net::Z3950::Connection class's _dispatch() method
+sub _new {
+ my $class = shift();
+ my($conn, $rsName, $searchResponse) = @_;
+
+ if (!$searchResponse->searchStatus()) {
+ # Search failed: set $conn's error indicators and return undef
+ my $records = $searchResponse->records();
+
+ if (defined $records) {
+ ref $records eq 'Net::Z3950::APDU::DefaultDiagFormat'
+ or die "non-default diagnostic format";
+ ### $rec->diagnosticSetId() is not used
+ $conn->{errcode} = $records->condition();
+ $conn->{addinfo} = $records->addinfo();
+ } else {
+ # Some servers don't return diag records, even though
+ # that's illegal. So fake an error.
+ $conn->{errcode} = 3; # unsupported search -- near enough
+ $conn->{addinfo} = "no diagnostic records supplied by server";
+ }
+ return undef;
+ }
+
+ my $this = bless {
+ conn => $conn,
+ rsName => $rsName,
+ searchResponse => $searchResponse,
+ records => {},
+ }, $class;
+
+ ### Should also check presentStatus where relevant
+ my $rawrecs = $searchResponse->records();
+ $this->_insert_records($searchResponse, 1, 1)
+ if defined $rawrecs;
+
+ return $this;
+}
+
+
+=head2 size()
+
+ $nrecords = $rs->size();
+
+Returns the number of records in the result set I<$rs>
+
+=cut
+
+sub size {
+ my $this = shift();
+
+ return $this->{searchResponse}->resultCount();
+}
+
+
+=head2 subqueryCount()
+
+ $subquery = $rs->subqueryCount();
+
+Returns hit count of subquery terms as a hash reference containing
+(term, count) pairs, if the server returned this information. If the
+information is not available, an undefined value is returned.
+
+=cut
+
+sub subqueryCount {
+ my $this = shift();
+
+ my $info = $this->{searchResponse}->additionalSearchInfo();
+ return undef if !$info;
+
+ my $subquery = {};
+ foreach my $unit (@{$info}) {
+ if ($unit->which() ==
+ Net::Z3950::OtherInformationUnit::ExternallyDefinedInfo) {
+ if (my $reports = $unit->externallyDefinedInfo()) {
+ foreach my $report (@{$reports}) {
+ if (my $expr = $report->subqueryExpression()) {
+ if ($expr->which() ==
+ Net::Z3950::QueryExpression::Term) {
+ my $term = $expr->term()->queryTerm()->general();
+ $subquery->{$term} = $report->subqueryCount()
+ if $term;
+ }
+ }
+ }
+ }
+ }
+ }
+
+ return $subquery;
+}
+
+=head2 present()
+
+ $rs->present($start, $count) or die "failed: $rs->{errcode}\n";
+
+Causes any records in the specified range that are not yet in the
+cache to be retrieved from the server. By calling this method before
+retrieving individual records with C<record()>, you avoid sending lots
+of small requests for single records across the network. In
+asynchronous mode, C<present()> just schedules the records for
+retrieval.
+
+Note that C<$start> is indexed from 1.
+
+In synchronous mode, returns 1 if the records were successfully
+retrieved, 0 if an error occurred. In asynchronous mode, returns 1 if
+new requests were queued, 0 if all of the requested records had
+already been queued.
+
+=cut
+
+sub present {
+ my ($this, $start, $count) = @_;
+
+ my $esn = $this->option('elementSetName');
+ ### Shouldn't this cache also have a record-syntax dimension?
+ if (!defined $this->{records}->{$esn}) {
+ $this->{records}->{$esn} = [];
+ }
+ my $records = $this->{records}->{$esn};
+
+ # quietly ignore presents past the last record - this stops
+ # prefetch causing errors
+
+ my $size = $this->size;
+ my $last = $start+$count-1;
+ $last = $size if $last > $size;
+
+ my $seen_new;
+ for (my $i=$start; $i <= $last; $i++) {
+ if (not defined $records->[$i]) {
+ # It hasn't even been requested: mark for Present-request
+ $records->[$i] = CALLER_REQUESTED;
+ $seen_new = 1;
+ }
+ }
+ $this->{conn}->{idleWatcher}->start() if $seen_new;
+ return undef
+ if $this->option('async');
+
+ # Synchronous-mode request for a record that we don't yet have.
+ # As soon as we're idle -- in the wait() call -- the _idle()
+ # watcher will send a presentRequest; we then wait for its
+ # response to arrive.
+ if (!$this->{conn}->expect(Net::Z3950::Op::Get, "get")) {
+ # Error code and addinfo are in the connection: copy them across
+ $this->{errcode} = $this->{conn}->{errcode};
+ $this->{addinfo} = $this->{conn}->{addinfo};
+ return 0;
+ }
+ return 1;
+}
+
+
+=head2 record()
+
+ $rec = $rs->record($n);
+
+Returns a reference to I<$n>th record in the result set I<$rs>, if the
+content of that record is known. Valid values of I<$n> range from 1
+to the return value of the C<size()> method.
+
+If the record is not available, an undefined value is returned, and
+diagnostic information made available via I<$rs>'s C<errcode()> and
+C<addinfo()> methods.
+
+As a special case, when the connection is anychronous, the
+C<errcode()> may be zero, indicating simply that the record has not
+yet been fetched from the server. In this case, the calling code
+should try again later. (How much later? As a rule of thumb, after
+it's done ``something else'', such as request another record or issue
+another search.) This can never happen in synchronous mode.
+
+=cut
+
+sub record {
+ my $this = shift();
+ my($which) = @_;
+
+ # autovivifies if necessary
+ my $rec = $this->{records}{$this->option('elementSetName')}[$which];
+
+ if (!defined $rec or not ref $rec) {
+ # Record not in place yet
+
+ my $status = $this->present($which, $this->option('prefetch') || 1);
+ if ($this->option('async')) {
+ # request was merely queued
+ $this->{errcode} = 0;
+ return undef;
+ } elsif (!$status) {
+ # An actual error: the code/addInfo have already been set
+ return undef;
+ }
+
+ # The _add_records() callback invoked by the event loop should now
+ # have inserted the requested record into our array, so we should
+ # just be able to return it. Sanity-check first, though.
+ $rec = $this->{records}{$this->option('elementSetName')}[$which];
+ if (!defined $rec) {
+ die "record(): impossible: didn't get record";
+ } elsif (!ref $rec) {
+ # Why would we ever get back a record that is not a
+ # reference? I think only because something is very badly
+ # wrong. We wrap it up as a reference so it can be
+ # render()ed without breaking the application.
+ use Net::Z3950::Record;
+ my $errmsg = "THIS IS NOT A USMARC RECORD. " .
+ "Something has gone badly wrong. " .
+ "The internal record object has value '$rec'";
+ return bless \$errmsg, 'Net::Z3950::Record::USMARC';
+ }
+ }
+
+ if (ref $rec && $rec->isa('Net::Z3950::APDU::DefaultDiagFormat')) {
+ # Set error information from record into the result set
+ ### $rec->diagnosticSetId() is not used
+ $this->{errcode} = $rec->condition();
+ $this->{addinfo} = $rec->addinfo();
+ return undef;
+ }
+ # We have it, and it's presumably a legitmate record
+ return $rec;
+}
+
+
+# PRIVATE to the Net::Z3950::Connection module's new() method, invoked as
+# an Event->idle callback
+sub _idle {
+ my($event) = @_;
+ my $watcher = $event->w();
+ my $conn = $watcher->data();
+
+ foreach my $rs ($conn->resultSets()) {
+ next if !$rs; # a pending slot, awaiting search response
+ $rs->_checkRequired();
+ }
+
+ # Don't fire again until more records are requested
+ $watcher->stop();
+}
+
+
+# PRIVATE to the _request_records() method
+sub _checkRequired {
+ my $this = shift();
+
+ my $esn = $this->option('elementSetName');
+ my $records = $this->{records}->{$esn};
+ return unless defined $records;
+ my $n = @$records;
+
+ ### If our interface to the C function makePresentRequest allowed
+ # us to generate multiple ranges (using the Present Request
+ # APDU's additionalRange parameter), we could consider using
+ # that and making a single big present request instead of
+ # (potentially) several little ones; but it's slightly tricky to
+ # do, and it's not clear that it would be more efficient, so
+ # let's not lose any sleep over it for now.
+
+ my($first, $howmany);
+ for (my $i = 1; $i <= $n; $i++) {
+ my $rec = $records->[$i];
+ if (!defined $first) {
+ # We've not yet seen a record we want to fetch
+ if (defined $rec && $rec == CALLER_REQUESTED) {
+ # ... but now we have! Start a new range
+ $first = $i;
+ $records->[$i] = RS_REQUESTED;
+ }
+ } else {
+ # We're already gathering a range
+ if (defined $rec && $rec == CALLER_REQUESTED) {
+ # Range continues: mark that we're requesting this record
+ $records->[$i] = RS_REQUESTED;
+ } else {
+ # This record is one past the end of the range we want
+ $howmany = $i-$first;
+ $this->_send_presentRequest($first, $i-$first);
+ $first = undef; # prepare for next range
+ }
+ }
+ }
+}
+
+
+# PRIVATE to the _checkRequired() method
+#
+# ### Instead of sending these out immediately, we should put them
+# on a queue to be sent out when the connection is quiet (which
+# may be immediately): in this way we work with broken (but
+# compliant!) servers which may throw away anything after the
+# first APDU in their connection's input queue. In Real Life,
+# the current version will Nearly Always(tm) work, but this is a
+# good place to look if we get bug reports in this area.
+#
+sub _send_presentRequest {
+ my $this = shift();
+ my($first, $howmany) = @_;
+
+ my $refId = _bind_refId($this->{rsName}, $first, $howmany);
+ my $errmsg = '';
+ my $pr = Net::Z3950::makePresentRequest($refId,
+ $this->option('namedResultSets') ?
+ $this->{rsName} : 'default',
+ $first, $howmany,
+ $this->option('elementSetName'),
+ $this->preferredRecordSyntax(),
+ $errmsg);
+ die "can't make present request: $errmsg" if !defined $pr;
+ $this->{conn}->_enqueue($pr);
+}
+
+
+# PRIVATE to the Net::Z3950::Connection class's _dispatch() method
+sub _add_records {
+ my $this = shift();
+ my($presentResponse) = @_;
+
+ my($rsName, $first, $howmany) =
+ _unbind_refId($presentResponse->referenceId());
+ ### Should check presentStatus
+ my $n = $presentResponse->numberOfRecordsReturned();
+
+ # Sanity checks
+ if ($rsName ne $this->{rsName}) {
+ die "rs '" . $this->{rsName} . "' was sent records for '$rsName'";
+ }
+ if ($n > $howmany) {
+ die "rs '$rsName' got $n records but only asked for $howmany";
+ }
+
+ if ($this->_insert_records($presentResponse, $first, $howmany)) {
+ my $esn = $this->option('elementSetName');
+ my $records = $this->{records}->{$esn};
+ for (my $i = $n; $i < $howmany; $i++) {
+ # We asked for this record but didn't get it, for whatever
+ # reason. Mark the record down to "requested by the user
+ # but no present request outstanding" so that it gets
+ # requested again.
+ ### This might not always be The Right Thing -- if the
+ # error is a permanent one, we'll end up looping, asking
+ # for it again and again. We could further overload the
+ # meaning of numbers in the {records}->{$esn} array to
+ # count how many times we've tried, and bomb out after
+ # "too many" tries.
+ $this->_check_slot($records->[$first+$i], $first+$i);
+ $records->[$first+$i] = CALLER_REQUESTED;
+ }
+ }
+
+ if ($n < $howmany) {
+ # We're missing at least one record, which we've marked
+ # CALLER_REQUESTED; restart the idle watcher so it issues a
+ # new present request at an appropriate point.
+ $this->{conn}->{idleWatcher}->start();
+ }
+}
+
+
+# PRIVATE to the _new() and _add_record() methods
+sub _insert_records {
+ my $this = shift();
+ my($apdu, $first, $howmany) = @_;
+ # $first is 1-based; $howmany is used only when storing NSDs.
+
+ my $esn = $this->option('elementSetName'); ### might this have changed?
+ my $records = $this->{records}->{$esn};
+ my $rawrecs = $apdu->records();
+
+ # Some badly-behaved servers claim records but don't include any.
+ # Fake up an error in this case.
+ unless (defined $rawrecs) {
+ $rawrecs = bless {
+ diagnosticSetId => '1.2.840.10003.4.1', # BIB-1 diagnostic set
+ condition => 14, # System error in presenting records
+ addinfo => 'No records supplied by server',
+ }, 'Net::Z3950::APDU::DefaultDiagFormat';
+ }
+
+ if ($rawrecs->isa('Net::Z3950::APDU::DefaultDiagFormat')) {
+ # Now what? We want to report the error back to the caller,
+ # but we got here from a callback from the event loop, and
+ # we're now miles away from any notional "flow of control"
+ # where we could pop up with an error. Instead, we lodge a
+ # copy of this error in the slots for each record requested,
+ # so that when the caller invokes record(), we can arrange
+ # that we set appropriate error information.
+ for (my $i = 0; $i < $howmany; $i++) {
+ $records->[$first+$i] = $rawrecs;
+ }
+ return 0;
+ }
+
+ {
+ # ### Should deal more gracefully with multiple
+ # non-surrogate diagnostics (Z_Records_multipleNSD)
+ my $type = 'Net::Z3950::APDU::NamePlusRecordList';
+ if (!$rawrecs->isa($type)) {
+ die "expected $type, got " . ref($rawrecs);
+ }
+ }
+
+ my $n = @$rawrecs;
+ for (my $i = 0; $i < $n; $i++) {
+ $this->_check_slot($records->[$first+$i], $first+$i)
+ if $first > 1; # > 1 => it's a present response
+
+ my $record = $rawrecs->[$i];
+ {
+ # Merely a redundant sanity check
+ my $type = 'Net::Z3950::APDU::NamePlusRecord';
+ if (!$record->isa($type)) {
+ die "expected $type, got " . ref($record);
+ }
+ }
+
+ ### We're ignoring databaseName -- do we have any use for it?
+ my $which = $record->which();
+ if ($which == Net::Z3950::NamePlusRecord::DatabaseRecord) {
+ $records->[$first+$i] = $this->_tweak($record->databaseRecord());
+ } elsif ($which == Net::Z3950::NamePlusRecord::SurrogateDiagnostic) {
+ $records->[$first+$i] = $record->surrogateDiagnostic();
+ } else {
+ ### Should deal with segmentation fragments
+ die "expected DatabaseRecord, got record-type $which";
+ }
+ }
+
+ return 1;
+}
+
+
+# PRIVATE to _insert_records()
+sub _tweak {
+ my($this, $rec) = @_;
+
+ # Ninety-nine times out of a hundred, all we need to do here is
+ # return the $rec argument directly, so that the application gets
+ # precisely the record returned from the server. However, a small
+ # but significant set of very badly-behaved servers sometimes take
+ # it upon themselves to return USMARC records when OPAC records
+ # have been requested but there is no holdings information. For
+ # the benefit of those misbegotten monstrosities, we wrap such
+ # unwanted USMARC records in an otherwise empty OPAC-record
+ # structure. <sigh>
+ if ($this->preferredRecordSyntax() == Net::Z3950::RecordSyntax::OPAC &&
+ $rec->isa("Net::Z3950::Record::USMARC")) {
+ return bless {
+ bibliographicRecord => $rec,
+ num_holdingsData => 0,
+ holdingsData => [],
+ }, "Net::Z3950::Record::OPAC";
+ }
+
+ return $rec;
+}
+
+
+# The code is the as for the Connection class's same-named method
+sub preferredRecordSyntax {
+ return Net::Z3950::Connection::preferredRecordSyntax(@_);
+}
+
+
+# PRIVATE to the _add_records() and _insert_records() methods
+sub _check_slot {
+ my $this = shift();
+ my($rec, $which) = @_;
+
+ if (ref $rec && $rec->isa('Net::Z3950::APDU::DefaultDiagFormat')) {
+ my $diag = $rec->condition();
+ # Error codes:
+ # 238 Record not available in requested syntax
+ # 239 Record syntax not supported
+ # If this has happened, we don't want to prevent the caller
+ # from trying again with a different record syntax.
+ return if $diag == 238 || $diag == 239;
+ die "re-fetching a record that's already had an error";
+ }
+ die "presented record $rec already loaded"
+ if ref $rec;
+ die "server was never asked for presented record"
+ if $rec == CALLER_REQUESTED;
+ die "user never asked for presented record"
+ if !defined $rec;
+ die "record is defined but false, which is impossible"
+ if !$rec;
+ die "weird slot-value $rec"
+ if $rec != RS_REQUESTED;
+}
+
+
+# PRIVATE to the _send_presentRequest() and _add_records() methods
+#
+# These functions encapsulate the scheme used for binding a result-set
+# name, the first record requested and the number of records requested
+# into a single opaque string, which we then use as a reference Id so
+# that it gets passed back to us when the present response arrives
+# (otherwise there's no way to know from the response what we asked
+# for, and therefore where in the result set to insert the records.)
+#
+sub _bind_refId {
+ my($rsName, $first, $howmany) = @_;
+ return $rsName . '-' . $first . '-' . $howmany;
+}
+
+sub _unbind_refId {
+ my($refId) = @_;
+ $refId =~ /(.*)-(.*)-(.*)/;
+ return ($1, $2, $3);
+}
+
+
+=head2 records()
+
+ @records = $rs->records();
+ foreach $rec (@records) {
+ print $rec->render();
+ }
+
+This utility method returns a list of all the records in the result
+set I$<rs>. Because Perl arrays are indexed from zero, the first
+record is C<$records[0]>, the second is C<$records[1]>, I<etc.>
+
+If not all the records associated with I<$rs> have yet been
+transferred from the server, then they need to be transferred at this
+point. This means that the C<records()> method may block, and so is
+not recommended for use in applications that interact with multiple
+servers simultaneously. It does also have the side-effect that
+subsequent invocations of the C<record()> method will always
+immediately return either a legitimate record or a ``real error''
+rather than a ``not yet'' indicator.
+
+If an error occurs, an empty list is returned. Since this is also
+what's returned when the search had zero hits, well-behaved
+applications will consult C<$rs->size()> in these circumstances to
+determine which of these two conditions pertains. After an error has
+occurred, details may be obtained via the result set's C<errcode()>
+and C<addinfo()> methods.
+
+If a non-empty list is returned, then individual elements of that list
+may still be undefined, indicating that corresponding record could not
+be fetched. In order to get more information, it's necessary to
+attempt to fetch the record using the C<record()> method, then consult
+the C<errcode()> and C<addinfo()> methods.
+
+B<Unwarranted personal opinion>: all in all, this method is a pleasant
+short-cut for trivial programs to use, but probably carries too many
+caveats to be used extensively in serious applications. You may want to
+take a look at C<present()> and the C<prefetch> option instead.
+
+B<AS OF RELEASE 0.31, THIS METHOD IS NOW DEPRECATED.
+PLEASE USE record() INSTEAD.>
+
+=cut
+
+# We'd like to do this by just returning {records}->{$esn} of course, but
+# we can't do that because (A) it's 1-based, and (B) we need undefined
+# slots where errors occur rather than error-information APDUs. So we
+# make a copy.
+#
+# ### It would be nice to come up with some cuter logic for when we
+# can fall out of our calling-wait()-to-get-more-records loop,
+# but for now, the trivial keep-going-till-we-have-them-all
+# approach is adequate.
+#
+# ### Does this work? Does anyone use it?
+#
+sub records {
+ my $this = shift();
+ warn "DEPRECATED method records() called on $this";
+
+ my $size = $this->size();
+ my $esn = $this->option('elementSetName');
+ my $records = $this->{records}->{$esn};
+
+ # Issue requests for any records not already available or requested.
+ for (my $i = 0; $i < $size; $i++) {
+ if (!defined $records->[$i+1]) {
+ $this->record($i+1); # discard result
+ }
+ }
+
+ # Wait until all the records are in (or at least errors)
+ while (1) {
+ my $done = 1;
+ for (my $i = 0; $i < $size; $i++) {
+ if (!ref $records->[$i+1]) {
+ $done = 0;
+ last;
+ }
+ }
+ last if $done;
+
+ # OK, we have at least one slot in $records which is not a
+ # reference either to a legitimate record or to an error
+ # APDU, so we need to wait for another server response.
+ my $conn = $this->{conn};
+ my $c2 = $conn->manager()->wait();
+ die "wait() yielded wrong connection"
+ if $c2 ne $conn;
+ }
+
+ my @res;
+ for (my $i = 0; $i < $size; $i++) {
+ my $tmp = $this->record($i+1);
+ $res[$i] = $tmp;
+ }
+
+ return @res;
+}
+
+
+=head2 delete()
+
+ $ok = $rs->delete();
+ if (!$ok) {
+ print "can't delete: ", $rs->errmsg(), "\n";
+ }
+
+Requests the server to delete the result set corresponding to C<$rs>.
+Return non-zero on success, zero on failure.
+
+=cut
+
+sub delete {
+ my $this = shift();
+
+ my $errmsg = '';
+ my $refId = _bind_refId($this->{rsName}, "delete", 0);
+ my $dr = Net::Z3950::makeDeleteRSRequest($refId,
+ $this->{rsName},
+ $errmsg);
+ die "can't make delete-RS request: $errmsg" if !defined $dr;
+ my $conn = $this->{conn};
+ $conn->_enqueue($dr);
+
+ ### The remainder of this method enforces synchronousness
+ if (!$conn->expect(Net::Z3950::Op::DeleteRS, "deleteRS")) {
+ return undef;
+ }
+
+ return $conn->{deleteStatus};
+}
+
+
+=head2 errcode(), addinfo(), errmsg()
+
+ if (!defined $rs->record($i)) {
+ print "error ", $rs->errcode(), " (", $rs->errmsg(), ")\n";
+ print "additional info: ", $rs->addinfo(), "\n";
+ }
+
+When a result set's C<record()> method returns an undefined value,
+indicating an error, it also sets into the result set the BIB-1 error
+code and additional information returned by the server. They can be
+retrieved via the C<errcode()> and C<addinfo()> methods.
+
+As a convenience, C<$rs->errmsg()> is equivalent to
+C<Net::Z3950::errstr($rs->errcode())>.
+
+=cut
+
+sub errcode {
+ my $this = shift();
+ return $this->{errcode};
+}
+
+sub addinfo {
+ my $this = shift();
+ return $this->{addinfo};
+}
+
+sub errmsg {
+ my $this = shift();
+ return Net::Z3950::errstr($this->errcode());
+}
+
+
+=head2 option()
+
+ $value = $rs->option($type);
+ $value = $rs->option($type, $newval);
+
+Returns I<$rs>'s value of the standard option I<$type>, as registered
+in I<$rs> itself, in the connection across which it was created, in
+the manager which controls that connection, or in the global defaults.
+
+If I<$newval> is specified, then it is set as the new value of that
+option in I<$rs>, and the option's old value is returned.
+
+=cut
+
+sub option {
+ my $this = shift();
+ my($type, $newval) = @_;
+
+ my $value = $this->{options}->{$type};
+ if (!defined $value) {
+ $value = $this->{conn}->option($type);
+ }
+ if (defined $newval) {
+ $this->{options}->{$type} = $newval;
+ }
+ return $value
+}
+
+
+=head1 AUTHOR
+
+Mike Taylor E<lt>mike at indexdata.comE<gt>
+
+First version Sunday 28th May 2000.
+
+=cut
+
+1;
Added: packages/libnet-z3950-perl/branches/upstream/current/Z3950/ScanSet.pm
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/Z3950/ScanSet.pm 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/Z3950/ScanSet.pm 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,143 @@
+# $Id: ScanSet.pm,v 1.1 2004/05/07 16:57:48 mike Exp $
+
+package Net::Z3950::ScanSet;
+use strict;
+use warnings;
+
+
+=head1 NAME
+
+Net::Z3950::ScanSet - set of terms received in response to a Z39.50 scan
+
+=head1 SYNOPSIS
+
+ $ss = $conn->scan('@attr 1=4 fish');
+ die $conn->errmsg() if !defined $ss;
+ $size = $ss->size();
+ for ($i = 0; $i < $size; $i++) {
+ $term = $ss->term($i);
+ $count = $ss->field($i, "freq");
+ $displayTerm = $ss->field($i, "display");
+ print "$displayTerm ($count) [$term]\n";
+ }
+
+=head1 DESCRIPTION
+
+A ScanSet object represents the set of terms found by a Z39.50 scan.
+
+There is no public constructor for this class. ScanSet objects are
+always created by the Net::Z3950 module itself, and are returned to
+the caller via the C<Net::Z3950::Connection> class's C<scan()> or
+C<scanResult()> method.
+
+=head1 METHODS
+
+=cut
+
+
+# PRIVATE to the Net::Z3950::Connection class's _dispatch() method
+sub _new {
+ my $class = shift();
+ my($conn, $scanResponse) = @_;
+
+ if ($scanResponse->scanStatus() == Net::Z3950::ScanStatus::Failure) {
+ my $diag = $scanResponse->diag();
+ $conn->{errcode} = $diag->condition();
+ $conn->{addinfo} = $diag->addinfo();
+ return undef;
+ }
+
+ return bless {
+ conn => $conn,
+ scanResponse => $scanResponse,
+ }, $class;
+}
+
+
+sub status { shift()->{scanResponse}->scanStatus() }
+sub position { shift()->{scanResponse}->positionOfTerm() }
+sub stepSize { shift()->{scanResponse}->stepSize() }
+sub size { shift()->{scanResponse}->numberOfEntriesReturned() }
+
+
+sub term {
+ my $this = shift();
+ my($i) = @_;
+
+ if ($i < 0 || $i >= $this->size()) {
+ # There is no BIB-1 error for "scan-set index out of range"
+ $this->{errcode} = 100;
+ $this->{addinfo} = "scan-set index $i out of range 0-" . $this->size();
+ return undef;
+ }
+
+ my $entry = $this->{scanResponse}->entries()->[$i];
+ die "Oops! No entry $i in scanSet $this" if !defined $entry;
+ my $info = $entry->termInfo();
+ if (!defined $info) {
+ # Must be a surrogate diagnostic
+ my $diag = $entry->surrogateDiagnostic();
+ # This is a diagRec which might be defaultFormat or EXTERNAL.
+ ref $diag eq 'Net::Z3950::APDU::DefaultDiagFormat'
+ or die "non-default diagnostic format";
+ ### $diag->diagnosticSetId() is not used
+ $this->{errcode} = $diag->condition();
+ $this->{addinfo} = $diag->addinfo();
+ return undef;
+ }
+
+ ### We wrongly assume that the term will always be of type general
+ return($info->term()->general(), $info->globalOccurrences);
+}
+
+
+sub field {
+ my $this = shift();
+ my($i, $what) = @_;
+
+ die "$this: field() not yet implemented";
+}
+
+
+=head2 errcode(), addinfo(), errmsg()
+
+ if (!defined $ss->term($i)) {
+ print "error ", $ss->errcode(), " (", $ss->errmsg(), ")\n";
+ print "additional info: ", $ss->addinfo(), "\n";
+ }
+
+When the C<term()> or <field()> method returns an undefined value,
+indicating an error, it also sets into the scan-set the BIB-1 error
+code and additional information returned by the server. They can be
+retrieved via the C<errcode()> and C<addinfo()> methods.
+
+As a convenience, C<$ss->errmsg()> is equivalent to
+C<Net::Z3950::errstr($ss->errcode())>.
+
+=cut
+
+sub errcode {
+ my $this = shift();
+ return $this->{errcode};
+}
+
+sub addinfo {
+ my $this = shift();
+ return $this->{addinfo};
+}
+
+sub errmsg {
+ my $this = shift();
+ return Net::Z3950::errstr($this->errcode());
+}
+
+
+=head1 AUTHOR
+
+Mike Taylor E<lt>mike at indexdata.comE<gt>
+
+First version Friday 7th May 2004.
+
+=cut
+
+1;
Added: packages/libnet-z3950-perl/branches/upstream/current/Z3950/Tutorial.pm
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/Z3950/Tutorial.pm 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/Z3950/Tutorial.pm 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,763 @@
+# $Header: /home/cvsroot/NetZ3950/Z3950/Tutorial.pm,v 1.16 2005/07/27 12:27:42 mike Exp $
+
+package Net::Z3950::Tutorial;
+use strict;
+
+
+=head1 NAME
+
+Net::Z3950::Tutorial - tutorial for the Net::Z3950 module
+
+
+=head1 SYNOPSIS
+
+Apparently, every POD document has to have a SYNOPSIS. So here's one.
+
+
+=head1 DESCRIPTION
+
+C<Net::Z3950> is a Perl module for writing Z39.50 clients. (If you
+want to write a Z39.50 server, you want the
+C<Net::Z3950::SimpleServer> module.)
+
+Its goal is to hide all the messy details of the Z39.50 protocol - at
+least by default - while providing access to all of its glorious
+power. Sometimes, this involves revealing the messy details after
+all, but at least this is the programmer's choice. The result is that
+writing Z39.50 clients works the way it should according my favourite
+of the various Perl mottos: ``Simple things should be simple, and
+difficult things should be possible.''
+
+If you don't know what Z39.50 is, then the best place to find out is
+at
+http://lcweb.loc.gov/z3950/agency/
+the web site of the Z39.50 Maintenance Agency. Among its many other
+delights, this site contains a complete downloadable soft-copy of the
+standard itself. In briefest summary, Z39.50 is the international
+standard for distributed searching and retrieval.
+
+
+=head1 A VERY SIMPLE CLIENT
+
+The C<Net::Z3950> distribution includes a couple of sample clients in
+the C<samples> directory. The simplest of them, C<trivial.pl> reads
+as follows:
+
+ use Net::Z3950;
+ $conn = new Net::Z3950::Connection('indexdata.dk', 210,
+ databaseName => 'gils');
+ $rs = $conn->search('mineral');
+ print "found ", $rs->size(), " records:\n";
+ my $rec = $rs->record(1);
+ print $rec->render();
+
+This complete program retrieves from the database called ``gils'' on
+the Z39.50 server on port 210 of C<indexdata.dk> the first record
+matching the search ``mineral'', and renders it in human-readable
+form. Typical output would look like this:
+
+ 6 fields:
+ (1,1) 1.2.840.10003.13.2
+ (1,14) "2"
+ (2,1) {
+ (1,19) "UTAH EARTHQUAKE EPICENTERS"
+ (3,Acronym) "UUCCSEIS"
+ }
+ (4,52) "UTAH GEOLOGICAL AND MINERAL SURVEY"
+ (4,1) "ESDD0006"
+ (1,16) "198903"
+
+
+=head1 HOW IT WORKS
+
+Let's pick the trivial client apart line by line (it won't take long!)
+
+ use Net::Z3950;
+
+This line simply tells Perl to pull in the C<Net::Z3950> module - a
+prerequisite for using types like C<Net::Z3950::Connection>.
+
+ $conn = new Net::Z3950::Connection('indexdata.dk', 210,
+ databaseName => 'gils');
+
+Creates a new connection to the Z39.50 server on port 210 of the host
+C<indexdata.dk>, noting that searches on this connection will default
+to the database called ``gils''. A reference to the new connection is
+stored in C<$conn>.
+
+ $rs = $conn->search('mineral');
+
+Performs a single-word search on the connection referenced by C<$conn>
+(in the previously established default database, ``gils''.) In
+response, the server generates an I<result set>, notionally containing
+all the matching records; a reference to the new connection is stored
+in C<$rs>.
+
+ print "found ", $rs->size(), " records:\n";
+
+Prints the number of records in the new result set C<$rs>.
+
+ my $rec = $rs->record(1);
+
+Fetches from the server the first record in the result set C<$rs>,
+requesting the default record syntax (GRS-1) and the default element
+set (brief, ``b''); a reference to the newly retrieved record is
+stored in C<$rec>.
+
+ print $rec->render();
+
+Prints a human-readable rendition of the record C<$rec>. The exact
+format of the rendition is dependent on issues like the record syntax
+of the record that the server sent.
+
+
+=head1 MORE COMPLEX BEHAVIOUR
+
+=head2 Searching
+
+Searches may be specified in one of several different syntaxes.
+The default
+syntax is so-called Prefix Query Notation, or PQN, a bespoke format
+invented by Index Data to map simply to the Z39.50 type-1 query
+structure. A second is the Common Command Language (CCL) an
+international standard query language often used in libraries.
+The third is the Common Query Language (CQL) the query language
+used by SRW and SRU.
+
+CCL queries may be interpreted on the client side and translated into
+a type-1 query which is forwarded to the server; or it may be sent
+``as is'' for the server to interpret as it may. CQL queries may only
+be passed ``as is''.
+
+The interpretation of the search string may be specified by passing an
+argument of C<-prefix>, C<-ccl>, C<-ccl2rpn> or C<-cql> to the C<search()>
+method before the search string itself, as follows:
+
+B<Prefix Queries>
+
+ $rs = $conn->search(-prefix => '@or rock @attr 1=21 mineral');
+
+Prefix Query Notation is fully described in section 8.1 (B<Query
+Syntax Parsers>) of the Yaz toolkit documentation, B<YAZ User's Guide
+and Reference>.
+
+Briefly, however, keywords begin with an C<@>-sign, and all other
+words are interpreted as search terms. Keywords include the binary
+operators C<@and> and C<@or>, which join together the two operands
+that follow them, and C<@attr>, which introduces a I<type>=I<value>
+expression specifying an attribute to be applied to the following
+term.
+
+So:
+
+=over 4
+
+=item *
+
+C<fruit> searches for the term ``fruit'',
+
+=item *
+
+C<@and fruit fish> searches for records containing both ``fruit'' and
+``fish'',
+
+=item *
+
+C<@or fish chicken> searches for records containing either ``fish'' or
+``chicken'' (or both),
+
+=item *
+
+C<@and fruit @or fish chicken> searches for records containing both
+``fruit'' and at least one of ``fish'' or ``chicken''.
+
+=item *
+
+C<@or rock @attr 1=21 mineral> searches for records either containing
+``rock'' or ``mineral'', but with the ``mineral'' search term carrying
+an attribute of type 1, with value 21 (typically interpreted to mean
+that the search term must occur in the ``subject'' field of the
+record.)
+
+=back
+
+B<CCL Queries>
+
+ $rs = $conn->search(-ccl2rpn => 'rock or su=mineral');
+ $rs = $conn->search(-ccl => 'rock or su=mineral');
+
+CCL is formally specified in the international standard ISO 8777
+(B<Commands for interactive text searching>) and also described in
+section 8.1 (B<Query Syntax Parsers>) of the Yaz toolkit
+documentation, B<YAZ User's Guide and Reference>.
+
+Briefly, however, there is a set of well-known keywords including
+C<and>, C<or> and C<not>. Words other than these are interpreted as
+search terms. Operating grouping (precedence) is specified by
+parentheses, and the semantics of a search term may be modified by
+prepending one or more comma-separated qualifiers qualifiers and an
+equals sign.
+
+So:
+
+=over 4
+
+=item *
+
+C<fruit> searches for the term ``fruit'',
+
+=item *
+
+C<fruit and fish> searches for records containing both ``fruit'' and
+``fish'',
+
+=item *
+
+C<fish or chicken> searches for records containing either ``fish'' or
+``chicken'' (or both),
+
+=item *
+
+C<fruit and (fish or chicken)> searches for records containing both
+``fruit'' and at least one of ``fish'' or ``chicken''.
+
+=item *
+
+C<rock or su=mineral> searches for records either containing
+``rock'' or ``mineral'', but with the ``mineral'' search term modified
+by the qualifier ``su'' (typically interpreted to mean that the search
+term must occur in the ``subject'' field of the record.)
+
+=back
+
+For CCL searches sent directly to the server (query type C<ccl>), the
+exact interpretation of the qualifiers is the server's
+responsibility. For searches compiled on the client side (query side
+C<ccl2rpn>) the interpretation of the qualifiers in terms of type-1
+attributes is determined by the contents of a file called
+I<### not yet implemented>.
+The format of this file is described in the Yaz documentation.
+
+B<CQL Queries>
+
+ $rs = $conn->search(-cql => 'au-(kernighan and ritchie)');
+
+CQL syntax is very similar to that of CCL.
+
+B<Setting Search Defaults>
+
+As an alternative to explicitly specifying the query type when
+invoking the C<search()> method, you can change the connection's
+default query type using its C<option()> method:
+
+ $conn->option(querytype => 'prefix');
+ $conn->option(querytype => 'ccl');
+ $conn->option(querytype => 'ccl2rpn');
+
+The connection's current default query type can be retrieved using
+C<option()> with no ``value'' argument:
+
+ $qt = $conn->option('querytype');
+
+The C<option()> method can be used to set and get numerous other
+defaults described in this document and elsewhere; this method exists
+not only on connections but also on managers (q.v.) and result sets.
+
+Another important option is C<databaseName>, whose value specifies
+which database is to be searched.
+
+=head2 Retrieval
+
+By default, records are requested from the server one at a time;
+this can be quite slow when retrieving several records. There are two
+ways of improving this. First, the C<present()> method can be used to
+explicitly precharge the cache. Its parameters are a start record and
+record count. In the following example, the present() is optional and
+merely makes the code run faster:
+
+ $rs->present(11, 5) or die ".....";
+ foreach my $i (11..15) {
+ my $rec = $rs->record($i);
+ ...
+ }
+
+The second way is with the C<prefetch> option. Setting this to a
+positive integer makes the C<record()> method fetch the next N
+records and place them in the cache if the the current record
+isn't already there. So the following code would cause two bouts of
+network activity, each retrieving 10 records.
+
+ $rs->option(prefetch => 10);
+ foreach my $i (1..20) {
+ my $rec = $rs->record($i);
+ ...
+ }
+
+In asynchronous mode, C<present()> and C<prefetch> merely cause the
+records to be scheduled for retrieval.
+
+
+B<Element Set>
+
+The default element set is ``b'' (brief). To change this, set the
+result set's C<elementSetName> option:
+
+ $rs->option(elementSetName => "f");
+
+B<Record Syntax>
+
+The default record syntax preferred by the C<Net::Z3950> module is
+GRS-1 (the One True Record syntax). If, however, you need to ask the
+server for a record using a different record syntax, then the way to
+do this is to set the C<preferredRecordSyntax> option of the result
+set from which the record is to be fetched:
+
+ $rs->option(preferredRecordSyntax => "SUTRS");
+
+The record syntaxes which may be requested are listed in the
+C<Net::Z3950::RecordSyntax> enumeration in the file C<Net/Z3950.pm>;
+they include
+C<Net::Z3950::RecordSyntax::GRS1>,
+C<Net::Z3950::RecordSyntax::SUTRS>,
+C<Net::Z3950::RecordSyntax::USMARC>,
+C<Net::Z3950::RecordSyntax::TEXT_XML>,
+C<Net::Z3950::RecordSyntax::APPLICATION_XML>
+and
+C<Net::Z3950::RecordSyntax::TEXT_HTML>
+
+(As always, C<option()> may also be invoked with no ``value''
+parameter to return the current value of the option.)
+
+=head2 Scanning
+
+B<### Note to self - write this section!>
+
+
+=head1 WHAT TO DO WITH YOUR RECORDS
+
+Once you've retrieved a record, what can you do with it?
+
+There are two broad approaches. One is just to display it to the
+user: this can always be done with the C<render()> method, as used in
+the sample code above, whatever the record syntax of the record.
+
+The more sophisticated approach is to perform appropriate analysis and
+manipulation of the raw record according to the record syntax. The
+raw data is retrieved using the C<rawdata()> method, and the record
+syntax can be determined using the universal C<isa()> method:
+
+ $raw = $rec->rawdata();
+ if ($rec->isa('Net::Z3950::Record::GRS1')) {
+ process_grs1_record($raw);
+ elsif ($rec->isa('Net::Z3950::Record::USMARC')) {
+ process_marc_record($raw);
+ } # etc.
+
+=head2 MARC RECORDS
+
+For further manipulation of MARC records, we recommend the existing
+MARC module in Ed Summers's directory at CPAN,
+http://cpan.valueclick.com/authors/id/E/ES/ESUMMERS/
+
+=head2 GRS-1 RECORDS
+
+The raw data of GRS-1 records in the C<Net::Z3950> module closely
+follows the structure of physcial GRS-1 records - see Appendices REC.5
+(B<Generic Record Syntax 1>), TAG (B<TagSet Definitions and Schemas>)
+and RET (B<Z39.50 Retrieval>) of the standard more details.
+
+The raw GRS-1 data is intended to be more or less self-describing, but
+here is a summary.
+
+=over 4
+
+=item *
+
+The raw data is a reference to an array of elements, each representing
+one of the fields of the record.
+
+=item *
+
+Each element is a C<Net::Z3950::APDU::TaggedElement> object. These
+objects support the accessor methods C<tagType()>, C<tagValue()>,
+C<tagOccurrence()> and C<content()>; the first three of these return
+numeric values, or strings in the less common case of string
+tag-values.
+
+=item *
+
+The C<content()> of an element is an object of type
+C<Net::Z3950::ElementData>. Its C<which()> method returns a constant
+indicating the type of the content, which may be any of the following:
+
+=over 4
+
+=item *
+
+C<Net::Z3950::ElementData::Numeric>
+indicates that the content is a number;
+access it via the
+C<numeric()>
+method.
+
+=item *
+
+C<Net::Z3950::ElementData::String>
+indicates that the content is a string of characters;
+access it via the
+C<string()>
+method.
+
+=item *
+
+C<Net::Z3950::ElementData::OID>
+indicates that the content is an OID, represented as a string with the
+components separated by periods (``C<.>'');
+access it via the
+C<oid()>
+method.
+
+=item *
+
+C<Net::Z3950::ElementData::Subtree>
+is
+a reference to another C<Net::Z3950::Record::GRS1> object, enabling
+arbitrary recursive nesting;
+access it via the
+C<subtree()>
+method.
+
+=back
+
+=back
+
+In the future, we plan to take you away from all this by introducing a
+C<Net::Z3950::Data> module which provides a DOM-like interface for
+walking hierarchically structured records independently of their
+record syntax. Keep watchin', kids!
+
+
+=head1 CHANGING SESSION PARAMETERS
+
+As with customising searching or retrieval behaviour, whole-session
+behaviour is customised by setting options. However, this needs to be
+done before the session is created, because the Z39.50 protocol
+doesn't provide a method for changing (for example) the preferred
+message size of an existing connection.
+
+In the C<Net::Z3950> module, this is done by creating a I<manager> - a
+controller for one or more connections. Then the manager's options
+can be set; then connections which are opened through the manager use
+the specified values for those options.
+
+As a matter of fact, I<every> connection is made through a manager.
+If one is not specified in the connection constructor, then the
+``default manager'' is used; it's automatically created the first time
+it's needed, then re-used for any other connections that need it.
+
+=head2 Make or Find a Manager
+
+A new manager is created as follows:
+
+ $mgr = new Net::Z3950::Manager();
+
+Once the manager exists, a new connection can be made through it by
+specifying the manager reference as the first argument to the connection
+constructor:
+
+ $conn = new Net::Z3950::Connection($mgr, 'indexdata.dk', 210);
+
+Or equivalently,
+
+ $conn = $mgr->connect('indexdata.dk', 210);
+
+In order to retrieve the manager through which a connection was made,
+whether it was the implicit default manager or not, use the
+C<manager()> method:
+
+ $mgr = $conn->manager();
+
+=head2 Set the Parameters
+
+There are two ways to set parameters. One we have already seen: the
+C<option()> method can be used to get and set option values for
+managers just as it can for connections and result sets:
+
+ $pms = $mgr->option('preferredMessageSize');
+ $mgr->option(preferredMessageSize => $pms*2);
+
+Alternatively, options may be passed to the manager constructor when
+the manager is first created:
+
+ $mgr = new Net::Z3950::Manager(
+ preferredMessageSize => 100*1024,
+ maximumRecordSize => 10*1024*1024,
+ preferredRecordSyntax => "GRS-1");
+
+This is I<exactly> equivalent to creating a ``vanilla'' manager with
+C<new Net::Z3950::Manager()>, then setting the three options with the
+C<option()> method.
+
+B<Message Size Parameters>
+
+The C<preferredMessageSize> and C<maximumRecordSize> parameters can be
+used to specify values of the corresponding parameters which are
+proposed to the server at initialisation time (although the server is
+not bound to honour them.) See sections 3.2.1.1.4
+(B<Preferred-message-size and Exceptional-message-size>) and 3.3
+(B<Message/Record Size and Segmentation>) of the Z39.50 standard
+itself for details.
+
+Both options default to one megabyte.
+
+B<Implementation Identification>
+
+The C<implementationId>, C<implementationName> and
+C<implementationVersion> options can be used to control the
+corresponding parameters in initialisation request sent to the server
+to identify the client. The default values are listed below in the
+section B<OPTION INHERITANCE>.
+
+B<Authentication>
+
+The C<user>, C<pass> and C<group> options can be specified for a
+manager so that they are passed as identification tokens at
+initialisation time to any connections opened through that manager.
+The three options are interpreted as follows:
+
+=over 4
+
+=item *
+
+If C<user> is not specified, then authentication is omitted (which is
+more or less the same as ``anonymous'' authentication).
+
+=item *
+
+If C<user> is specified but not C<pass>, then the value of the
+C<user> option is passed as an ``open'' authentication token.
+
+=item *
+
+If both C<user> and C<pass> are specified, then their values are
+passed in an ``idPass'' authentication structure, together with the
+value of C<group> if is it specified.
+
+=back
+
+By default, all three options are undefined, so no authentication is
+used.
+
+
+B<Character set and language negotiation>
+
+The C<charset> and C<language> options can be used to negotiate the
+character set and language to be used for connections opened through
+that manager. If these options are set, they are passed to the server
+in a character-negotition otherInfo package attached to the
+initialisation request.
+
+
+=head1 OPTION INHERITANCE
+
+The values of options are inherited from managers to connections,
+result sets and finally to records.
+
+This means that when a record is asked for an option value (whether by
+an application invoking its C<option()> method, or by code inside the
+module that needs to know how to behave), that value is looked for
+first in the record's own table of options; then, if it's not
+specified there, in the options of the result set from which the
+record was retrieved; then if it's not specified there, in those of
+the connection across which the result set was found; and finally, if
+not specified there either, in the options for the manager through
+which the connection was created.
+
+Similarly, option values requested from a result set are looked up (if
+not specified in the result set itself) in the connection, then the
+manager; and values requested from a connection fall back to its
+manager.
+
+This is why it made sense in an earlier example (see the section B<Set
+the Parameters>) to specify a value for the C<preferredRecordSyntax>
+option when creating a manager: the result of this is that, unless
+overridden, it will be the preferred record syntax when any record is
+retrieved from any result set retrieved from any connection created
+through that manager. In effect, it establishes a global default.
+Alternatively, one might specify different defaults on two different
+connections.
+
+In all cases, if the manager doesn't have a value for the requested
+option, then a hard-wired default is used. The defaults are as
+follows. (Please excuse the execrable formatting - that's what
+C<pod2html> does, and there's no sensible way around it.)
+
+=over 4
+
+=item C<die_handler>
+
+C<undef>
+A function to invoke if C<die()> is called within the main event loop.
+
+=item C<timeout>
+
+C<undef>
+The maximum number of seconds a manager will wait when its C<wait()>
+method is called. If the timeout elapses, C<wait()> returns an
+undefined value. B<Can not be set on a per-connection basis.>
+
+=item C<async>
+
+C<0>
+(Determines whether a given connection is in asynchronous mode.)
+
+=item C<preferredMessageSize>
+
+C<1024*1024>
+
+=item C<maximumRecordSize>
+
+C<1024*1024>
+
+=item C<user>
+
+C<undef>
+
+=item C<pass>
+
+C<undef>
+
+=item C<group>
+
+C<undef>
+
+=item C<implementationId>
+
+C<'Mike Taylor (id=169)'>
+
+=item C<implementationName>
+
+C<'Net::Z3950.pm (Perl)'>
+
+=item C<implementationVersion>
+
+C<$Net::Z3950::VERSION>
+
+=item C<charset>
+
+C<undef>
+
+=item C<language>
+
+C<undef>
+
+=item C<querytype>
+
+C<'prefix'>
+
+=item C<databaseName>
+
+C<'Default'>
+
+=item C<smallSetUpperBound>
+
+C<0>
+(This and the next four options provide flexible control for run-time
+details such as what record syntax to use when returning records. See
+sections
+3.2.2.1.4 (B<Small-set-element-set-names and
+Medium-set-element-set-names>)
+and
+3.2.2.1.6 (B<Small-set-upper-bound, Large-set-lower-bound, and
+Medium-set-present-number>)
+of the Z39.50 standard itself for details.)
+
+=item C<largeSetLowerBound>
+
+C<1>
+
+=item C<mediumSetPresentNumber>
+
+C<0>
+
+=item C<smallSetElementSetName>
+
+C<'f'>
+
+=item C<mediumSetElementSetName>
+
+C<'b'>
+
+=item C<preferredRecordSyntax>
+
+C<'GRS-1'>
+
+=item C<responsePosition>
+
+C<1>
+(Indicates the one-based position of the start term in the set of
+terms returned from a scan.)
+
+=item C<stepSize>
+
+C<0>
+(Indicates the number of terms between each of the terms returned from
+a scan.)
+
+=item C<numberOfEntries>
+
+C<20>
+(Indicates the number of terms to return from a scan.)
+
+=item C<elementSetName>
+
+C<'b'>
+
+=item C<namedResultSets>
+
+C<1> indicating boolean true. This option tells the client to use a
+new result set name for each new result set generated, so that old
+C<ResultSet> objects remain valid. For the benefit of old, broken
+servers, this option may be set to 0, indicating that same result-set
+name, C<default>, should be used for each search, so that each search
+invalidates all existing C<ResultSet>s.
+
+=back
+
+Any other option's value is undefined.
+
+
+=head1 ASYNCHRONOUS MODE
+
+I don't propose to discuss this at the moment, since I think it's more
+important to get the Tutorial out there with the synchronous stuff in
+place than to write the asynchronous stuff. I'll do it soon, honest.
+In the mean time, let me be clear: the asynchronous code itself is
+done and works (the synchronous interface is merely a thin layer on
+top of it) - it's only the I<documentation> that's not yet here.
+
+B<### Note to self - write this section!>
+
+
+=head1 NOW WHAT?
+
+This tutorial is only an overview of what can be done with the
+C<Net::Z3950> module. If you need more information that it provides,
+then you need to read the more technical documentation on the
+individual classes that make up the module -
+C<Net::Z3950> itself,
+C<Net::Z3950::Manager>,
+C<Net::Z3950::Connection>,
+C<Net::Z3950::ResultSet> and
+C<Net::Z3950::Record>.
+
+
+=head1 AUTHOR
+
+Mike Taylor E<lt>mike at indexdata.comE<gt>
+
+First version Sunday 28th January 2001.
+
+=cut
+
+1;
Added: packages/libnet-z3950-perl/branches/upstream/current/Z3950.pm
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/Z3950.pm 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/Z3950.pm 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,351 @@
+# $Id: Z3950.pm,v 1.45 2005/07/27 12:05:51 mike Exp $
+
+package Net::Z3950;
+
+use strict;
+use Carp;
+use vars qw($VERSION @ISA @EXPORT $AUTOLOAD);
+
+require Exporter;
+require DynaLoader;
+require AutoLoader;
+
+ at ISA = qw(Exporter DynaLoader);
+$VERSION = '0.50';
+
+sub AUTOLOAD {
+ # This AUTOLOAD is used to 'autoload' constants from the constant()
+ # XS function. If a constant is not found then control is passed
+ # to the AUTOLOAD in AutoLoader.
+
+ my $constname;
+ ($constname = $AUTOLOAD) =~ s/.*:://;
+ croak "& not defined" if $constname eq 'constant';
+ my $val = constant($constname, @_ ? $_[0] : 0);
+ if ($! != 0) {
+ if ($! =~ /Invalid/) {
+ $AutoLoader::AUTOLOAD = $AUTOLOAD;
+ goto &AutoLoader::AUTOLOAD;
+ }
+ else {
+ croak "Your vendor has not defined Net::Z3950 macro $constname";
+ }
+ }
+ no strict 'refs';
+ *$AUTOLOAD = sub () { $val };
+ goto &$AUTOLOAD;
+}
+
+bootstrap Net::Z3950 $VERSION;
+
+
+=head1 NAME
+
+Net::Z3950 - Perl extension for talking to Z39.50 servers.
+
+=head1 SYNOPSIS
+
+(This code blocks in reads: see below for sample non-blocking code
+which allows multiple servers to be searched in parallel.)
+
+ use Net::Z3950;
+
+ $conn = new Net::Z3950::Connection('server.host.name', 210)
+ or die $!;
+ $rs = $conn->search('au=kernighan or su=unix')
+ or die $conn->errmsg();
+
+ my $n = $rs->size();
+ print "found $n records:\n";
+ foreach $i (1..$n) {
+ $rec = $rs->record($i) or die $rs->errmsg();
+ print $rec->render();
+ }
+
+ $conn->close();
+
+=head1 DESCRIPTION
+
+This module provides a Perl interface to the Z39.50 information
+retrieval protocol (aka. ISO 23950), a mature and powerful protocol
+used in application domains as diverse as bibliographic information,
+geo-spatial mapping, museums and other cultural heritage information,
+and structured vocabulary navigation.
+
+C<Net::Z3950.pm> is an implementation of the Perl binding for ZOOM, the
+Z39.50 Objct Orientation Model. Bindings for the same abstract API
+are, or will be, available in other languages including C, C++, Java
+and Tcl.
+
+Two basic approaches are possible to building clients with this
+module:
+
+=over 4
+
+=item *
+
+The simple synchronous approach considers blocking reads acceptable, and
+therefore allows a straightforward style of imperative programming.
+This approach is suitable for clients which only talk to one server at
+a time, and is exemplified by the code in the SYNOPSIS section above.
+
+=item *
+
+The more complex asynchronous approach, appropriate for clients which
+multiplex simultaneous connections, requires a slightly less familiar
+event-driven programming style, as exemplified in the ASYNCHRONOUS
+SYNOPSIS section below.
+
+=back
+
+(The simpler synchronous interface functions are implemented as a thin
+layer on top of the asynchronous functions.)
+
+=head1 ASYNCHRONOUS SYNOPSIS
+
+(This code does not block in reads, and so is suitable for broadcast
+clients which search multiple servers simultaneously: see above for
+simpler sample code that blocks in reads.)
+
+I<### To be written>
+
+=cut
+
+
+# Define the operation-code enumeration. The values here are chosen
+# to be in a distinctive range (i.e. 3950 plus a small integer) so
+# that if they are misused in another context, they're easy to spot.
+package Net::Z3950::Op;
+sub Error { 3951 }
+sub Init { 3952 }
+sub Search { 3953 }
+sub Get { 3954 }
+sub DeleteRS { 3955 }
+sub Scan { 3956 }
+package Net::Z3950;
+
+
+# Define the record-syntax enumeration. These values must be kept
+# synchronised with the values implied by the oid_value enumeration in
+# the header file "yaz/oid.h"
+package Net::Z3950::RecordSyntax;
+sub UNIMARC { 16 }
+sub INTERMARC { 17 }
+sub CCF { 18 }
+sub USMARC { 19 }
+sub UKMARC { 20 }
+sub NORMARC { 21 }
+sub LIBRISMARC { 22 }
+sub DANMARC { 23 }
+sub FINMARC { 24 }
+sub MAB { 25 }
+sub CANMARC { 26 }
+sub SBN { 27 }
+sub PICAMARC { 28 }
+sub AUSMARC { 29 }
+sub IBERMARC { 30 }
+sub CATMARC { 31 }
+sub MALMARC { 32 }
+sub EXPLAIN { 33 }
+sub SUTRS { 34 }
+sub OPAC { 35 }
+sub SUMMARY { 36 }
+sub GRS0 { 37 }
+sub GRS1 { 38 }
+sub EXTENDED { 39 }
+sub TEXT_HTML { 70 }
+sub XML { 80 }
+sub TEXT_XML { 80 }
+sub APPLICATION_XML { 81 }
+
+use vars '%map';
+# Maps record-syntax name strings to enumeration members
+%map = (UNIMARC => UNIMARC,
+ INTERMARC => INTERMARC,
+ CCF => CCF,
+ USMARC => USMARC,
+ UKMARC => UKMARC,
+ NORMARC => NORMARC,
+ LIBRISMARC => LIBRISMARC,
+ DANMARC => DANMARC,
+ FINMARC => FINMARC,
+ MAB => MAB,
+ CANMARC => CANMARC,
+ SBN => SBN,
+ PICAMARC => PICAMARC,
+ AUSMARC => AUSMARC,
+ IBERMARC => IBERMARC,
+ CATMARC => CATMARC,
+ MALMARC => MALMARC,
+ EXPLAIN => EXPLAIN,
+ SUTRS => SUTRS,
+ OPAC => OPAC,
+ SUMMARY => SUMMARY,
+ GRS0 => GRS0,
+ GRS1 => GRS1,
+ EXTENDED => EXTENDED,
+ TEXT_HTML => TEXT_HTML,
+ XML => XML,
+ TEXT_XML => TEXT_XML,
+ APPLICATION_XML => APPLICATION_XML,
+ );
+package Net::Z3950;
+
+
+# Define the reason-for-decodeAPDU()-failure enumeration. This must
+# be kept synchronised with the values #defined in "yazwrap/yazwrap.h"
+package Net::Z3950::Reason;
+sub EOF { 23951 } # read EOF from connection (server gone)
+sub Incomplete { 23952 } # read bytes, but not yet a whole APDU
+sub Malformed { 23953 } # couldn't decode APDU (malformed)
+sub BadAPDU { 23954 } # APDU was well-formed but unrecognised
+sub Error { 23955 } # some other error (consult errno)
+package Net::Z3950;
+
+
+# Define the query-type enumeration. This must be kept synchronised
+# with the values #defined in "yazwrap/yazwrap.h"
+package Net::Z3950::QueryType;
+sub Prefix { 39501 } # Yaz's "@attr"-ish forward-Polish notation
+sub CCL { 39502 } # Send CCL string to server ``as is''
+sub CCL2RPN { 39503 } # Convert CCL to RPN (type-1) locally
+sub CQL { 39504 } # Send CQL string to server ``as is''
+package Net::Z3950;
+
+
+# Define the result-set-status enumeration, used by the
+# `resultSetStatus' field in the Net::Z3950::APDU::SearchResponse
+# class in cases where `searchStatus' is false (indicating failure).
+# This must be kept synchronised with the ASN.1 for the structure
+# described in section 3.2.2.1.11 of the Z39.50 standard itself.
+package Net::Z3950::ResultSetStatus;
+sub Subset { 1 }
+sub Interim { 2 }
+sub None { 3 }
+package Net::Z3950;
+
+
+# Define the present-status enumeration, used by the `presentStatus'
+# field in the Net::Z3950::APDU::SearchResponse class in cases where
+# `searchStatus' is true (indicating success). This must be kept
+# synchronised with the ASN.1 for the structure described in section
+# 3.2.2.1.11 of the Z39.50 standard itself.
+package Net::Z3950::PresentStatus;
+sub Success { 0 }
+sub Partial1 { 1 }
+sub Partial2 { 2 }
+sub Partial3 { 3 }
+sub Partial4 { 4 }
+sub Failure { 5 }
+package Net::Z3950;
+
+
+# Define the scan-status enumeration, used by the `scanStatus'
+# field in the Net::Z3950::APDU::ScanResponse class. This must be
+# kept synchronised with the ASN.1 for the structure described in
+# section 3.2.8.1.6 of the Z39.50 standard itself.
+package Net::Z3950::ScanStatus;
+sub Success { 0 }
+sub Partial1 { 1 }
+sub Partial2 { 2 }
+sub Partial3 { 3 }
+sub Partial4 { 4 }
+sub Partial5 { 5 }
+sub Failure { 6 }
+package Net::Z3950;
+
+
+# Include modules implementing Net::Z3950 classes
+use Net::Z3950::Manager;
+use Net::Z3950::Connection;
+use Net::Z3950::APDU;
+use Net::Z3950::ResultSet;
+use Net::Z3950::Record;
+use Net::Z3950::ScanSet;
+
+
+=head1 FUNCTIONS
+
+The C<Net::Z3950> module itself provides very few functions: most of the
+functionality is provided by the daughter modules included by C<Net::Z3950>
+- C<Net::Z3950::Manager>, C<Net::Z3950::Connection>, I<etc.>
+
+=cut
+
+
+=head2 errstr()
+
+ $errcode = $conn->errcode();
+ $errmsg = Net::Z3950::errmsg($errcode);
+ print "error $errcode ($errmsg)\n";
+
+Returns an English-language string describing the error indicated by
+the Z39.50 BIB-1 diagnostic error code I<$errcode>.
+
+=cut
+
+sub errstr {
+ my($errcode) = @_;
+
+ use Carp;
+ confess "errstr() called with undefined argument" if !defined $errcode;
+ return "not yet available (try again later)" if $errcode == 0;
+ return diagbib1_str($errcode);
+}
+
+
+=head2 opstr()
+
+ $str = Net::Z3950::opstr($conn->errop());
+ print "error occurred in $str\n";
+
+Returns an English-language string describing the operation indicated
+by the argument, which must be one of the C<Net::Z3950::Op::*> constants
+described in the documentation for the C<Net::Z3950::Connection> class's
+C<op()> method.
+
+=cut
+
+sub opstr {
+ my($op) = @_;
+ return "error" if $op == Net::Z3950::Op::Error;
+ return "init" if $op == Net::Z3950::Op::Init;
+ return "search" if $op == Net::Z3950::Op::Search;
+ return "get" if $op == Net::Z3950::Op::Get;
+ return "deleteRS" if $op == Net::Z3950::Op::DeleteRS;
+ return "scan" if $op == Net::Z3950::Op::Scan;
+ return "unknown op " . $op;
+}
+
+
+=head1 AUTHOR
+
+Mike Taylor E<lt>mike at indexdata.comE<gt>
+
+First version Tuesday 23rd May 2000.
+
+=head1 SEE ALSO
+
+The ZOOM API for Z39.50, of which this is an implementation, is fully
+specified at
+http://zoom.z3950.org
+where links to other implementations may also be found.
+
+This module is built on Index Data's Yaz (Yet Another Z39.50) toolkit,
+which is freely available at
+http://indexdata.dk/yaz/
+
+Index Data also provide a variety of other useful Z39.50 software
+including the free server/database Zebra, the commercial
+server/database Z'mbol, a Tcl interface to Z39.50 called Ir/Tcl, and a
+free web-to-Z39.50 gateway called Zap. See their home page at
+http://indexdata.dk/
+
+The best source of information about Z39.50 itself is the official
+Mainenance Agency at
+http://lcweb.loc.gov/z3950/agency/
+
+=cut
+
+1;
+__END__
Added: packages/libnet-z3950-perl/branches/upstream/current/Z3950.xs
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/Z3950.xs 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/Z3950.xs 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,217 @@
+/* $Header: /home/cvsroot/NetZ3950/Z3950.xs,v 1.6 2004/11/01 08:31:43 adam Exp $ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "yazwrap/yazwrap.h"
+
+/* Used for converting databuf-type arguments */
+static databuf SVstar2databuf(SV* svp)
+{
+ databuf buf;
+
+ if (SvOK(svp)) {
+ buf.data = (char*) SvPV(svp, buf.len);
+ } else {
+ buf.data = 0;
+ }
+
+ return buf;
+}
+
+static char *SVstar2MNPV(SV* svp)
+{
+ STRLEN dummy;
+
+ if (!SvOK(svp))
+ return 0;
+
+ return SvPV(svp, dummy);
+}
+
+
+/*
+ * The manifest-constant stuff, generated by h2xs, turns out not to be
+ * necessary or sufficient, so we don't use it. But it's non-trivial
+ * to surgically remove this code, so we leave it in for now -- the
+ * overhead can't be great.
+ */
+static int
+not_here(char *s)
+{
+ croak("%s not implemented on this architecture", s);
+ return -1;
+}
+
+static double
+constant(char *name, int arg)
+{
+ errno = 0;
+ switch (*name) {
+ case 'A':
+ break;
+ case 'B':
+ break;
+ case 'C':
+ break;
+ case 'D':
+ break;
+ case 'E':
+ break;
+ case 'F':
+ break;
+ case 'G':
+ break;
+ case 'H':
+ break;
+ case 'I':
+ break;
+ case 'J':
+ break;
+ case 'K':
+ break;
+ case 'L':
+ break;
+ case 'M':
+ break;
+ case 'N':
+ break;
+ case 'O':
+ break;
+ case 'P':
+ break;
+ case 'Q':
+ break;
+ case 'R':
+ break;
+ case 'S':
+ break;
+ case 'T':
+ break;
+ case 'U':
+ break;
+ case 'V':
+ break;
+ case 'W':
+ break;
+ case 'X':
+ break;
+ case 'Y':
+ break;
+ case 'Z':
+ break;
+ }
+ errno = EINVAL;
+ return 0;
+
+not_there:
+ errno = ENOENT;
+ return 0;
+}
+
+
+MODULE = Net::Z3950 PACKAGE = Net::Z3950
+
+PROTOTYPES: DISABLE
+
+
+double
+constant(name,arg)
+ char * name
+ int arg
+
+COMSTACK
+yaz_connect(addr)
+ char *addr
+
+int
+yaz_socket(cs)
+ COMSTACK cs
+
+int
+yaz_close(cs)
+ COMSTACK cs
+
+const char *
+diagbib1_str(errcode)
+ int errcode
+
+databuf
+makeInitRequest(referenceId, preferredMessageSize, maximumRecordSize, user, password, groupid, implementationId, implementationName, implementationVersion, charset, language, errmsg)
+ databuf referenceId
+ int preferredMessageSize
+ int maximumRecordSize
+ mnchar *user
+ mnchar *password
+ mnchar *groupid
+ mnchar *implementationId
+ mnchar *implementationName
+ mnchar *implementationVersion
+ mnchar *charset
+ mnchar *language
+ char *&errmsg
+ OUTPUT:
+ errmsg
+
+databuf
+makeSearchRequest(referenceId, smallSetUpperBound, largeSetLowerBound, mediumSetPresentNumber, resultSetName, databaseName, smallSetElementSetName, mediumSetElementSetName, preferredRecordSyntax, queryType, query, errmsg)
+ databuf referenceId
+ int smallSetUpperBound
+ int largeSetLowerBound
+ int mediumSetPresentNumber
+ char *resultSetName
+ char *databaseName
+ char *smallSetElementSetName
+ char *mediumSetElementSetName
+ int preferredRecordSyntax
+ int queryType
+ char *query
+ char *&errmsg
+ OUTPUT:
+ errmsg
+
+databuf
+makeScanRequest(referenceId, databaseName, stepSize, numberOfTermsRequested, preferredPositionInResponse, queryType, query, errmsg)
+ databuf referenceId
+ char *databaseName
+ int stepSize
+ int numberOfTermsRequested
+ int preferredPositionInResponse
+ int queryType
+ char *query
+ char *&errmsg
+ OUTPUT:
+ errmsg
+
+databuf
+makePresentRequest(referenceId, resultSetId, resultSetStartPoint, numberOfRecordsRequested, elementSetName, preferredRecordSyntax, errmsg)
+ databuf referenceId
+ char *resultSetId
+ int resultSetStartPoint
+ int numberOfRecordsRequested
+ char *elementSetName
+ int preferredRecordSyntax
+ char *&errmsg
+ OUTPUT:
+ errmsg
+
+databuf
+makeDeleteRSRequest(referenceId, resultSetId, errmsg)
+ databuf referenceId
+ char *resultSetId
+ char *&errmsg
+ OUTPUT:
+ errmsg
+
+SV *
+decodeAPDU(cs, reason)
+ COMSTACK cs
+ int &reason
+ OUTPUT:
+ reason
+
+int
+yaz_write(cs, buf)
+ COMSTACK cs
+ databuf buf
Added: packages/libnet-z3950-perl/branches/upstream/current/ccl.qual
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/ccl.qual 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/ccl.qual 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,7 @@
+# The type can be either numeric or it may be either u (use), r
+# (relation), p (position), s (structure), t (truncation) or c
+# (completeness).
+
+ti u=4 s=1
+au u=1 s=1
+term s=105
Added: packages/libnet-z3950-perl/branches/upstream/current/doc/Albums
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/doc/Albums 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/doc/Albums 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,105 @@
+Rainbow -- 1979 -- Down to Earth
+ 2000/5/21
+Rainbow -- 1981 -- Difficult to Cure
+ 2000/5/21
+Rainbow -- 1982 -- Straight Between the Eyes
+ 2000/5/21
+Rainbow -- 1977 -- Ritchie Blackmore's
+ 2000/5/22
+Billy Joel -- 1993 -- River of Dreams
+ 2000/5/22
+The Jimi Hendrix Experience -- 1970 -- Electric Ladyland
+ 2000/5/22
+The Firm -- 1985 -- The Firm
+ 2000/5/22
+UFO -- 1985 -- Misdemeanor
+ 2000/5/23
+Beatles -- 1966 -- Revolver
+ 2000/5/23
+Scorpions -- 1973? -- Lonesome Crow
+ 2000/5/23
+Various -- 1989 -- cc -O Sunnys.CDs.c -o Mirks.tape
+ 2000/5/23
+Blue Oyster Cult -- 1978 -- Some Enchanted Evening
+ 2000/5/23
+Blue Oyster Cult -- 1977 -- Spectres
+ 2000/5/23
+Blue Oyster Cult -- 1979 -- Mirrors
+ 2000/5/23
+Blue Oyster Cult -- 1981 -- Fire of Unknown Origin
+ 2000/5/23
+Blue Oyster Cult -- 1983 -- The Revolution by Night
+ 2000/5/24
+Genesis -- 1978 -- And Then There Were Three
+ 2000/5/24
+ 2000/5/25
+ 2000/7/2
+Simply Red -- 1991 -- Stars
+ 2000/5/25
+Billy Joel -- 1980 -- Glass Houses
+ 2000/5/25
+Deep Purple -- 1974 -- Burn
+ 2000/5/25
+Deep Purple -- 1973 -- Who Do We Think We Are?
+ 2000/5/25
+Dire Straits -- 1985 -- Brothers in Arms
+ 2000/5/25
+ 2000/5/26
+Deep Purple -- 1969 -- Deep Purple
+ 2000/5/26
+U2 -- 1983 -- Under A Blood Red Sky
+ 2000/5/26
+Marillion -- 1987 -- Clutching at Straws
+ 2000/5/26
+Journey -- 1975 -- Journey
+ 2000/5/26
+Journey -- 1977 -- Next
+ 2000/5/26
+UFO -- 1983 -- Making Contact
+ 2000/5/27
+UFO -- 1980 -- No Place to Run
+ 2000/5/27
+Whitesnake -- 1979 -- Love Hunter
+ 2000/5/27
+UFO -- 1982 -- Mechanix
+ 2000/5/28
+Whitesnake -- 1980 -- Ready an' Willing
+ 2000/5/29
+U2 -- 1988 -- Rattle and Hum (Double)
+ 2000/5/29
+Whitesnake -- 1981 -- Come an' Get It
+ 2000/6/3
+Whitesnake -- 1982 -- Saints an' Sinners
+ 2000/6/3
+Keith Green -- 1980 -- So You Wanna Go Back to Egypt?
+ 2000/6/4
+UFO -- 1979 -- Strangers in the Night (A Double Live Album)
+ 2000/6/4
+Keith Green -- 1981 -- The Keith Green Collection
+ 2000/6/7
+Chris De Burgh -- 1977 -- At The End of a Perfect Day
+ 2000/6/7
+Pink Floyd -- 1973 -- Dark Side of the Moon
+ 2000/6/8
+Pink Floyd -- 1988 -- Delicate Sound of Thunder
+ 2000/6/8
+Genesis -- 1980 -- Duke
+ 2000/6/8
+Deep Purple -- 1984 -- Perfect Strangers
+ 2000/6/21
+David Coverdale -- 1977 -- Northwinds
+ 2000/6/21
+Genesis -- 1972 -- Foxtrot
+ 2000/6/21
+Deep Purple -- 1968 -- Shades of Deep Purple
+ 2000/6/26
+Pink Floyd -- 1987 -- A Momentary Lapse of Reason
+ 2000/6/27
+David Gilmour -- 1984 -- About Face
+ 2000/6/27
+Iona -- 1990 -- Iona
+ 2000/6/27
+Rainbow -- 1977 -- Rising
+ 2000/6/29
+Deep Purple -- 1970 -- In Rock
+ 2000/7/2
Added: packages/libnet-z3950-perl/branches/upstream/current/doc/Makefile
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/doc/Makefile 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/doc/Makefile 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,30 @@
+# $Header: /home/cvsroot/NetZ3950/doc/Makefile,v 1.6 2004/11/22 22:59:58 mike Exp $
+
+MODULES = Z3950 Z3950/Tutorial Z3950/Manager Z3950/Connection Z3950/APDU \
+ Z3950/ResultSet Z3950/Record
+PERL = $(MODULES:%=../%.pm)
+HTML = $(MODULES:%=%.html)
+JUNK = pod2html-dircache pod2html-itemcache \
+ pod2htmd.x~~ pod2htmi.x~~ \
+ pod2htmd.tmp pod2htmi.tmp
+
+all: Z3950 Z3950/style.css $(HTML)
+
+Z3950:
+ mkdir Z3950
+
+Z3950/style.css: style.css
+ rm -f $@; cp $? $@
+
+%.html: ../%.pm
+ ./htmlify < $? > $@
+
+### Why do we need this rule? Isn't is a special case of the last one?
+Z3950/%.html: ../Z3950/%.pm
+ ./htmlify < $? > $@
+
+clean:
+ rm -f $(HTML) Z3950/style.css $(JUNK)
+ rmdir Z3950
+
+distclean: clean
Added: packages/libnet-z3950-perl/branches/upstream/current/doc/gui.html
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/doc/gui.html 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/doc/gui.html 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,22 @@
+<HTML>
+ <HEAD>
+ <TITLE>GUIs for Perl/Net::Z3950 Applications</TITLE>
+ </HEAD>
+ <BODY>
+ <H1>GUIs for Perl/Net::Z3950 Applications</H1>
+ <P>
+ Because the Net::Z3950 code is driven by the standard generic event loop
+ (provided by the <TT>Event</TT> module), you might think it would be
+ easy to integrate it with with a GUI toolkit to achieve a GUI Z39.50
+ client. Yes and no. The two main GUI toolkits for perl are Tk and
+ Qt: the former does not integrate with Event, but the latter does -
+ although I've not done it myself. See the file <TT>perlqt.t</TT> in
+ the Event distribution, which shows how to do it, but hints that it
+ will probably be necessary to rebuild Qt first :-(
+ <P>
+ Looks like I'm going to have to either learn Qt <I><sigh></I>
+ or wait until the Tk maintainers fulfil what's apparently a
+ long-standing intention to make it Event-friendly
+ <I><double-sigh></I>
+ </BODY>
+</HTML>
Added: packages/libnet-z3950-perl/branches/upstream/current/doc/htmlify
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/doc/htmlify 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/doc/htmlify 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,7 @@
+#!/bin/sh
+
+# HTMLify -- trivial wrapper to pod2html making output acceptable.
+# $Header: /home/cvsroot/NetZ3950/doc/htmlify,v 1.1 2001/10/12 15:17:51 mike Exp $
+
+pod2html ${@+"$@"} |
+ sed 's@^</HEAD>$@<LINK rel="stylesheet" type="text/css" href="style.css">&@; s/<HR>//'
Property changes on: packages/libnet-z3950-perl/branches/upstream/current/doc/htmlify
___________________________________________________________________
Name: svn:executable
+
Added: packages/libnet-z3950-perl/branches/upstream/current/doc/index.html
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/doc/index.html 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/doc/index.html 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,77 @@
+<HTML>
+ <HEAD>
+ <TITLE>Net::Z3950 - Perl extension for talking to Z39.50 servers</TITLE>
+ <LINK rel="stylesheet" type="text/css" href="style.css">
+ </HEAD>
+ <BODY>
+ <H1>Net::Z3950 - Perl extension for talking to Z39.50 servers</H1>
+
+ <H2>Why a Documentation Directory?</H2>
+ <P>
+ For a while, I experimented with having the HTML form of the POD
+ documents living alongside the Perl source, but that turns out to be
+ Hard To Do right - you end up fighting the MakeMaker - so I decided
+ it wasn't worth the effort, and moved all the documentation into
+ this separate directory, where the building of the HTML is
+ controlled by a simple Makefile.
+
+ <H2>User Documents</H2>
+ <P>
+ The bulk of the documentation is from the PODs in the source files:
+ it is intended to provide everything that a user of the Net::Z3950 module
+ could need to know.
+ <P>
+ It should be read in the following order:
+ <UL>
+ <LI><A href="Z3950.html">Net::Z3950 module overview</A>
+ <LI><A href="Z3950/Tutorial.html">Tutorial</A>
+ <LI><A href="Z3950/Manager.html">The Net::Z3950::Manager class</A>
+ <LI><A href="Z3950/Connection.html">The Net::Z3950::Connection class</A>
+ <LI><A href="Z3950/ResultSet.html">The Net::Z3950::ResultSet class</A>
+ <LI><A href="Z3950/Record.html">The Net::Z3950::Record class</A>
+ <LI>Standard options <B>(NOT YET)</B>
+ <LI><A href="Z3950/APDU.html">The Net::Z3950::APDU class</A>
+ <I>(Don't bother reading this)</I>
+ </UL>
+ <P>
+ Yes, it's ridiculous that I need to provide this hand-maintained
+ index. What I should clearly do is have the SEE ALSO section of the
+ top-level Net::Z3950 overview manual link to all the other manuals
+ describing specific data types. Unfortunately (can you believe this?)
+ I can't find any construct in POD which converts to a simple relative
+ link in HTML.
+ <P>
+ Other things that may be worth reading:
+ <UL>
+ <LI>Thoughts about <A href="gui.html">putting a GUI on Net::Z950/Perl
+ applications</A>
+ <LI>Notes about <A href="todo.html">work still to be done</A>
+ </UL>
+
+ <H2>Developer Documents</H2>
+ <P>
+ There are a few additional bits and pieces that may be of interest
+ to people who want to develop the module further:
+ <UL>
+ <LI><A href="visit.html">Early documentation</A> written on
+ the bus and plane to visit Index Data in Denmark, and
+ including some notes added during the discussions there, of
+ which the most interesting are the revised interface
+ sketches. <B>Please understand that this is out of date, and
+ of historical interest only</B>
+ <LI>A list of the <A href="Albums">music</A> that I listened
+ to while I was writing it. (OK, I admit it has a lot of
+ mid-seventies semi-metal crud in it. That's because I did the
+ work in my office at home, which has an old-fashioned
+ turntable in it, and gives me a rare opportunity to revive my
+ teen years with the aid of all that obsolete vinyl that's
+ gathering dust in the corner. Also, if I were coming over all
+ sentimental, I might comment on how certain songs on the Chris
+ De Burgh album present an achingly resonant insight into the
+ ephemerality of human life, the noble tragedy of the world's
+ continuous losses as people grow old and die, and the human
+ condition generally. But hey, this is supposed to be a
+ technical document, so I won't mention any of that stuff.)
+ </UL>
+ </BODY>
+<HTML>
Added: packages/libnet-z3950-perl/branches/upstream/current/doc/style.css
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/doc/style.css 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/doc/style.css 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,9 @@
+/*
+ * style.css -- HTML style-sheet for Net::Z3950 documentation
+ * $Header: /home/cvsroot/NetZ3950/doc/style.css,v 1.2 2001/10/19 15:40:25 mike Exp $
+ */
+body { color: #000040; background: white }
+h1 { color: #ffffa0; background: #a00000; margin-top: 20px;
+ padding: 5px 10px; border: 1px transparent }
+h2,h3,h4,h5,h6 { color: #600000 }
+.warning { color: #ff0000; background: #ffff80 }
Added: packages/libnet-z3950-perl/branches/upstream/current/doc/todo.html
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/doc/todo.html 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/doc/todo.html 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,48 @@
+<HTML>
+ <HEAD>
+ <TITLE>Work still to be done in Net::Z3950.pm</TITLE>
+ <STYLE type="text/css"><!--
+ /* Netscape 4.51 applies this to the entire <UL> rather than
+ to the individual <LI>s within it: my mistake or its bug? */
+ ul li { margin-top: 0.5em; }
+ --></STYLE>
+ </HEAD>
+ <BODY>
+ <H1>Work still to be done in Net::Z3950.pm</H1>
+ <P>
+ Things that need fixing include, but may not be limited to, the
+ following. (They're listed in the order that they occurred to me,
+ which is by no means order of importance or anything.)
+ <UL>
+ <LI>Creating a non-blocking COMSTACK to a non-existent server
+ (e.g. <TT>ECONNREFUSED</TT>) is not properly diagnosed,
+ yielding a <TT>SIGPIPE</TT> instead of a graceful error
+ report.
+ <LI>Support for more types of APDU.
+ <LI>Support for more of the elements in APDUs of types that are
+ handled -- for example, the initResponse APDU's
+ <TT>otherInfo</TT> field.
+ <LI>Rework the sample code (including fragments in the SYNOPSIS
+ sections of the various PODs) to reflect the reality of the
+ fully-evolved interface more fully.
+ <LI>Test all the code-paths related to non-blocking multiplexing -
+ sending a PDU of which only a part can be written in the
+ initial syswrite(), receiving a PDU of which only a part can
+ be read in the initial cs_get(), doing both together across
+ multiple connections, etc.
+ <LI>Improve the reporting of Z39.50 errors.
+ <LI>Clue in the Event.pm dispatcher to call the
+ <TT>decodeAPDU()</TT> again straight away when
+ <TT>cs_more()</TT> is true.
+ <LI>Fix <TT>makeInitRequest()</TT> (and no doubt other functions
+ too) to understand undefined arguments, and pass null pointers
+ accordingly. (By inspection, all <TT>undef</TT> arguments are
+ passed as the same zero-length string - address
+ <TT>0x80b94fc</TT> in my most recent run - so it should be
+ possible to tie this down as the address of a well-known
+ zero-length object in the Perl run-time system, perhaps
+ something related to <TT>PL_sv_undef</TT>.)
+ <LI>Write a simple command-line Zthes browsing client.
+ </UL>
+ </BODY>
+</HTML>
Added: packages/libnet-z3950-perl/branches/upstream/current/doc/visit.html
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/doc/visit.html 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/doc/visit.html 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,178 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
+<!-- This is "visit.html", as automatically converted from the Psion
+ WRD file where I made notes during the visit, with only minor
+ hacks to improve the HTML, fix spelling mistakes, etc. -->
+<html>
+<head>
+<title>ZZPerl - Perl interface to Z39.50</title>
+</head>
+<body>
+<!-- Header text "" -->
+<h1>ZZPerl - Perl interface to Z39.50</h1>
+
+<h2>Class Hierarchy</h2>
+
+<p>
+All classes defined by the Z3950 Perl module (note the absence of the
+dot - this really is a Perl module name) are of the form
+<i>Z3950::*</i>.
+
+<h3>Z3950::Manager</h3>
+
+<p>
+This encapsulate the Z3950 module's global state - option for search
+parsing, preferred record syntaxes, compiled configuration files,
+<i>etc.</i> - as well as a list of references to all the open
+connections. We would normally expect there to be just one of these,
+but I suppose there's no reason why you shouldn't make more if you
+want.
+
+<h3>Z3950::Connection</h3>
+
+<p>
+Represents an established connection to a particular server on a
+particular port, together with options such as the default database in
+which to search. Maintains a record of all outstanding requests, and
+maybe - why not? - history of previous requests.
+
+<p>
+(Could have this merely store information and not actually do the the
+INIT until you do a search.)
+
+<h3>Z3950::Search</h3>
+
+<p>
+Represents a compiled search, ready to be sent to a server. May be
+built by calling a constructor to compile a search command (e.g. using
+CCL with a specified set of qualifiers) or Index Data's prefix
+notation; or a Type-1 or 101 query may be built "by hand" by creating
+an composing nodes of type <b>Z3950::Search::Type1</b> and promoting
+the top-level node to a fully-fledged <b>Z3950::Search</b>.
+
+<h3>Z3950::ResultSet</h3>
+
+<p>
+Represents the result of executing a search against a specific
+database on a specific connection, and contains an ordered list of
+zero or more elements each of which is either a record or a surrogate
+diagnostic (see below).
+
+<h3>Z3950::Record</h3>
+
+<p>
+This is an abstract type, in the sense that it is never actually
+instantiated. Instead, it is used as a base class - really an
+interface specification - for a variety of concrete derivatives, of
+which the most interesting are:
+
+<ul>
+<li><b>Z3950::Record::SUTRS</b>
+<li><b>Z3950::Record::USMARC</b>
+<li><b>Z3950::Record::DANMARC</b>
+<li><i>etc.</i>
+<li><b>Z3950::Record::GRS1</b>
+<li><b>Z3950::Record::XML</b>
+</ul>
+
+<p>
+(Alternatively, the various <b>*MARC</b> record types could be
+represented as <b>Z3950::Record::MARC::US</b> <i>etc.</i>)
+
+<p>
+Each of these record types defines standard methods for operations
+such as as ``what's your type?'' and ``render yourself''.
+
+<p>
+An obvious starting point would be to implement SUTRS only - it's easy
+to translate a C-level SUTRS record (basically a string) into a Perl
+version.
+
+<p>
+The various MARC formats could perhaps also be dealt with trivially by
+simply returning a flat block of data to be interpreted by a
+pre-existing MARC package - is there such a beast on CPAN?
+
+<p>
+The real challenge of course is translating GRS-1 records from Yaz's
+format into Perl data structures: this will presumably require us to
+define yet more types such as Z3950::Record::GRS1::Element and build
+recursive trees reflecting the GRS-1 ASN.1 in Appendix RET.
+
+<p>
+XML records can be passed through "as it".
+
+<h3>Z3950::Diagnostic</h3>
+
+<p>
+Represents a surrogate diagnostic occurring in a result set in place
+of a record. (Non-surrogate diagnostics do not have an explicit
+representation - they are indicated by methods returning an undefined
+value and storing error information in the object.)
+
+<h3>Future Directions</h3>
+
+<p>
+The type system described in this document provides an interface to
+only four Z39.50 services - INIT, SEARCH, PRESENT and (implicitly)
+CLOSE. A future version could also provide objects to invoke SCAN,
+EXTENDED SERVICES, <i>etc.</i>
+
+<h3>Note</h3>
+
+<p>
+This system appears simple and indeed obvious. Is that because it's
+trivial, or is it just elegantly minimal and generally perfect? (And
+do those two options even conflict?)
+
+<h2>GRS-1 Interface</h2>
+
+<p>
+Apart from the obvious traversal functions, we want to be able to say:
+
+<ul>
+<li>Get me all top-level elements tagged (2,1)
+<li>Get me all elements with tag-path (2,1)/(4,2)/(1,1)
+<li>zthes-like selection by related element.
+</ul>
+
+<h2>Simple Client Code</h2>
+<BLOCKQUOTE><PRE>
+use Z3950;
+$conn = new Z3950::Connection('indexdata.dk');
+$rs = $conn->search('au=kernighan');
+foreach $rec ($rs->records()) {
+ print $rec->render();
+}
+</PRE></BLOCKQUOTE>
+
+<h2>Multiplexing Client Code</h2>
+<BLOCKQUOTE><PRE>
+use Z3950;
+$mgr = new Z3950::Manager(-mode => 'async');
+my @conn;
+foreach $host ('indexdata.dk', 'tecc.co.uk') {
+ push @conn, $mgr->startConnect($host);
+}
+foreach $conn (@conn) {
+ $conn->startSearch('au=kernighan');
+}
+while ($conn = $mgr->wait()) {
+ if ($conn->failed()) {
+ die "error " . $conn->errcode() .
+ "( " . $conn->addinfo() . ")" .
+ " in " . $conn->where();
+ }
+ $op = $conn->op();
+ if ($op == Z3950::Op::Search) {
+ $rs = $conn->resultSet();
+ $size = $rs->size();
+ $rs->startGet(1, $size);
+ } elsif ($op == Z3950::Op::Get) {
+ foreach $rec ($conn->records()) {
+ print $rec->render();
+ }
+}
+</PRE></BLOCKQUOTE>
+<!-- Footer text "%P" -->
+</body>
+</html>
Added: packages/libnet-z3950-perl/branches/upstream/current/samples/ISBNs
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/samples/ISBNs 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/samples/ISBNs 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,9 @@
+0253333490
+0892782986
+080186481X
+1559633042
+0521576733
+0231107102
+0312262264
+0563537434
+0060952814
Added: packages/libnet-z3950-perl/branches/upstream/current/samples/README
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/samples/README 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/samples/README 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,9 @@
+$Id: README,v 1.3 2003/06/26 21:39:16 mike Exp $
+
+Sample code in this directory:
+
+canonical.pl The most trivial complete program: fetch and print a record
+fetch1.pl Like canonical.pl but with rudimentary error checking
+simple.pl Similar, but takes command-line args and prints all records
+batch-isbn.pl Fetch a batch of records with ISBNs taken from names file
+multiplex.pl Searches concurrently across multiple servers
Added: packages/libnet-z3950-perl/branches/upstream/current/samples/batch-isbn.pl
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/samples/batch-isbn.pl 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/samples/batch-isbn.pl 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,39 @@
+#!/usr/bin/perl -w
+
+# $Id: batch-isbn.pl,v 1.2 2003/11/21 12:05:47 mike Exp $
+#
+# Fetch records for a batch of books, the ISBNs of which are read from
+# a named file. Hardwired to use the nasty, slow LoC server.
+
+use Net::Z3950;
+use IO::File;
+use strict;
+
+die "Usage: batch-isbn.pl <ISBN-file>\n"
+ unless @ARGV == 1;
+
+my $filename = $ARGV[0];
+my $fh = new IO::File("<$filename")
+ or die "can't open ISBN file '$filename': $!";
+my @isbn = <$fh>;
+$fh->close();
+
+my $query = '@attr 1=7 ' . '@or ' x (@isbn-1) . join('', @isbn);
+$query =~ tr/\n/ /;
+warn $query;
+
+my $conn = new Net::Z3950::Connection('z3950.loc.gov', 7090,
+ databaseName => 'Voyager')
+ or die "can't connect to LoC: $!";
+
+$conn->option(preferredRecordSyntax => "USMARC");
+my $rs = $conn->search($query)
+ or die $conn->errmsg();
+my $n = $rs->size();
+print "found $n of " . scalar(@isbn) . " records\n";
+
+for (my $i = 1; $i <= $n; $i++) {
+ my $rec = $rs->record($i)
+ or die $rs->errmsg();
+ print $rec->render();
+}
Added: packages/libnet-z3950-perl/branches/upstream/current/samples/canonical.pl
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/samples/canonical.pl 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/samples/canonical.pl 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,9 @@
+#!/usr/bin/perl -w
+
+use Net::Z3950;
+$conn = new Net::Z3950::Connection('z3950.loc.gov', 7090,
+ databaseName => 'Voyager');
+$conn->option('preferredRecordSyntax', "USMARC");
+$rs = $conn->search('@attr 1=7 0253333490');
+$rec = $rs->record(1);
+print $rec->render();
Added: packages/libnet-z3950-perl/branches/upstream/current/samples/fetch1.pl
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/samples/fetch1.pl 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/samples/fetch1.pl 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,14 @@
+#!/usr/bin/perl -w
+
+use Net::Z3950;
+$conn = new Net::Z3950::Connection('z3950.loc.gov', 7090,
+ databaseName => 'Voyager')
+ or die "can't connect: $!";
+$conn->option('preferredRecordSyntax', "USMARC");
+$rs = $conn->search('@attr 1=7 0253333490')
+ or die "can't search: " . $conn->errmsg() . " (" . $conn->addinfo() . ")";
+print "found ", $rs->size(), " records:\n";
+exit if $rs->size() == 0;
+$rec = $rs->record(1)
+ or die "can't get record: " . $rs->errmsg() . " (" . $rs->addinfo() . ")";
+print $rec->render();
Property changes on: packages/libnet-z3950-perl/branches/upstream/current/samples/fetch1.pl
___________________________________________________________________
Name: svn:executable
+
Added: packages/libnet-z3950-perl/branches/upstream/current/samples/multiplex.pl
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/samples/multiplex.pl 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/samples/multiplex.pl 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,68 @@
+#!/usr/bin/perl -w
+
+# $Id: multiplex.pl,v 1.6 2005/01/05 16:24:53 mike Exp $
+
+use Net::Z3950;
+use strict;
+
+# Feel free to modify @servers and @searches
+my @servers = (
+ ['Z3950cat.bl.uk', 9909, "BLAC"],
+ ['bagel.indexdata.dk', 210, "gils"],
+ ['z3950.loc.gov', 7090, "Voyager"],
+ );
+
+my @searches = ('computer', 'data', 'survey', 'mineral');
+my %conn2si; # Indicates, for each connection, how
+ # far through @searches it has got.
+
+my $mgr = new Net::Z3950::Manager(async => 1,
+ preferredRecordSyntax => "usmarc");
+my @conn;
+foreach my $spec (@servers) {
+ my($host, $port, $dbname) = @$spec;
+ my $conn = new Net::Z3950::Connection($mgr, $host, $port, \&done_init,
+ databaseName => $dbname)
+ or die "can't connect to $host:$port: $!";
+ #print "> got $conn, added it to $mgr\n";
+}
+
+
+#$Event::DebugLevel = 5;
+$mgr->wait();
+print "Finished.\n";
+use Errno qw(ECONNREFUSED);
+if ($! == ECONNREFUSED) {
+ ### At present, a single connection failing to connect makes the
+ # whole concurrent session end. Need to consider the interface.
+ print "(Possible premature exit due to $!)\n";
+}
+
+
+sub done_init {
+ my($conn, $apdu) = @_;
+
+ print $conn->name(), " - done init\n";
+ $conn2si{$conn} = 0;
+ $conn->startSearch($searches[0], \&done_search);
+}
+
+sub done_search {
+ my($conn, $apdu) = @_;
+
+ my $si = $conn2si{$conn};
+ my $rs = $conn->resultSet();
+ if (!defined $rs) {
+ print $conn->name(), " - search failed: ", $conn->errmsg(), "\n";
+ } else {
+ print $conn->name(), " - search ", $si+1,
+ " found ", $rs->size(), " records\n";
+ }
+ my $search = $searches[++$conn2si{$conn}];
+ if (defined $search) {
+ $conn->startSearch($search, \&done_search);
+ } else {
+ print $conn->name(), " finished!\n";
+ $conn->close();
+ }
+}
Property changes on: packages/libnet-z3950-perl/branches/upstream/current/samples/multiplex.pl
___________________________________________________________________
Name: svn:executable
+
Added: packages/libnet-z3950-perl/branches/upstream/current/samples/scan.pl
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/samples/scan.pl 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/samples/scan.pl 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,87 @@
+#!/usr/bin/perl -w
+
+# $Id: scan.pl,v 1.5 2004/05/07 16:58:15 mike Exp $
+#
+# e.g. run as follows:
+# cd /usr/local/src/z39.50/NetZ3950
+# PERL_DL_NONLAZY=1 /usr/bin/perl "-Iblib/lib" "-Iblib/arch" \
+# samples/scan.pl bagel 210 gils x responsePosition 5
+# OR gondolin.hist.liv.ac.uk 210 l5r foo stepSize 4
+
+use Net::Z3950;
+use strict;
+
+my $verbose = 0;
+if (@ARGV > 0 && $ARGV[0] eq "-v") {
+ $verbose = 1;
+ shift;
+}
+
+die "Usage: scan.pl <host> <port> <db> <scan-query> [<option> <value>] ...\n"
+ unless @ARGV >= 4;
+my $host = shift();
+my $port = shift();
+my $db = shift();
+my $scanQuery = shift();
+my $mgr = new Net::Z3950::Manager();
+while (@ARGV) {
+ my $type = shift();
+ my $val = shift();
+ $mgr->option($type, $val);
+}
+
+my $conn = new Net::Z3950::Connection($mgr, $host, $port, databaseName => $db)
+ or die "can't connect: ". ($! == -1 ? "init refused" : $!);
+
+my $ss = $conn->scan($scanQuery);
+die "scan: " . error($conn) if !defined $ss;
+
+$conn->close();
+if ($verbose) {
+ use Data::Dumper;
+ print Dumper($ss);
+}
+
+my $status = $ss->status();
+if ($status != Net::Z3950::ScanStatus::Success) {
+ print "Scan-status is $status: ";
+ if ($status == Net::Z3950::ScanStatus::Failure) {
+ my $addinfo = $ss->addinfo();
+ print "scan failed\n";
+ print "error ", $ss->errcode(), ": ", $ss->errmsg();
+ print " ($addinfo)" if $addinfo;
+ print "\n";
+ exit;
+ }
+ print "only partial results included\n";
+}
+
+my $n = $ss->size();
+my $step = $ss->stepSize();
+my $pos = $ss->position();
+
+print "Scanned $n entries";
+print ", step-size $step" if defined $step;
+print ", position=$pos" if defined $pos;
+print "\n";
+
+for (my $i = 1; $i <= $n; $i++) {
+ my($term, $count) = $ss->term($i-1);
+ print "-->" if defined $pos && $i == $pos;
+ if (!defined $term) {
+ print "\tNSD: ", $ss->errmsg(), "\n";
+ } else {
+ print "\t$term ($count)\n";
+ }
+}
+
+
+sub error {
+ my($x) = @_;
+
+ my $res = "error " . $x->errcode() . ": " . $x->errmsg();
+ my $addinfo = $x->addinfo();
+ $res .= " ($addinfo)" if defined $addinfo;
+
+ return $res;
+}
Added: packages/libnet-z3950-perl/branches/upstream/current/samples/simple.pl
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/samples/simple.pl 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/samples/simple.pl 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,43 @@
+#!/usr/bin/perl -w
+
+# $Header: /home/cvsroot/NetZ3950/samples/simple.pl,v 1.13 2003/11/21 12:05:48 mike Exp $
+
+use Net::Z3950;
+use strict;
+
+die "Usage: simple.pl <host> <port> <db> <\@query> [<option> <value>] ...\n"
+ unless @ARGV >= 4;
+my $host = shift();
+my $port = shift();
+my $db = shift();
+my $query = shift();
+my $mgr = new Net::Z3950::Manager();
+$mgr->option(preferredRecordSyntax => "USMARC");
+while (@ARGV) {
+ my $type = shift();
+ my $val = shift();
+ $mgr->option($type, $val);
+}
+
+my $conn = new Net::Z3950::Connection($mgr, $host, $port, databaseName => $db)
+ or die "can't connect: ". ($! == -1 ? "init refused" : $!);
+
+my $rs = $conn->search($query)
+ or die("search: " . $conn->errmsg(),
+ defined $conn->addinfo() ? ": " . $conn->addinfo() : "");
+
+my $n = $rs->size();
+print "found $n records:\n";
+
+for (my $i = 0; $i < $n; $i++) {
+ my $rec = $rs->record($i+1);
+ if (!defined $rec) {
+ print STDERR "record ", $i+1, ": error #", $rs->errcode(),
+ " (", $rs->errmsg(), "): ", $rs->addinfo(), "\n";
+ next;
+ }
+ print "=== record ", $i+1, " ===\n", $rec, "\n", $rec->render();
+}
+
+$rs->delete(); # may not be supported by all servers
+$conn->close();
Property changes on: packages/libnet-z3950-perl/branches/upstream/current/samples/simple.pl
___________________________________________________________________
Name: svn:executable
+
Added: packages/libnet-z3950-perl/branches/upstream/current/test.pl
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/test.pl 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/test.pl 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,314 @@
+# $Header: /home/cvsroot/NetZ3950/test.pl,v 1.12 2005/04/21 10:05:31 mike Exp $
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..23\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Net::Z3950;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+use strict;
+
+# Test 1 was ability to load module
+
+## ------------------------------ cut here ------------------------------
+
+# For a similar test, run:
+# perl samples/simple.pl indexdata.dk 210 gils mineral
+
+
+# Check that constants work
+### This is vacuous now they're defined in Perl rather than C
+if (Net::Z3950::Reason::EOF == 23951 &&
+ Net::Z3950::Reason::Incomplete == 23952 &&
+ Net::Z3950::Reason::Malformed == 23953 &&
+ Net::Z3950::Reason::BadAPDU == 23954 &&
+ Net::Z3950::Reason::Error == 23955) {
+ print "ok 2\n";
+} else {
+ print "not ok 2\n";
+}
+
+# Check that Net::Z3950::diagbib1_str() works
+if (Net::Z3950::diagbib1_str(1) eq 'Permanent system error' &&
+ Net::Z3950::diagbib1_str(2) eq 'Temporary system error' &&
+ Net::Z3950::diagbib1_str(3) eq 'Unsupported search' &&
+ Net::Z3950::diagbib1_str(28) eq 'Result set is in use') {
+ print "ok 3\n";
+} else {
+ print "not ok 3\n";
+}
+
+# Create Net::Z3950 manager
+my $mgr = new Net::Z3950::Manager(async => 1,
+ smallSetUpperBound => 0, largeSetLowerBound => 10000,
+ mediumSetPresentNumber => 5,
+ preferredRecordSyntax => "GRS-1"
+# preferredRecordSyntax => "USMARC"
+ )
+ or (print "not ok 4\n"), exit;
+print "ok 4\n";
+
+# Forge connection to the local "yaz-ztest" server
+### You need to be connected to the internet for this to work, of course.
+my $conn1 = $mgr->connect('bagel.indexdata.dk', 210)
+ or (print "not ok 5 ($!)\n"), exit;
+print "ok 5\n";
+
+# no-op for historical reasons
+print "ok 6\n";
+
+# First init response
+my $conn = $mgr->wait()
+ or (print "not ok 7\n"), exit;
+print "ok 7\n";
+
+# Is the nominated connection one that we created?
+check_connection(8, $conn);
+
+# Which operation fired? Should be an Init
+check_op(9, $conn->op(), Net::Z3950::Op::Init);
+
+# Was the connection accepted?
+my $r = $conn->initResponse();
+if (!$r->result()) {
+ print "not ok 10\n";
+ exit;
+}
+print "ok 10\n";
+
+# We shouldn't really print this stuff if a test script.
+if (0) {
+ print "Connection accepted\n";
+ print "referenceId: '", $r->referenceId(), "'\n";
+ print "preferredMessageSize: '", $r->preferredMessageSize(), "'\n";
+ print "maximumRecordSize: '", $r->maximumRecordSize(), "'\n";
+ print "implementationId: '", $r->implementationId(), "'\n";
+ print "implementationName: '", $r->implementationName(), "'\n";
+ print "implementationVersion: '", $r->implementationVersion(), "'\n";
+}
+
+# No test -- currently this "just works"
+# Amazingly, the GILS server supports neither 1=1 nor 1=21!
+$conn1->option('databaseName', 'gils');
+$conn1->startSearch(-prefix => '@or mineral machine');
+
+# First search response
+$conn = $mgr->wait()
+ or (print "not ok 11\n"), exit;
+print "ok 11\n";
+
+# Is the nominated connection one that we created?
+check_connection(12, $conn);
+
+# Which operation fired? Should be an Search
+check_op(13, $conn->op(), Net::Z3950::Op::Search);
+
+# Fetch result set
+my $rs = $conn->resultSet()
+ or error(14, $conn);
+print "ok 14\n";
+
+# No test -- this "just works"
+my $size = $rs->size();
+
+# We shouldn't really print this stuff if a test script.
+if (0) {
+ my $r = $rs->{searchResponse};
+ print "referenceId: '", $r->referenceId(), "'\n";
+ print "resultCount: '", $r->resultCount(), "'\n";
+ print "numberOfRecordsReturned: '", $r->numberOfRecordsReturned(), "'\n";
+ print "nextResultSetPosition: '", $r->nextResultSetPosition(), "'\n";
+ print "searchStatus: '", $r->searchStatus(), "'\n";
+ print "resultSetStatus: '", $r->resultSetStatus(), "'\n";
+ print "presentStatus: '", $r->presentStatus(), "'\n";
+ print "records: '", $r->records(), "'\n";
+ if (0) {
+ print "in detail: ";
+ use Data::Dumper;
+ print Dumper($r->records());
+ }
+}
+
+my @seen = map { 0 } 0..$size;
+my $nreq = 0;
+
+my $rec; # we want this visible after the loop exits
+OUTER_LOOP: while (1) {
+ # Test whether any elements of @tmp apart from 0'th are false
+ {
+ my @tmp = @seen;
+ shift @tmp;
+ last OUTER_LOOP if !grep { !$_ } @tmp;
+ }
+
+ for (my $i = 1; $i <= $size; $i++) {
+ next if $seen[$i];
+
+ $rec = $rs->record($i);
+ if (defined $rec) {
+ # We shouldn't really print this stuff if a test script.
+ if (0) {
+ print "\nRecord $i: ", $rec->render();
+ }
+ $seen[$i] = 1;
+ } elsif ($rs->errcode() != 0) {
+ # The test suite will stop early here if you run it
+ # against the "ztest" server supplied with Yaz, after the
+ # 11th record of 17 in the result set. This is due to
+ # ztest's somewhat idiosyncratic interpretation of what
+ # constitutes a seventeen-record result set. Test against
+ # a real server instead.
+ die("can't fetch record $i of $size: " .
+ "error code=" . $rs->errcode() .
+ " [" . Net::Z3950::errstr($rs->errcode()) . "], " .
+ "addinfo='". $rs->addinfo() . "'");
+ } else {
+ # Record is not yet available -- we wait for requested
+ # records to arrive "every so often", say one in three.
+ next if ++$nreq < 3;
+ $conn = $mgr->wait();
+ die "oops -- expected Op::Get"
+ if $conn->op() != Net::Z3950::Op::Get;
+ $nreq = 0;
+ next OUTER_LOOP;
+ }
+ }
+}
+
+### The following tests know details of the Zebra demo database
+my $sq = $rs->subqueryCount();
+
+$size == 18 and
+$sq->{'mineral'} == 18 and
+$sq->{'machine'} == 0
+ or (print "not ok 15\n"), exit;
+print "ok 15\n";
+
+$rec->render() eq qq[6 fields:
+(1,1) 1.2.840.10003.13.2
+(1,14) "34"
+(2,1) "MINERAL OCCURRENCES, DEPOSITS, PROSPECTS, AND MINES"
+(4,52) "NEVADA BUREAU OF MINES AND GEOLOGY"
+(4,1) "ESDD0048"
+(1,16) "199101"
+]
+ or (print "not ok 16\nrec='", $rec->render(), "'\n"), exit;
+print "ok 16\n";
+
+# Testing scan
+$conn->startScan('mineral');
+$conn = $mgr->wait()
+ or (print "not ok 17\n"), exit;
+print "ok 17\n";
+
+# Which operation fired? Should be a Scan
+check_op(18, $conn->op(), Net::Z3950::Op::Scan);
+my $sr = $conn->scanResponse();
+
+if ($sr->scanStatus() != 0 ||
+ $sr->positionOfTerm() != 1 ||
+ $sr->stepSize() != 0 ||
+ $sr->numberOfEntriesReturned() != 20) {
+ print "not ok 19\n";
+ print "scanResponse APDU:\n";
+ foreach my $key (sort keys %$sr) {
+ print "$key -> $sr->{$key}\n";
+ }
+ exit;
+}
+print "ok 19\n";
+
+my $term0 = $sr->entries()->[0]->termInfo();
+my $term19 = $sr->entries()->[19]->termInfo();
+if ($term0->term()->general() ne "mineral" ||
+ $term0->globalOccurrences() != 18 ||
+ $term19->term()->general() ne "national" ||
+ $term19->globalOccurrences() != 2) {
+ print "not ok 20\n";
+ print "scanResponse entries:\n";
+ foreach my $entry (@{$sr->entries()}) {
+ foreach my $key (keys %{$entry}) {
+ print("\t", $entry->termInfo()->term()->general(),
+ " (" . $entry->termInfo()->globalOccurrences() . ")\n");
+ }
+ }
+}
+print "ok 20\n";
+
+# Check scan's error-reporting
+my $oldDB = $conn->option(databaseName => "nonExistentDB");
+$conn->startScan('fruit');
+$conn->option(databaseName => $oldDB);
+$conn = $mgr->wait()
+ or (print "not ok 21\n"), exit;
+print "ok 21\n";
+
+check_op(22, $conn->op(), Net::Z3950::Op::Scan);
+my $sr = $conn->scanResponse();
+
+if ($sr->scanStatus() != 6 ||
+ $sr->diag()->condition() != 109 ||
+ $sr->diag()->addinfo() ne "nonExistentDB") {
+ print "not ok 23\n";
+ { use Data::Dumper; print Dumper($sr); }
+}
+print "ok 23\n";
+
+print "\ntests complete\n";
+exit;
+
+
+sub check_connection {
+ my($testno, $conn) = @_;
+
+ if ($conn != $conn1) {
+ print "not ok $testno\n";
+ exit 1;
+ }
+
+ print "ok $testno\n";
+}
+
+
+sub check_op {
+ my($testno, $op, $wanted) = @_;
+
+ if ($op != $wanted) {
+ print "not ok $testno\n";
+ exit 1;
+ }
+
+ print "ok $testno\n";
+}
+
+
+# Called on failure for test $testno; according to Perl-module test
+# harness "best practice", this should just print "not ok $testno" and
+# exit, but in Real Life(tm), we want any additional error information
+# that's accrued in the connection object.
+#
+sub error {
+ my($testno, $conn) = @_;
+
+ print "not ok $testno\n";
+ if ($conn->errcode()) {
+ print("[error ", $conn->errcode(),
+ " (", Net::Z3950::diagbib1_str($conn->errcode()), ")",
+ " - ", $conn->addinfo(), "]\n");
+ }
+ exit 1;
+}
Added: packages/libnet-z3950-perl/branches/upstream/current/typemap
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/typemap 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/typemap 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,35 @@
+# $Header: /home/cvsroot/NetZ3950/typemap,v 1.1.1.1 2001/02/12 10:53:54 mike Exp $
+
+# We need this for three reasons.
+#
+# 1. To provide the trivial mappings for types like "const char *"
+# (which clearly behaves the same as a "char *", so why isn't it in
+# the default typemap?) and COMSTACK (on opaque pointer).
+#
+# 2. To provide a mapping for the "databuf" type, a simple
+# counted-length data buffer (we can't use a simple char* as it chokes
+# on NUL characters.)
+#
+# 3. To provide support for the nmchar* (maybe-null char*) type. This
+# behaves the same as boring old char* except that it's legitimate to
+# pass an undefined value, which yields a null pointer.
+
+# basic C types
+const char * T_PV
+COMSTACK T_PTR
+databuf T_DATABUF
+mnchar * T_MNPV
+
+#############################################################################
+INPUT
+T_DATABUF
+ $var = SVstar2databuf($arg)
+T_MNPV
+ $var = SVstar2MNPV($arg)
+
+#############################################################################
+OUTPUT
+T_DATABUF
+ sv_setpvn($arg, $var.data, $var.len);
+T_MNPV
+ NOT IMPLEMENTED
Added: packages/libnet-z3950-perl/branches/upstream/current/yazwrap/Makefile.PL
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/yazwrap/Makefile.PL 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/yazwrap/Makefile.PL 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,28 @@
+use ExtUtils::MakeMaker;
+$Verbose = 1;
+
+WriteMakefile(
+ 'NAME' => 'Net::Z3950::yazwrap',
+ 'SKIP' => [qw(all static dynamic test)],
+ 'clean' => {'FILES' => 'libyazwrap$(LIB_EXT)'},
+ 'OPTIMIZE' => '-g', ### temporary
+# Some systems like to be told: 'DEFINE' => '-D_GNU_SOURCE'
+);
+
+
+sub MY::top_targets {
+ '
+all :: static
+
+static :: libyazwrap$(LIB_EXT)
+
+libyazwrap$(LIB_EXT): $(O_FILES)
+ $(AR) cr libyazwrap$(LIB_EXT) $(O_FILES)
+ $(RANLIB) libyazwrap$(LIB_EXT)
+
+# nothing to test
+
+test:
+
+';
+}
Added: packages/libnet-z3950-perl/branches/upstream/current/yazwrap/connect.c
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/yazwrap/connect.c 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/yazwrap/connect.c 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,62 @@
+/* $Header: /home/cvsroot/NetZ3950/yazwrap/connect.c,v 1.5 2005/01/04 20:33:25 mike Exp $ */
+
+/*
+ * yazwrap/connect.c -- wrapper functions for Yaz's client API.
+ *
+ * Provide a simple Perl-level interface to Yaz's COMSTACK API. We
+ * need to use this because of its mystical ability to read only whole
+ * APDUs off the network stream.
+ */
+
+#include <yaz/tcpip.h>
+#include "ywpriv.h"
+
+
+/*
+ * We're setting up the connection in non-blocking mode, which is what
+ * we want. However, this means that the connect() (as well as
+ * subsequent read()s) will be non-blocking, so that we'll need to
+ * catch and service the "connection complete" callback in "receive.c"
+ */
+COMSTACK yaz_connect(char *addr)
+{
+ COMSTACK conn;
+ void *inaddr;
+
+ /* Second argument is `blocking', false => no immediate errors */
+ if ((conn = cs_create_host(addr, 0, &inaddr)) == 0) {
+ /* mostly likely `errno' will be ENOMEM or something useful */
+ return 0;
+ }
+
+ switch (cs_connect(conn, inaddr)) {
+ case -1: /* can't connect */
+ /* I think this never happens due to blocking=0 */
+/*printf("cs_connect() failed\n");*/
+ cs_close(conn);
+ return 0;
+ case 0: /* success */
+ /* I think this never happens due to blocking=0 */
+/*printf("cs_connect() succeeded\n");*/
+ break;
+ case 1: /* non-blocking -- "not yet" */
+/*printf("cs_connect() not yet\n");*/
+ break;
+ }
+
+ return conn;
+}
+
+
+/* Need a Real Function for Perl to call, as cs_fileno() is a macro */
+int yaz_socket(COMSTACK cs)
+{
+ return cs_fileno(cs);
+}
+
+/* just a wrapper for now, but who knows - perhaps it may do more later */
+
+int yaz_close(COMSTACK cs)
+{
+ return cs_close(cs);
+}
Added: packages/libnet-z3950-perl/branches/upstream/current/yazwrap/receive.c
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/yazwrap/receive.c 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/yazwrap/receive.c 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,1132 @@
+/* $Header: /home/cvsroot/NetZ3950/yazwrap/receive.c,v 1.19 2005/04/19 21:36:35 mike Exp $ */
+
+/*
+ * yazwrap/receive.c -- wrapper functions for Yaz's client API.
+ *
+ * This file provides a single function, decodeAPDU(), which pulls an
+ * APDU off the network, decodes it (using YAZ) and converts it from
+ * Yaz's C structures into broadly equivalent Perl functions.
+ */
+
+#include <assert.h>
+#include <yaz/proto.h>
+#include <yaz/oid.h>
+#include "ywpriv.h"
+
+
+static SV *translateAPDU(Z_APDU *apdu, int *reasonp);
+static SV *translateInitResponse(Z_InitResponse *res, int *reasonp);
+static SV *translateSearchResponse(Z_SearchResponse *res, int *reasonp);
+static SV *translateScanResponse(Z_ScanResponse *res, int *reasonp);
+static SV *translatePresentResponse(Z_PresentResponse *res, int *reasonp);
+static SV *translateDeleteRSResponse(Z_DeleteResultSetResponse *res,
+ int *reasonp);
+static SV *translateClose(Z_Close *res, int *reasonp);
+static SV *translateRecords(Z_Records *x);
+static SV *translateNamePlusRecordList(Z_NamePlusRecordList *x);
+static SV *translateNamePlusRecord(Z_NamePlusRecord *x);
+static SV *translateListEntries(Z_ListEntries *x, int *isErrorp);
+static SV *translateEntry(Z_Entry *x);
+static SV *translateTermInfo(Z_TermInfo *x);
+static SV *translateTerm(Z_Term *x);
+static SV *translateExternal(Z_External *x);
+static SV *translateSUTRS(Z_SUTRS *x);
+static SV *translateGenericRecord(Z_GenericRecord *x);
+static SV *translateTaggedElement(Z_TaggedElement *x);
+static SV *translateStringOrNumeric(Z_StringOrNumeric *x);
+static SV *translateElementData(Z_ElementData *x);
+static SV *translateOPACRecord(Z_OPACRecord *x);
+static SV *translateHoldingsRecord(Z_HoldingsRecord *x);
+static SV *translateHoldingsAndCirc(Z_HoldingsAndCircData *x);
+static SV *translateVolume(Z_Volume *x);
+static SV *translateCircRecord(Z_CircRecord *x);
+static SV *translateOctetAligned(Odr_oct *x, Odr_oid *direct_reference);
+static SV *translateFragmentSyntax(Z_FragmentSyntax *x);
+static SV *translateDiagRecs(Z_DiagRecs *x);
+static SV *translateDiagRec(Z_DiagRec *x);
+static SV *translateDefaultDiagFormat(Z_DefaultDiagFormat *x);
+static SV *translateOID(Odr_oid *x);
+static SV *translateOtherInformation(Z_OtherInformation *x);
+static SV *translateOtherInformationUnit(Z_OtherInformationUnit *x);
+static SV *translateSearchInfoReport(Z_SearchInfoReport *x);
+static SV *translateSearchInfoReport_s(Z_SearchInfoReport_s *x);
+static SV *translateQueryExpression(Z_QueryExpression *x);
+static SV *translateQueryExpressionTerm(Z_QueryExpressionTerm *x);
+static SV *newObject(char *class, SV *referent);
+static void setNumber(HV *hv, char *name, IV val);
+static void setString(HV *hv, char *name, char *val);
+static void setBuffer(HV *hv, char *name, char *valdata, int vallen);
+static void setMember(HV *hv, char *name, SV *val);
+
+
+/*
+ * This interface hides from the caller the possibility that the
+ * socket has become ready not because there's data to be read, but
+ * because the connect() has finished. In this case, we just return a
+ * null pointer with *reasonp==REASON_INCOMPLETE, which the caller
+ * will treat in the right way (try again later.)
+ *
+ * ### The "perlguts" manual strongly implies that returning a null
+ * pointer here and elsewhere is not good enough, and I need
+ * instead to return PL_sv_undef. In fact, null seems to work
+ * just fine.
+ */
+SV *decodeAPDU(COMSTACK cs, int *reasonp)
+{
+ static char *buf = 0; /* apparently, static is OK */
+ static int size = 0; /* apparently, static is OK */
+ int nbytes;
+ static ODR odr = 0;
+ Z_APDU *apdu;
+
+ switch (cs_look(cs)) {
+ case CS_CONNECT:
+ /* In fact, this never happens and I don't understand how the
+ * connection is successfully forged. We also don't get here
+ * if the connection _isn't_ forged: instead, the socket
+ * select()s as ready to write, and writing down it fails with
+ * ECONNREFUSED or whatever the error is. */
+ if (cs_rcvconnect(cs) < 0) {
+ *reasonp = REASON_ERROR;
+ } else {
+ *reasonp = REASON_INCOMPLETE;
+ }
+ return 0;
+ case CS_DATA:
+ break;
+ default:
+ fatal("surprising cs_look() result");
+ }
+
+ nbytes = cs_get(cs, &buf, &size);
+ switch (nbytes) {
+ case -1:
+ *reasonp = cs_errno(cs);
+ return 0;
+ case 0:
+ *reasonp = REASON_EOF;
+ return 0;
+ case 1:
+ *reasonp = REASON_INCOMPLETE;
+ return 0;
+ default:
+ /* We got enough bytes for a whole PDU */
+ break;
+ }
+
+ if (odr)
+ odr_reset(odr);
+ else {
+ if ((odr = odr_createmem(ODR_DECODE)) == 0) {
+ /* Perusal of the Yaz source shows that this is impossible:
+ * odr_createmem() only fails if the initial xmalloc() fails,
+ * but xmalloc() is #defined to xmalloc_f(), which goes fatal
+ * if the underlying xmalloc_d() call fails.
+ */
+ fatal("impossible odr_createmem() failure");
+ }
+ }
+
+ odr_setbuf(odr, buf, nbytes, 0);
+ if (!z_APDU(odr, &apdu, 0, 0)) {
+ /* Oops. Malformed APDU (can't be short, otherwise, we'd not
+ * have got a >1 response from cs_get()). There's nothing we
+ * can do about it.
+ */
+ *reasonp = REASON_MALFORMED;
+ return 0;
+ }
+
+ /* ### we should find a way to request another call if cs_more() */
+ return translateAPDU(apdu, reasonp);
+}
+
+
+/*
+ * This has to return a Perl data-structure representing the decoded
+ * APDU. What's the best way to do this? We have several options:
+ *
+ * 1. We can hack a new backend onto Yaz's existing ASN.1 compiler
+ * (written in Tcl!) so that it mechanically generates the
+ * functions necessary to convert Yaz's C data structures into
+ * Perl.
+ *
+ * 2. We can do it by hand, which will be more work but will yield a
+ * better final product. This also has the benefit of a lower
+ * startup cost (I don't have to grok the Tcl code) and a simpler
+ * distribution.
+ *
+ * 3. We can do (or have the ASN.1 compiler do) a mechanical job,
+ * translating into low-level Perl data structures like arrays
+ * and hashes, and have the Perl layer above this translate the
+ * "raw" structures into something more palatable.
+ *
+ * For now, I guess we'll go with option 2, just so we can demonstrate
+ * a successful Init negotiation. In the longer term, we'll probably
+ * need to run with 1 or 3, because there's a LOT of dull code to
+ * write!
+ *
+ * ### Do I need to check for the Perl "guts" functions returning
+ * null values? The manual doesn't seem to be clear on this.
+ */
+static SV *translateAPDU(Z_APDU *apdu, int *reasonp)
+{
+ switch (apdu->which) {
+ case Z_APDU_initResponse:
+ return translateInitResponse(apdu->u.initResponse, reasonp);
+ case Z_APDU_searchResponse:
+ return translateSearchResponse(apdu->u.searchResponse, reasonp);
+ case Z_APDU_scanResponse:
+ return translateScanResponse(apdu->u.scanResponse, reasonp);
+ case Z_APDU_presentResponse:
+ return translatePresentResponse(apdu->u.presentResponse, reasonp);
+ case Z_APDU_deleteResultSetResponse:
+ return translateDeleteRSResponse(apdu->u.deleteResultSetResponse,
+ reasonp);
+ case Z_APDU_close:
+ return translateClose(apdu->u.close, reasonp);
+ default:
+ break;
+ }
+
+ *reasonp = REASON_BADAPDU;
+ return 0;
+}
+
+
+static SV *translateInitResponse(Z_InitResponse *res, int *reasonp)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::InitResponse", (SV*) (hv = newHV()));
+
+ if (res->referenceId) {
+ setBuffer(hv, "referenceId",
+ (char*) res->referenceId->buf, res->referenceId->len);
+ }
+ /* protocolVersion not translated (complex data type) */
+ /* options not translated (complex data type) */
+ setNumber(hv, "preferredMessageSize", (IV) *res->preferredMessageSize);
+ setNumber(hv, "maximumRecordSize", (IV) *res->maximumRecordSize);
+ setNumber(hv, "result", (IV) *res->result);
+ if (res->implementationId)
+ setString(hv, "implementationId", res->implementationId);
+ if (res->implementationName)
+ setString(hv, "implementationName", res->implementationName);
+ if (res->implementationVersion)
+ setString(hv, "implementationVersion", res->implementationVersion);
+ /* userInformationField (OPT) not translated (complex data type) */
+ /* otherInfo (OPT) not translated (complex data type) */
+
+ return sv;
+}
+
+
+static SV *translateSearchResponse(Z_SearchResponse *res, int *reasonp)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::SearchResponse", (SV*) (hv = newHV()));
+ if (res->referenceId)
+ setBuffer(hv, "referenceId",
+ (char*) res->referenceId->buf, res->referenceId->len);
+
+ setNumber(hv, "resultCount", (IV) *res->resultCount);
+ setNumber(hv, "numberOfRecordsReturned",
+ (IV) *res->numberOfRecordsReturned);
+ setNumber(hv, "nextResultSetPosition", (IV) *res->nextResultSetPosition);
+ setNumber(hv, "searchStatus", (IV) *res->searchStatus);
+ if (res->resultSetStatus)
+ setNumber(hv, "resultSetStatus", (IV) *res->resultSetStatus);
+ if (res->presentStatus)
+ setNumber(hv, "presentStatus", (IV) *res->presentStatus);
+ if (res->records)
+ setMember(hv, "records", translateRecords(res->records));
+ if (res->additionalSearchInfo)
+ setMember(hv, "additionalSearchInfo", translateOtherInformation(res->additionalSearchInfo));
+
+ /* otherInfo (OPT) not translated (complex data type) */
+
+ return sv;
+}
+
+static SV *translateScanResponse(Z_ScanResponse *res, int *reasonp) {
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::ScanResponse", (SV*) (hv = newHV()));
+ if (res->referenceId) {
+ setBuffer(hv, "referenceId", (char*) res->referenceId->buf,
+ res->referenceId->len);
+ }
+
+ if (res->stepSize)
+ setNumber(hv, "stepSize", (IV) *res->stepSize);
+ setNumber(hv, "scanStatus", (IV) *res->scanStatus);
+ setNumber(hv, "numberOfEntriesReturned",
+ (IV) *res->numberOfEntriesReturned);
+ if (res->positionOfTerm)
+ setNumber(hv, "positionOfTerm", (IV) *res->positionOfTerm);
+ if (res->entries) {
+ int isError = 0;
+ SV *tmp = translateListEntries(res->entries, &isError);
+ setMember(hv, isError ? "diag" : "entries", tmp);
+ }
+
+ /* attributeSet (OPT) not translated (complex data type) */
+ /* otherInfo (OPT) not translated (complex data type) */
+
+ return sv;
+}
+
+static SV *translateDeleteRSResponse(Z_DeleteResultSetResponse *res,
+ int *reasonp)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::DeleteRSResponse", (SV*) (hv = newHV()));
+
+ if (res->referenceId) {
+ setBuffer(hv, "referenceId",
+ (char*) res->referenceId->buf, res->referenceId->len);
+ }
+
+ setNumber(hv, "deleteOperationStatus", (IV) *res->deleteOperationStatus);
+
+ /* ### We needn't bother with _any_ of this, really */
+ /* Z_ListStatuses *deleteListStatuses; /* OPT */
+ /* int *numberNotDeleted; /* OPT */
+ /* Z_ListStatuses *bulkStatuses; /* OPT */
+ /* Z_InternationalString *deleteMessage; /* OPT */
+ /* Z_OtherInformation *otherInfo; /* OPT */
+
+ return sv;
+}
+
+static SV *translateClose(Z_Close *res, int *reasonp)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::Close", (SV*) (hv = newHV()));
+
+ if (res->referenceId)
+ setBuffer(hv, "referenceId",
+ (char*) res->referenceId->buf, res->referenceId->len);
+
+ setNumber(hv, "closeReason", (IV) *res->closeReason);
+
+ if (res->diagnosticInformation)
+ setString(hv, "diagnosticInformation", (char*) res->referenceId);
+
+ /* resourceReportFormat (OPT) not translated */
+ /* resourceReport (OPT) not translated */
+ /* otherInfo (OPT) not translated */
+ return sv;
+}
+
+
+static SV *translatePresentResponse(Z_PresentResponse *res, int *reasonp)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::PresentResponse", (SV*) (hv = newHV()));
+
+ if (res->referenceId)
+ setBuffer(hv, "referenceId",
+ (char*) res->referenceId->buf, res->referenceId->len);
+ setNumber(hv, "numberOfRecordsReturned",
+ (IV) *res->numberOfRecordsReturned);
+ setNumber(hv, "nextResultSetPosition", (IV) *res->nextResultSetPosition);
+ setNumber(hv, "presentStatus", (IV) *res->presentStatus);
+ if (res->records)
+ setMember(hv, "records", translateRecords(res->records));
+
+ /* otherInfo (OPT) not translated (complex data type) */
+
+ return sv;
+}
+
+
+static SV *translateRecords(Z_Records *x)
+{
+ switch (x->which) {
+ case Z_Records_DBOSD:
+ return translateNamePlusRecordList(x->u.databaseOrSurDiagnostics);
+ case Z_Records_NSD:
+ return translateDefaultDiagFormat(x->u.nonSurrogateDiagnostic);
+ case Z_Records_multipleNSD:
+ return translateDiagRecs(x->u.multipleNonSurDiagnostics);
+ default:
+ break;
+ }
+ fatal("illegal `which' in Z_Records");
+ return 0; /* NOTREACHED; inhibit gcc -Wall warning */
+}
+
+
+static SV *translateNamePlusRecordList(Z_NamePlusRecordList *x)
+{
+ /* Represented as a reference to a blessed array of elements */
+ SV *sv;
+ AV *av;
+ int i;
+
+ sv = newObject("Net::Z3950::APDU::NamePlusRecordList", (SV*) (av = newAV()));
+ for (i = 0; i < x->num_records; i++)
+ av_push(av, translateNamePlusRecord(x->records[i]));
+
+ return sv;
+}
+
+
+static SV *translateNamePlusRecord(Z_NamePlusRecord *x)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::NamePlusRecord", (SV*) (hv = newHV()));
+ if (x->databaseName)
+ setString(hv, "databaseName", x->databaseName);
+ setNumber(hv, "which", x->which);
+
+ switch (x->which) {
+ case Z_NamePlusRecord_databaseRecord:
+ setMember(hv, "databaseRecord",
+ translateExternal(x->u.databaseRecord));
+ break;
+ case Z_NamePlusRecord_surrogateDiagnostic:
+ setMember(hv, "surrogateDiagnostic",
+ translateDiagRec(x->u.surrogateDiagnostic));
+ break;
+ case Z_NamePlusRecord_startingFragment:
+ setMember(hv, "startingFragment",
+ translateFragmentSyntax(x->u.startingFragment));
+ break;
+ case Z_NamePlusRecord_intermediateFragment:
+ setMember(hv, "intermediateFragment",
+ translateFragmentSyntax(x->u.intermediateFragment));
+ break;
+ case Z_NamePlusRecord_finalFragment:
+ setMember(hv, "finalFragment",
+ translateFragmentSyntax(x->u.finalFragment));
+ break;
+ default:
+ fatal("illegal `which' in Z_NamePlusRecord");
+ }
+
+ return sv;
+}
+
+
+static SV *translateListEntries(Z_ListEntries *x, int *isErrorp) {
+ /*
+ * This might return either a ListEntries object or a
+ * DefaultDiagFormat object, depending on which of x->entries and
+ * x->nonsurrogateDiagnostics is set. The ASN.1 says that both of
+ * these are optional but at least one must be included; but the
+ * Z39.50-1995 prose says that entries must _always_ be provided
+ * (presumably including when there are zero of them) and the
+ * diagnostics are optional. So we take the pragmatic approach
+ * that if there are diagnostics we return them, otherwise the
+ * entries. We further simplify by returning only the first
+ * diagnostic if there are several.
+ *
+ * ### This fails badly with the following scan:
+ * ruslan.ru:210/spstu
+ * @attr 1=21 fruit
+ * The response contains a set of entries _and_ multiple NSDs.
+ * This is because ruslan is a union catalogue of several
+ * database, some of which support scan on subject and some of
+ * which don't. The former supply terms, and the latter each
+ * supply a diagnostic. We need to change the structure we
+ * return.
+ *
+ * The entries object is represented as a reference to a blessed
+ * array of elements
+ */
+ SV *sv;
+ AV *av;
+ int i;
+
+ if (x->nonsurrogateDiagnostics) {
+ /* If there's more than one diagnostic, we just use the first */
+ *isErrorp = 1;
+ return translateDiagRec(x->nonsurrogateDiagnostics[0]);
+ }
+
+ /* No diagnostics, so return the actual entries */
+ sv = newObject("Net::Z3950::APDU::ListEntries", (SV*) (av = newAV()));
+ for (i=0; i < x->num_entries; i++) {
+ av_push(av, translateEntry(x->entries[i]));
+ }
+
+ return sv;
+}
+
+
+static SV *translateEntry(Z_Entry *x) {
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::Entry", (SV*) (hv = newHV()));
+ switch (x->which) {
+ case Z_Entry_termInfo:
+ setMember(hv, "termInfo", translateTermInfo(x->u.termInfo));
+ break;
+ case Z_Entry_surrogateDiagnostic:
+ setMember(hv, "surrogateDiagnostic",
+ translateDiagRec(x->u.surrogateDiagnostic));
+ break;
+ default:
+ fatal("illegal `which' in Z_Entry");
+ }
+
+ return sv;
+}
+
+
+static SV *translateTermInfo(Z_TermInfo *x) {
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::TermInfo", (SV*) (hv = newHV()));
+ setMember(hv, "term", translateTerm(x->term));
+
+ if (x->globalOccurrences)
+ setNumber(hv, "globalOccurrences", (IV) *x->globalOccurrences);
+
+ /* ### Lots of elements not translated here:
+ * displayTerm [0] IMPLICIT InternationalString
+ * suggestedAttributes AttributeList OPTIONAL,
+ * alternativeTerm [4] IMPLICIT SEQUENCE OF AttributesPlusTerm OPTIONAL,
+ * byAttributes [3] IMPLICIT OccurrenceByAttributes OPTIONAL,
+ * otherTermInfo OtherInformation OPTIONAL}
+ */
+
+ return sv;
+}
+
+
+static SV *translateTerm(Z_Term *x) {
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::Term", (SV*) (hv = newHV()));
+
+ switch (x->which) {
+ case Z_Term_general:
+ setBuffer(hv, "general", x->u.general->buf, x->u.general->len);
+ break;
+ case Z_Term_numeric:
+ /* ### this won't do at all */
+ break;
+ case Z_Term_characterString:
+ break;
+ case Z_Term_oid:
+ break;
+ case Z_Term_dateTime:
+ break;
+ case Z_Term_external:
+ break;
+ case Z_Term_integerAndUnit:
+ break;
+ case Z_Term_null:
+ break;
+ default:
+ fatal("illegal `which' in Z_Term");
+ }
+
+ return sv;
+}
+
+
+/*
+ * Section 3.4 (EXTERNAL Data) of chapter 3 (The ASN Module) of the
+ * Yaz Manual has this to say:
+ * For ASN.1 structured data, you need only consult the which
+ * field to determine the type of data. You can the access the
+ * data directly through the union.
+ * In other words, the Z_External structure's direct_reference,
+ * indirect_reference and descriptor fields are only there to help the
+ * data get across the network; and once it's done that (and arrived
+ * here), we can simply use the `which' discriminator to choose a
+ * branch of the union to encode.
+ *
+ * ### Exception: if I understand this correctly, then we need to
+ * have translateOctetAligned() consult x->direct_reference so it
+ * knows which specific *MARC class to bless the data into.
+ */
+static SV *translateExternal(Z_External *x)
+{
+ switch (x->which) {
+ case Z_External_sutrs:
+ return translateSUTRS(x->u.sutrs);
+ case Z_External_grs1:
+ return translateGenericRecord(x->u.grs1);
+ case Z_External_OPAC:
+ return translateOPACRecord(x->u.opac);
+ case Z_External_octet:
+ /* This is used for any opaque data-block (i.e. just a hunk of
+ * octets) -- in particular, for records in any of the *MARC
+ * syntaxes and for XML and HTML records.
+ */
+ return translateOctetAligned(x->u.octet_aligned, x->direct_reference);
+ case Z_External_searchResult1:
+ return translateSearchInfoReport(x->u.searchResult1);
+ default:
+ break;
+ }
+ fatal("illegal/unsupported `which' (%d) in Z_External", x->which);
+ return 0; /* NOTREACHED; inhibit gcc -Wall warning */
+}
+
+
+static SV *translateSUTRS(Z_SUTRS *x)
+{
+ /* Represent as a blessed scalar -- unusual but clearly appropriate.
+ * The usual scheme of things in this source file is to make objects of
+ * class Net::Z3950::APDU::*, but in this case and some other below, we go
+ * straight to the higher-level representation of a Net::Z3950::Record::*
+ * object, knowing that this is a subclass of its Net::Z3950::APDU::*
+ * analogue, but with additional, record-syntax-specific,
+ * functionality.
+ */
+ return newObject("Net::Z3950::Record::SUTRS",
+ newSVpvn((char*) x->buf, x->len));
+}
+
+
+static SV *translateGenericRecord(Z_GenericRecord *x)
+{
+ /* Represented as a reference to a blessed array of elements */
+ SV *sv;
+ AV *av;
+ int i;
+
+ /* See comment on class-name in translateSUTRS() above. We use
+ * ...::GRS1 rather than ...::GenericRecord because that's what the
+ * application-level calling code will expect.
+ */
+ sv = newObject("Net::Z3950::Record::GRS1", (SV*) (av = newAV()));
+ for (i = 0; i < x->num_elements; i++)
+ av_push(av, translateTaggedElement(x->elements[i]));
+
+ return sv;
+}
+
+
+static SV *translateTaggedElement(Z_TaggedElement *x)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::TaggedElement", (SV*) (hv = newHV()));
+ if (x->tagType)
+ setNumber(hv, "tagType", *x->tagType);
+ setMember(hv, "tagValue", translateStringOrNumeric(x->tagValue));
+ if (x->tagOccurrence)
+ setNumber(hv, "tagOccurrence", *x->tagOccurrence);
+ setMember(hv, "content", translateElementData(x->content));
+ /* Z_ElementMetaData *metaData; // OPT */
+ /* Z_Variant *appliedVariant; // OPT */
+
+ return sv;
+}
+
+
+static SV *translateStringOrNumeric(Z_StringOrNumeric *x)
+{
+ switch (x->which) {
+ case Z_StringOrNumeric_string:
+ return newSVpv(x->u.string, 0);
+ case Z_StringOrNumeric_numeric:
+ return newSViv(*x->u.numeric);
+ default:
+ break;
+ }
+ fatal("illegal `which' in Z_ElementData");
+ return 0; /* NOTREACHED; inhibit gcc -Wall warning */
+}
+
+
+/*
+ * It's tempting to treat this data by simply returning an appropriate
+ * Perl data structure, not bothering with an explicit discriminator --
+ * as translateStringOrNumeric() does for its data -- but that would
+ * mean (for example) that we couldn't tell the difference between
+ * elementNotThere, elementEmpty and noDataRequested. This would
+ * be A Bad Thing, since it's not this code's job to fix bugs in the
+ * standard :-) Instead, we return an object with an explicit `which'
+ * element, as translateNamePlusRecord() does.
+ */
+static SV *translateElementData(Z_ElementData *x)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::ElementData", (SV*) (hv = newHV()));
+ setNumber(hv, "which", x->which);
+
+ switch (x->which) {
+ case Z_ElementData_numeric:
+ setMember(hv, "numeric", newSViv(*x->u.numeric));
+ break;
+ case Z_ElementData_string:
+ setMember(hv, "string", newSVpv(x->u.string, 0));
+ break;
+ case Z_ElementData_oid:
+ setMember(hv, "oid", translateOID(x->u.oid));
+ break;
+ case Z_ElementData_subtree:
+ setMember(hv, "subtree", translateGenericRecord(x->u.subtree));
+ break;
+ default:
+ fatal("illegal/unsupported `which' (%d) in Z_ElementData", x->which);
+ }
+
+ return sv;
+}
+
+
+static SV *translateOPACRecord(Z_OPACRecord *x)
+{
+ SV *sv, *sv2;
+ HV *hv;
+ AV *av;
+ int i;
+
+ sv = newObject("Net::Z3950::Record::OPAC", (SV*) (hv = newHV()));
+ setMember(hv, "bibliographicRecord",
+ translateExternal(x->bibliographicRecord));
+ setNumber(hv, "num_holdingsData", x->num_holdingsData);
+
+ sv2 = newObject("Net::Z3950::APDU::HoldingsData", (SV*) (av = newAV()));
+ for (i = 0; i < x->num_holdingsData; i++)
+ av_push(av, translateHoldingsRecord(x->holdingsData[i]));
+ setMember(hv, "holdingsData", sv2);
+
+ return sv;
+}
+
+
+static SV *translateHoldingsRecord(Z_HoldingsRecord *x)
+{
+ switch (x->which) {
+ case Z_HoldingsRecord_marcHoldingsRecord:
+ return translateExternal(x->u.marcHoldingsRecord);
+ case Z_HoldingsRecord_holdingsAndCirc:
+ return translateHoldingsAndCirc(x->u.holdingsAndCirc);
+ default:
+ break;
+ }
+ fatal("illegal `which' in Z_HoldingsRecord");
+ return 0; /* NOTREACHED; inhibit gcc -Wall warning */
+}
+
+
+static SV *translateHoldingsAndCirc(Z_HoldingsAndCircData *x)
+{
+ SV *sv, *sv2;
+ HV *hv;
+ AV *av;
+ int i;
+
+ sv = newObject("Net::Z3950::APDU::HoldingsAndCirc", (SV*) (hv = newHV()));
+ if (x->typeOfRecord)
+ setString(hv, "typeOfRecord", x->typeOfRecord);
+ if (x->encodingLevel)
+ setString(hv, "encodingLevel", x->encodingLevel);
+ if (x->format)
+ setString(hv, "format", x->format);
+ if (x->receiptAcqStatus)
+ setString(hv, "receiptAcqStatus", x->receiptAcqStatus);
+ if (x->generalRetention)
+ setString(hv, "generalRetention", x->generalRetention);
+ if (x->completeness)
+ setString(hv, "completeness", x->completeness);
+ if (x->dateOfReport)
+ setString(hv, "dateOfReport", x->dateOfReport);
+ if (x->nucCode)
+ setString(hv, "nucCode", x->nucCode);
+ if (x->localLocation)
+ setString(hv, "localLocation", x->localLocation);
+ if (x->shelvingLocation)
+ setString(hv, "shelvingLocation", x->shelvingLocation);
+ if (x->callNumber)
+ setString(hv, "callNumber", x->callNumber);
+ if (x->shelvingData)
+ setString(hv, "shelvingData", x->shelvingData);
+ if (x->copyNumber)
+ setString(hv, "copyNumber", x->copyNumber);
+ if (x->publicNote)
+ setString(hv, "publicNote", x->publicNote);
+ if (x->reproductionNote)
+ setString(hv, "reproductionNote", x->reproductionNote);
+ if (x->termsUseRepro)
+ setString(hv, "termsUseRepro", x->termsUseRepro);
+ if (x->enumAndChron)
+ setString(hv, "enumAndChron", x->enumAndChron);
+
+ sv2 = newObject("Net::Z3950::APDU::Volumes", (SV*) (av = newAV()));
+ for (i = 0; i < x->num_volumes; i++)
+ av_push(av, translateVolume(x->volumes[i]));
+ setMember(hv, "volumes", sv2);
+
+ sv2 = newObject("Net::Z3950::APDU::CirculationData", (SV*) (av = newAV()));
+ for (i = 0; i < x->num_circulationData; i++)
+ av_push(av, translateCircRecord(x->circulationData[i]));
+ setMember(hv, "circulationData", sv2);
+
+ return sv;
+}
+
+
+static SV *translateVolume(Z_Volume *x)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::Volume", (SV*) (hv = newHV()));
+ if (x->enumeration)
+ setString(hv, "enumeration", x->enumeration);
+ if (x->chronology)
+ setString(hv, "chronology", x->chronology);
+ if (x->enumAndChron)
+ setString(hv, "enumAndChron", x->enumAndChron);
+
+ return sv;
+}
+
+
+static SV *translateCircRecord(Z_CircRecord *x)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::CircRecord", (SV*) (hv = newHV()));
+ setNumber(hv, "availableNow", *x->availableNow);
+ /* Note the typo in the next line. It goes right back to the
+ ASN.1 in the printed Z39.50-1995 standard, so the honest thing
+ here seems to be to propagate it into the Perl interface. */
+ if (x->availablityDate)
+ setString(hv, "availablityDate", x->availablityDate);
+ if (x->availableThru)
+ setString(hv, "availableThru", x->availableThru);
+ if (x->restrictions)
+ setString(hv, "restrictions", x->restrictions);
+ if (x->itemId)
+ setString(hv, "itemId", x->itemId);
+ setNumber(hv, "renewable", *x->renewable);
+ setNumber(hv, "onHold", *x->onHold);
+ if (x->enumAndChron)
+ setString(hv, "enumAndChron", x->enumAndChron);
+ if (x->midspine)
+ setString(hv, "midspine", x->midspine);
+ if (x->temporaryLocation)
+ setString(hv, "temporaryLocation", x->temporaryLocation);
+
+ return sv;
+}
+
+
+/*
+ * We use a blessed scalar string to represent the (non-ASN.1-encoded)
+ * record; the only difficult part is knowing what class to bless it into.
+ * We do that by looking up its record syntax in a hardwired table that
+ * maps it to a class-name string.
+ *
+ * We assume that the record, not processed here, will subsequently be
+ * picked apart by some pre-existing module, most likely the
+ * MARC::Record module for *MARC records; I'd be interested to know
+ * what people use for XML and HTML records.
+ */
+static SV *translateOctetAligned(Odr_oct *x, Odr_oid *direct_reference)
+{
+ struct {
+ oid_value val;
+ char *name;
+ } rs[] = {
+ { VAL_USMARC, "Net::Z3950::Record::USMARC" },
+ { VAL_UKMARC, "Net::Z3950::Record::UKMARC" },
+ { VAL_NORMARC, "Net::Z3950::Record::NORMARC" },
+ { VAL_LIBRISMARC, "Net::Z3950::Record::LIBRISMARC" },
+ { VAL_DANMARC, "Net::Z3950::Record::DANMARC" },
+ { VAL_UNIMARC, "Net::Z3950::Record::UNIMARC" },
+ { VAL_UNIMARC, "Net::Z3950::Record::UNIMARC" },
+ { VAL_HTML, "Net::Z3950::Record::HTML" },
+ { VAL_TEXT_XML, "Net::Z3950::Record::XML" },
+ { VAL_APPLICATION_XML, "Net::Z3950::Record::XML" },
+ { VAL_MAB, "Net::Z3950::Record::MAB" },
+ { VAL_NOP } /* end marker */
+ /* ### etc. */
+ };
+
+ int i;
+ for (i = 0; rs[i].val != VAL_NOP; i++) {
+ static struct oident ent = { PROTO_Z3950, CLASS_RECSYN };
+ int *oid;
+ ent.value = rs[i].val;
+ oid = oid_getoidbyent(&ent);
+ if (!oid_oidcmp(oid, direct_reference))
+ break;
+ }
+
+ if (rs[i].val == VAL_NOP)
+ fatal("can't translate record of unknown RS");
+
+ return newObject(rs[i].name, newSVpvn(x->buf, x->len));
+}
+
+
+static SV *translateFragmentSyntax(Z_FragmentSyntax *x)
+{
+ return 0; /* ### not yet implemented */
+}
+
+
+static SV *translateDiagRecs(Z_DiagRecs *x)
+{
+ /* Represented as a reference to a blessed array of elements */
+ SV *sv;
+ AV *av;
+ int i;
+
+ sv = newObject("Net::Z3950::APDU::DiagRecs", (SV*) (av = newAV()));
+ for (i = 0; i < x->num_diagRecs; i++)
+ av_push(av, translateDiagRec(x->diagRecs[i]));
+
+ return sv;
+}
+
+
+static SV *translateDiagRec(Z_DiagRec *x)
+{
+ switch (x->which) {
+ case Z_DiagRec_defaultFormat:
+ return translateDefaultDiagFormat(x->u.defaultFormat);
+ case Z_DiagRec_externallyDefined:
+ return translateExternal(x->u.externallyDefined);
+ default:
+ break;
+ }
+ fatal("illegal `which' in Z_DiagRec");
+ return 0; /* NOTREACHED; inhibit gcc -Wall warning */
+}
+
+
+static SV *translateDefaultDiagFormat(Z_DefaultDiagFormat *x)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::DefaultDiagFormat", (SV*) (hv = newHV()));
+ setMember(hv, "diagnosticSetId", translateOID(x->diagnosticSetId));
+ setNumber(hv, "condition", *x->condition);
+ /* ### we don't care what value of `which' pertains -- in either
+ * case, what we have is frankly a char*, so we let type punning
+ * take care of it.
+ */
+ setString(hv, "addinfo", x->u.v2Addinfo);
+ return sv;
+}
+
+
+static SV *translateOID(Odr_oid *x)
+{
+ /* Yaz represents an OID by an int array terminated by a negative
+ * value, typically -1; we represent it as a reference to a
+ * blessed scalar string of "."-separated elements.
+ */
+ char buf[1000];
+ int i;
+
+ *buf = '\0';
+ for (i = 0; x[i] >= 0; i++) {
+ sprintf(buf + strlen(buf), "%d", (int) x[i]);
+ if (x[i+1] >= 0)
+ strcat(buf, ".");
+ }
+
+ /*
+ * ### We'd like to return a blessed scalar (string) here, but of
+ * course you can't do that in Perl: only references can be
+ * blessed, so we'd have to return a _reference_ to a string, and
+ * bless _that_. Better to do without the blessing, I think.
+ */
+ if (1) {
+ return newSVpv(buf, 0);
+ } else {
+ return newObject("Net::Z3950::APDU::OID", newSVpv(buf, 0));
+ }
+}
+
+
+static SV *translateOtherInformation(Z_OtherInformation *x)
+{
+ SV *sv;
+ AV *av;
+ int i;
+
+ sv = newObject("Net::Z3950::APDU::OtherInformation", (SV*) (av = newAV()));
+ for (i=0; i < x->num_elements; i++) {
+ av_push(av, translateOtherInformationUnit(x->list[i]));
+ }
+
+ return sv;
+}
+
+
+static SV *translateOtherInformationUnit(Z_OtherInformationUnit *x)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::OtherInformationUnit",
+ (SV*) (hv = newHV()));
+
+ /* ### category not translated */
+ setNumber(hv, "which", x->which);
+ switch (x->which) {
+ case Z_OtherInfo_characterInfo:
+ break;
+ case Z_OtherInfo_binaryInfo:
+ break;
+ case Z_OtherInfo_externallyDefinedInfo:
+ setMember(hv, "externallyDefinedInfo",
+ translateExternal(x->information.externallyDefinedInfo));
+ return sv;
+ case Z_OtherInfo_oid:
+ break;
+ default:
+ break;
+ }
+
+ fatal("illegal/unsupported `which' (%d) in Z_OtherInformationUnit",
+ x->which);
+ return 0; /* NOTREACHED; inhibit gcc -Wall warning */
+}
+
+
+static SV *translateSearchInfoReport(Z_SearchInfoReport *x)
+{
+ SV *sv;
+ AV *av;
+ int i;
+
+ sv = newObject("Net::Z3950::APDU::SearchInfoReport", (SV*) (av = newAV()));
+ for (i=0; i < x->num; i++) {
+ av_push(av, translateSearchInfoReport_s(x->elements[i]));
+ }
+
+ return sv;
+}
+
+
+static SV *translateSearchInfoReport_s(Z_SearchInfoReport_s *x)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::SearchInfoReport_s",
+ (SV*) (hv = newHV()));
+ setNumber(hv, "fullQuery", (IV) *x->fullQuery);
+ if (x->subqueryExpression)
+ setMember(hv, "subqueryExpression",
+ translateQueryExpression(x->subqueryExpression));
+ if (x->subqueryCount)
+ setNumber(hv, "subqueryCount", (IV) *x->subqueryCount);
+ /* ### many, many elements omitted here */
+
+ return sv;
+}
+
+
+static SV *translateQueryExpression(Z_QueryExpression *x)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::QueryExpression", (SV*) (hv = newHV()));
+ setNumber(hv, "which", x->which);
+
+ switch (x->which) {
+ case Z_QueryExpression_term:
+ setMember(hv, "term", translateQueryExpressionTerm(x->u.term));
+ return sv;
+ case Z_QueryExpression_query:
+ break;
+ default:
+ break;
+ }
+
+ fatal("illegal/unsupported `which' (%d) in Z_QueryExpression", x->which);
+ return 0; /* NOTREACHED; inhibit gcc -Wall warning */
+}
+
+
+static SV *translateQueryExpressionTerm(Z_QueryExpressionTerm *x)
+{
+ SV *sv;
+ HV *hv;
+
+ sv = newObject("Net::Z3950::APDU::QueryExpressionTerm",
+ (SV*) (hv = newHV()));
+ setMember(hv, "queryTerm", translateTerm(x->queryTerm));
+
+ return sv;
+}
+
+
+/*
+ * Creates a new Perl object of type `class'; the newly-created scalar
+ * that is a reference to the blessed thingy `referent' is returned.
+ */
+static SV *newObject(char *class, SV *referent)
+{
+ HV *stash;
+ SV *sv;
+
+ sv = newRV_noinc((SV*) referent);
+ stash = gv_stashpv(class, 0);
+ if (stash == 0)
+ fatal("attempt to create object of undefined class '%s'", class);
+ sv_bless(sv, stash);
+ return sv;
+}
+
+
+static void setNumber(HV *hv, char *name, IV val)
+{
+ SV *sv = newSViv(val);
+ setMember(hv, name, sv);
+}
+
+
+static void setString(HV *hv, char *name, char *val)
+{
+ setBuffer(hv, name, val, 0);
+}
+
+
+static void setBuffer(HV *hv, char *name, char *valdata, int vallen)
+{
+ SV *sv = newSVpv(valdata, vallen);
+ setMember(hv, name, sv);
+}
+
+
+static void setMember(HV *hv, char *name, SV *val)
+{
+ /* We don't increment `val's reference count -- I think this is
+ * right because it's created with a refcount of 1, and in fact
+ * the reference via this hash is the only reference to it in
+ * general.
+ */
+ if (!hv_store(hv, name, (U32) strlen(name), val, (U32) 0))
+ fatal("couldn't store member in hash");
+}
Added: packages/libnet-z3950-perl/branches/upstream/current/yazwrap/send.c
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/yazwrap/send.c 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/yazwrap/send.c 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,509 @@
+/* $Header: /home/cvsroot/NetZ3950/yazwrap/send.c,v 1.11 2005/07/27 12:07:00 mike Exp $ */
+
+/*
+ * yazwrap/send.c -- wrapper functions for Yaz's client API.
+ *
+ * This file provides functions which (we hope) will be easier to
+ * invoke via XS than the raw Yaz API. We do this by providing fewer
+ * functions at a higher level; and, where appropriate, using more
+ * primitive C data types.
+ */
+
+#include <unistd.h>
+#include <yaz/proto.h>
+#include <yaz/pquery.h> /* prefix query compiler */
+#include <yaz/ccl.h> /* CCL query compiler */
+#include <yaz/yaz-ccl.h> /* CCL-to-RPN query converter */
+#include <yaz/otherinfo.h>
+#include <yaz/charneg.h>
+#include "ywpriv.h"
+
+
+Z_ReferenceId *make_ref_id(Z_ReferenceId *buf, databuf refId);
+static Odr_oid *record_syntax(ODR odr, int preferredRecordSyntax);
+static databuf encode_apdu(ODR odr, Z_APDU *apdu, char **errmsgp);
+static int prepare_odr(ODR *odrp, char **errmsgp);
+static databuf nodata(char *msg);
+
+
+/*
+ * Errors are indicated by returning a databuf with a null data member,
+ * with *errmsgp pointed at an error message whose memory is managed by
+ * this module.
+ */
+databuf makeInitRequest(databuf referenceId,
+ int preferredMessageSize,
+ int maximumRecordSize,
+ mnchar *user,
+ mnchar *password,
+ mnchar *groupid,
+ mnchar *implementationId,
+ mnchar *implementationName,
+ mnchar *implementationVersion,
+ mnchar *charset,
+ mnchar *language,
+ char **errmsgp)
+{
+ static ODR odr = 0;
+ Z_APDU *apdu;
+ Z_InitRequest *req;
+ Z_ReferenceId zr;
+ Z_IdAuthentication auth;
+ Z_IdPass id;
+
+ if (!prepare_odr(&odr, errmsgp))
+ return nodata((char*) 0);
+ apdu = zget_APDU(odr, Z_APDU_initRequest);
+ req = apdu->u.initRequest;
+
+ req->referenceId = make_ref_id(&zr, referenceId);
+ /*
+ * ### We should consider allowing the caller to influence which
+ * of the following options are set. The ones marked with the
+ * Mystic Rune Of The Triple Hash are actually not supported in
+ * Net::Z3950.pm as I write.
+ */
+ ODR_MASK_SET(req->options, Z_Options_search);
+ ODR_MASK_SET(req->options, Z_Options_present);
+ ODR_MASK_SET(req->options, Z_Options_namedResultSets);
+ ODR_MASK_SET(req->options, Z_Options_triggerResourceCtrl); /* ### */
+ ODR_MASK_SET(req->options, Z_Options_scan);
+ ODR_MASK_SET(req->options, Z_Options_sort); /* ### */
+ ODR_MASK_SET(req->options, Z_Options_extendedServices); /* ### */
+ ODR_MASK_SET(req->options, Z_Options_delSet); /* ### */
+
+ ODR_MASK_SET(req->protocolVersion, Z_ProtocolVersion_1);
+ ODR_MASK_SET(req->protocolVersion, Z_ProtocolVersion_2);
+ ODR_MASK_SET(req->protocolVersion, Z_ProtocolVersion_3);
+
+ *req->preferredMessageSize = preferredMessageSize;
+ *req->maximumRecordSize = maximumRecordSize;
+
+ /*
+ * We interpret the `user', `password' and `group' arguments as
+ * follows: if `user' is not specified, then authentication is
+ * omitted (which is more or less the same as "anonymous"
+ * authentication); if `user' is specified but not `password',
+ * then it's treated as an "open" authentication token; if both
+ * `user' and `password' are specified, then they are used in
+ * "idPass" authentication, together with `group' if specified.
+ */
+ if (user != 0) {
+ req->idAuthentication = &auth;
+ if (password == 0) {
+ auth.which = Z_IdAuthentication_open;
+ auth.u.open = user;
+ } else {
+ auth.which = Z_IdAuthentication_idPass;
+ auth.u.idPass = &id;
+ id.userId = user;
+ id.groupId = groupid;
+ id.password = password;
+ }
+ }
+
+ if (charset || language) {
+ Z_OtherInformation **p;
+ Z_OtherInformationUnit *p0;
+
+ yaz_oi_APDU(apdu, &p);
+
+ if ((p0=yaz_oi_update(p, odr, NULL, 0, 0))) {
+ ODR_MASK_SET(req->options, Z_Options_negotiationModel);
+
+ p0->which = Z_OtherInfo_externallyDefinedInfo;
+ p0->information.externallyDefinedInfo =
+ yaz_set_proposal_charneg(
+ odr,
+ (const char**)&charset,
+ charset ? 1 : 0,
+ (const char**)&language, language ? 1 : 0, 1);
+ }
+ }
+
+
+ if (implementationId != 0)
+ req->implementationId = implementationId;
+ if (implementationName != 0)
+ req->implementationName = implementationName;
+ if (implementationVersion != 0)
+ req->implementationVersion = implementationVersion;
+
+ return encode_apdu(odr, apdu, errmsgp);
+}
+
+
+/*
+ * I feel really uncomfortable about that fact that if this function
+ * fails, the caller has no way to know why -- it could be an illegal
+ * record syntax, an unsupported query type, a bad search command or
+ * failure to encode the APDU. Oh well.
+ */
+databuf makeSearchRequest(databuf referenceId,
+ int smallSetUpperBound,
+ int largeSetLowerBound,
+ int mediumSetPresentNumber,
+ char *resultSetName,
+ char *databaseName,
+ char *smallSetElementSetName,
+ char *mediumSetElementSetName,
+ int preferredRecordSyntax,
+ int queryType,
+ char *query,
+ char **errmsgp)
+{
+ static ODR odr = 0;
+ Z_APDU *apdu;
+ Z_SearchRequest *req;
+ Z_ReferenceId zr;
+ Z_ElementSetNames smallES, mediumES;
+ oident attrset;
+ int oidbuf[20]; /* more than enough */
+ Z_Query zquery;
+ Odr_oct ccl_query;
+ struct ccl_rpn_node *rpn;
+ int error, pos;
+ static CCL_bibset bibset;
+ Z_External *ext;
+
+ if (!prepare_odr(&odr, errmsgp))
+ return nodata((char*) 0);
+ apdu = zget_APDU(odr, Z_APDU_searchRequest);
+ req = apdu->u.searchRequest;
+
+ req->referenceId = make_ref_id(&zr, referenceId);
+ *req->smallSetUpperBound = smallSetUpperBound;
+ *req->largeSetLowerBound = largeSetLowerBound;
+ *req->mediumSetPresentNumber = mediumSetPresentNumber;
+ *req->replaceIndicator = 1;
+ if (strcmp (resultSetName, "0") != 0)
+ req->resultSetName = resultSetName;
+ req->num_databaseNames = 1;
+ req->databaseNames = &databaseName;
+
+ /* Translate a single element-set names into a Z_ElementSetNames */
+ req->smallSetElementSetNames = &smallES;
+ smallES.which = Z_ElementSetNames_generic;
+ smallES.u.generic = smallSetElementSetName;
+
+ req->mediumSetElementSetNames = &mediumES;
+ mediumES.which = Z_ElementSetNames_generic;
+ mediumES.u.generic = mediumSetElementSetName;
+
+ /* Convert from our enumeration to the corresponding OID */
+ if ((req->preferredRecordSyntax =
+ record_syntax(odr, preferredRecordSyntax)) == 0)
+ return nodata(*errmsgp = "can't convert record syntax");
+
+ /* Convert from our querytype/query pair to a Z_Query */
+ req->query = &zquery;
+
+ switch (queryType) {
+ case QUERYTYPE_PREFIX:
+ /* ### Is type-1 always right? What about type-101 when under v2? */
+ zquery.which = Z_Query_type_1;
+ if ((zquery.u.type_1 = p_query_rpn (odr, PROTO_Z3950, query)) == 0)
+ return nodata(*errmsgp = "can't compile PQN query");
+ break;
+
+ case QUERYTYPE_CCL:
+ zquery.which = Z_Query_type_2;
+ zquery.u.type_2 = &ccl_query;
+ ccl_query.buf = (unsigned char*) query;
+ ccl_query.len = strlen(query);
+ break;
+
+ case QUERYTYPE_CCL2RPN:
+ zquery.which = Z_Query_type_1;
+ if (bibset == 0) {
+ FILE *fp;
+ bibset = ccl_qual_mk();
+ if ((fp = fopen("ccl.qual", "r")) != 0) {
+ ccl_qual_file(bibset, fp);
+ fclose(fp);
+ } else if (errno != ENOENT) {
+ return nodata(*errmsgp = "can't read CCL qualifier file");
+ }
+ }
+ if ((rpn = ccl_find_str(bibset, query, &error, &pos)) == 0)
+ return nodata(*errmsgp = (char*) ccl_err_msg(error));
+ if ((zquery.u.type_1 = ccl_rpn_query(odr, rpn)) == 0)
+ return nodata(*errmsgp = "can't encode Type-1 query");
+ attrset.proto = PROTO_Z3950;
+ attrset.oclass = CLASS_ATTSET;
+ attrset.value = VAL_BIB1; /* ### should be configurable! */
+ zquery.u.type_1->attributeSetId = oid_ent_to_oid(&attrset, oidbuf);
+ ccl_rpn_delete (rpn);
+ break;
+
+ case QUERYTYPE_CQL:
+ zquery.which = Z_Query_type_104;
+ ext = (Z_External*) odr_malloc(odr, sizeof(*ext));
+ ext->direct_reference = odr_getoidbystr(odr, "1.2.840.10003.16.2");
+ ext->indirect_reference = 0;
+ ext->descriptor = 0;
+ ext->which = Z_External_CQL;
+ ext->u.cql = odr_strdup(odr, query);
+ zquery.u.type_104 = ext;
+ break;
+
+ default:
+ return nodata(*errmsgp = "unknown queryType");
+ }
+
+ return encode_apdu(odr, apdu, errmsgp);
+}
+
+
+/* Inspired by the scan implementation from client.c
+ * in the source package of the YAZ C toolkit available
+ * at http://www.indexdata.dk/yaz/
+ */
+databuf makeScanRequest(databuf referenceId,
+ char *databaseName,
+ int stepSize,
+ int numberOfTermsRequested,
+ int preferredPositionInResponse,
+ int queryType,
+ char *query,
+ char **errmsgp)
+{
+ static ODR odr = 0;
+ Z_APDU *apdu;
+ Z_ScanRequest *req;
+ Z_ReferenceId zr;
+ static CCL_bibset bibset;
+ int oid[OID_SIZE];
+
+ if (!prepare_odr(&odr, errmsgp))
+ return nodata((char*) 0);
+
+ apdu = zget_APDU(odr, Z_APDU_scanRequest);
+ req = apdu->u.scanRequest;
+
+ req->referenceId = make_ref_id(&zr, referenceId);
+ req->num_databaseNames = 1;
+ req->databaseNames = &databaseName;
+ req->stepSize = &stepSize;
+ req->numberOfTermsRequested = &numberOfTermsRequested;
+ req->preferredPositionInResponse = &preferredPositionInResponse;
+
+ /* ### should this share code with makeSearchRequest()? */
+ if (queryType == QUERYTYPE_CCL2RPN) {
+ oident bib1;
+ int error, pos;
+ struct ccl_rpn_node *rpn;
+
+ rpn = ccl_find_str (bibset, query, &error, &pos);
+ if (bibset == 0) {
+ FILE *fp;
+ bibset = ccl_qual_mk();
+ if ((fp = fopen("ccl.qual", "r")) != 0) {
+ ccl_qual_file(bibset, fp);
+ fclose(fp);
+ } else if (errno != ENOENT) {
+ return nodata (*errmsgp = "can't read CCL qualifier file");
+ }
+ }
+ rpn = ccl_find_str (bibset, query, &error, &pos);
+ if (error) {
+ return nodata (*errmsgp = (char *) ccl_err_msg(error));
+ }
+ bib1.proto = PROTO_Z3950;
+ bib1.oclass = CLASS_ATTSET;
+ bib1.value = VAL_BIB1;
+ req->attributeSet = oid_ent_to_oid (&bib1, oid);
+
+ if (!(req->termListAndStartPoint = ccl_scan_query (odr, rpn))) {
+ return nodata (*errmsgp = "can't convert CCL to Scan term");
+ }
+ ccl_rpn_delete (rpn);
+
+ } else { /* QUERYTYPE_PREFIX */
+ YAZ_PQF_Parser pqf_parser = yaz_pqf_create ();
+
+ if (!(req->termListAndStartPoint =
+ yaz_pqf_scan(pqf_parser, odr, &req->attributeSet, query)))
+ {
+ size_t off;
+ int code = yaz_pqf_error (pqf_parser,(const char **) errmsgp, &off);
+ yaz_pqf_destroy (pqf_parser);
+ return nodata(*errmsgp);
+ }
+ yaz_pqf_destroy (pqf_parser);
+ }
+
+ return encode_apdu(odr, apdu, errmsgp);
+}
+
+
+databuf makePresentRequest(databuf referenceId,
+ char *resultSetId,
+ int resultSetStartPoint,
+ int numberOfRecordsRequested,
+ char *elementSetName,
+ int preferredRecordSyntax,
+ char **errmsgp)
+{
+ static ODR odr = 0;
+ Z_APDU *apdu;
+ Z_PresentRequest *req;
+ Z_ReferenceId zr;
+ Z_RecordComposition rcomp;
+ Z_ElementSetNames esname;
+
+ if (!prepare_odr(&odr, errmsgp))
+ return nodata((char*) 0);
+ apdu = zget_APDU(odr, Z_APDU_presentRequest);
+ req = apdu->u.presentRequest;
+
+ req->referenceId = make_ref_id(&zr, referenceId);
+ if (strcmp (resultSetId, "0") != 0)
+ req->resultSetId = resultSetId;
+ *req->resultSetStartPoint = resultSetStartPoint;
+ *req->numberOfRecordsRequested = numberOfRecordsRequested;
+ req->num_ranges = 0; /* ### would be nice to support this */
+ req->recordComposition = &rcomp;
+ rcomp.which = Z_RecordComp_simple; /* ### espec suppport would be nice */
+ rcomp.u.simple = &esname;
+ esname.which = Z_ElementSetNames_generic;
+ esname.u.generic = elementSetName;
+ if ((req->preferredRecordSyntax =
+ record_syntax(odr, preferredRecordSyntax)) == 0)
+ return nodata(*errmsgp = "can't convert record syntax");
+
+ return encode_apdu(odr, apdu, errmsgp);
+}
+
+
+databuf makeDeleteRSRequest(databuf referenceId,
+ char *resultSetId,
+ char **errmsgp)
+{
+ static ODR odr = 0;
+ Z_APDU *apdu;
+ Z_DeleteResultSetRequest *req;
+ Z_ReferenceId zr;
+ Z_ResultSetId *rsList[1];
+ int x;
+
+ if (!prepare_odr(&odr, errmsgp))
+ return nodata((char*) 0);
+ apdu = zget_APDU(odr, Z_APDU_deleteResultSetRequest);
+ req = apdu->u.deleteResultSetRequest;
+
+ req->referenceId = make_ref_id(&zr, referenceId);
+ req->deleteFunction = &x;
+ x = Z_DeleteResultSetRequest_list;
+ req->num_resultSetList = 1;
+ req->resultSetList = &rsList[0];
+ rsList[0] = resultSetId;
+
+ return encode_apdu(odr, apdu, errmsgp);
+}
+
+
+/*
+ * If refId is non-null, copy it into the provided buffer, and return
+ * a pointer to it; otherwise, return a null pointer. Either way, the
+ * result is suitable to by plugged into an APDU structure.
+ */
+Z_ReferenceId *make_ref_id(Z_ReferenceId *buf, databuf refId)
+{
+ if (refId.data == 0)
+ return 0;
+
+ buf->buf = refId.data;
+ buf->len = (int) refId.len;
+ return buf;
+}
+
+
+static Odr_oid *record_syntax(ODR odr, int preferredRecordSyntax)
+{
+ oident prefsyn;
+ int oidbuf[20]; /* more than enough */
+ int *oid;
+
+ prefsyn.proto = PROTO_Z3950;
+ prefsyn.oclass = CLASS_RECSYN;
+ prefsyn.value = (oid_value) preferredRecordSyntax;
+ if ((oid = oid_ent_to_oid(&prefsyn, oidbuf)) == 0)
+ return 0;
+
+ return odr_oiddup(odr, oid);
+}
+
+
+/*
+ * Memory management strategy: every APDU we're asked to allocate
+ * obliterates the previous one by overwriting our static ODR buffer,
+ * so the caller _must_ ensure that it copies or otherwise consumes
+ * the return value before the next call is made. (This strategy
+ * would normally stink, but it's actually not error-prone in this
+ * context, since we know that the Perl XS code is about to copy the
+ * data onto its stack.)
+ */
+static databuf encode_apdu(ODR odr, Z_APDU *apdu, char **errmsgp)
+{
+ databuf res;
+ int len;
+ res.data = 0;
+
+ if (!z_APDU(odr, &apdu, 0, (char*) 0)) {
+ *errmsgp = odr_errmsg(odr_geterror(odr));
+ return res;
+ }
+
+ res.data = odr_getbuf(odr, &len, (int*) 0);
+ res.len = len;
+ return res;
+}
+
+
+static int prepare_odr(ODR *odrp, char **errmsgp)
+{
+ if (*odrp != 0) {
+ odr_reset(*odrp);
+ } else if ((*odrp = odr_createmem(ODR_ENCODE)) == 0) {
+ *errmsgp = "can't create ODR stream";
+ return 0;
+ }
+
+ return 1;
+}
+
+
+/*
+ * Return a databuf with a null pointer (used as an error indicator)
+ * (In passing, we also report to stderr what the problem was.)
+ */
+static databuf nodata(char *msg)
+{
+ databuf buf;
+
+#ifndef NDEBUG
+ if (msg != 0) {
+ fprintf(stderr, "DEBUG nodata(): %s\n", msg);
+ }
+#endif
+ buf.data = 0;
+ return buf;
+}
+
+
+/*
+ * Simple wrapper for cs_write() when that comes along. Also calls
+ * cs_look() to detect the completion of a connection when that comes
+ * along.
+ */
+int yaz_write(COMSTACK cs, databuf buf)
+{
+ if (cs_look(cs) == CS_CONNECT) {
+ if (cs_rcvconnect(cs) < 0) {
+ return -1;
+ }
+ }
+
+ return write(cs_fileno(cs), buf.data, buf.len);
+}
Added: packages/libnet-z3950-perl/branches/upstream/current/yazwrap/util.c
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/yazwrap/util.c 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/yazwrap/util.c 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,26 @@
+/* $Header: /home/cvsroot/NetZ3950/yazwrap/util.c,v 1.3 2003/01/21 16:46:41 mike Exp $ */
+
+/*
+ * yazwrap/util.c -- wrapper functions for Yaz's client API.
+ *
+ * This file provides utility functions for the wrapper library.
+ */
+
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include "ywpriv.h"
+
+
+void fatal(char *fmt, ...)
+{
+ va_list ap;
+
+ fprintf(stderr, "FATAL (yazwrap): ");
+ va_start(ap, fmt);
+ vfprintf(stderr, fmt, ap);
+ va_end(ap);
+ fprintf(stderr, "\n");
+ abort();
+}
Added: packages/libnet-z3950-perl/branches/upstream/current/yazwrap/yazwrap.h
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/yazwrap/yazwrap.h 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/yazwrap/yazwrap.h 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,121 @@
+/* $Header: /home/cvsroot/NetZ3950/yazwrap/yazwrap.h,v 1.7 2005/07/27 12:06:40 mike Exp $ */
+
+/*
+ * yazwrap/yazwrap.h -- wrapper functions for Yaz's client API.
+ *
+ * This file provides the public interface to this thin library.
+ */
+
+#include <yaz/diagbib1.h> /* Provide declaration of diagbib1_str() */
+#include <yaz/comstack.h> /* Need COMSTACK typedef to parse this file */
+
+/* Simple counted-length data buffer (so it can contain NULs) */
+typedef struct databuf {
+ char *data;
+ size_t len;
+} databuf;
+
+/* Maybe-null char* (don't ask -- see ../typemap if you really care */
+typedef char mnchar;
+
+/* Home-brew simplified front end functions */
+COMSTACK yaz_connect(char *addr);
+int yaz_close(COMSTACK cs);
+int yaz_socket(COMSTACK cs);
+
+/*
+ * Functions representing Z39.50 requests. Where parameters specified
+ * by the standard are not currently supported by this interface,
+ * their names are commented.
+ */
+databuf makeInitRequest(databuf referenceId,
+ /* protocolVersion */
+ /* options */
+ int preferredMessageSize,
+ int maximumRecordSize,
+ mnchar *user,
+ mnchar *password,
+ mnchar *groupid,
+ mnchar *implementationId,
+ mnchar *implementationName,
+ mnchar *implementationVersion,
+ mnchar *charset,
+ mnchar *language,
+ /* userInformationField */
+ /* otherInfo */
+ char **errmsgp
+ );
+
+databuf makeSearchRequest(databuf referenceId,
+ int smallSetUpperBound,
+ int largeSetLowerBound,
+ int mediumSetPresentNumber,
+ /* replaceIndicator */
+ char *resultSetName,
+ /* num_databaseNames */
+ char *databaseName,
+ char *smallSetElementSetName,
+ char *mediumSetElementSetName,
+ int preferredRecordSyntax,
+ int queryType,
+ char *query,
+ char **errmsgp
+ /* additionalSearchInfo */
+ /* otherInfo */
+ );
+
+databuf makeScanRequest(databuf referenceId,
+ /* num_databaseNames */
+ char *databaseName,
+ /* attributeSet */
+ /* termListAndStartPoint -> queryType/query */
+ int stepSize,
+ int numberOfTermsRequested,
+ int preferredPositionInResponse,
+ int queryType,
+ char *query,
+ char **errmsgp
+ /* otherInfo */
+ );
+
+/* Constants for use as `querytype' argument to makeSearchRequest() */
+#define QUERYTYPE_PREFIX 39501 /* Yaz's "@attr"-ish forward-Polish notation */
+#define QUERYTYPE_CCL 39502 /* Send CCL string to server ``as is'' */
+#define QUERYTYPE_CCL2RPN 39503 /* Convert CCL to RPN (type-1) locally */
+#define QUERYTYPE_CQL 39504 /* Send CQL string to server ``as is'' */
+
+databuf makePresentRequest(databuf referenceId,
+ char *resultSetId,
+ int resultSetStartPoint,
+ int numberOfRecordsRequested,
+ /* num_ranges */
+ /* additionalRanges */
+ char *elementSetName,
+ int preferredRecordSyntax,
+ /* maxSegmentCount */
+ /* maxRecordSize */
+ /* maxSegmentSize */
+ /* otherInfo */
+ char **errmsgp
+ );
+
+databuf makeDeleteRSRequest(databuf referenceId,
+ /* delete_function */
+ char *resultSetId,
+ /* otherInfo */
+ char **errmsgp
+ );
+
+SV *decodeAPDU(COMSTACK cs, int *reasonp);
+/*
+ * decodeAPDU() error codes -- will be set into `*reasonp' if a null
+ * pointer is returned. In addition to these, `*reasonp' may be set
+ * to a value of cs_errno()
+ */
+#define REASON_EOF 23951 /* read EOF from connection (server gone) */
+#define REASON_INCOMPLETE 23952 /* read bytes, but not yet a whole APDU */
+#define REASON_MALFORMED 23953 /* couldn't decode APDU (malformed) */
+#define REASON_BADAPDU 23954 /* APDU was well-formed but unrecognised */
+#define REASON_ERROR 23955 /* some other error (consult errno) */
+
+int yaz_write(COMSTACK cs, databuf buf);
Added: packages/libnet-z3950-perl/branches/upstream/current/yazwrap/ywpriv.h
===================================================================
--- packages/libnet-z3950-perl/branches/upstream/current/yazwrap/ywpriv.h 2006-02-25 20:45:43 UTC (rev 2204)
+++ packages/libnet-z3950-perl/branches/upstream/current/yazwrap/ywpriv.h 2006-02-25 20:48:55 UTC (rev 2205)
@@ -0,0 +1,32 @@
+/* $Header: /home/cvsroot/NetZ3950/yazwrap/ywpriv.h,v 1.5 2005/05/25 14:27:28 mike Exp $ */
+
+#include "EXTERN.h" /* Prerequisite for "perl.h" */
+#define yaz_log __some_stupid_function_in_the_linux_math_library
+#include "perl.h" /* Is this enough for SV*? */
+#include "XSUB.h"
+#undef yaz_log
+#undef simple
+#undef list
+#undef open
+/*
+ * Explanations for the above bits of brain damage.
+ *
+ * 1. on some systems (e.g. Red Hat Linux 6.0), the <math.h> header
+ * file (which is included by "perl.h") deploys a terrifying swathe of
+ * cpp trickery to declare a function called yaz_log() -- totally
+ * unrelated to Index Data's Yaz toolkit -- which means that when we
+ * subsequently #include <yaz/log.h> (as "send.c" does), the true
+ * declaration is flagged as an error. Ouch. Hence the
+ * define-it-out-of-the-way nonsense above.
+ *
+ * I find it truly hard to believe this, but "embed.h" (included by
+ * "perl.h") #defines the token "simple" to "Perl_simple", which means
+ * we can't access the `simple' element of Yaz's Z_RecordComposition
+ * structure. So this has to be explicitly undefined. Same for
+ * "list", which dets defined to "Perl_list". Bleaurrgh. And "open"
+ * gets defined to "open64" on some platforms, e.g. Solaris 9.
+ */
+
+#include "yazwrap.h"
+
+void fatal(char *fmt, ...);
More information about the Pkg-perl-cvs-commits
mailing list