MARC-Record-2.0.7/0000755000175100017510000000000013111154233011550 5ustar gmcgmcMARC-Record-2.0.7/META.json0000644000175100017510000000172613111154233013177 0ustar gmcgmc{ "abstract" : "Perl extension for handling MARC records", "author" : [ "Galen Charlton " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "MARC-Record", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "File::Find" : "0", "File::Spec" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "version" : "v2.0.7" } MARC-Record-2.0.7/META.yml0000644000175100017510000000106013111154233013016 0ustar gmcgmc--- abstract: 'Perl extension for handling MARC records' author: - 'Galen Charlton ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: MARC-Record no_index: directory: - t - inc requires: Carp: '0' File::Find: '0' File::Spec: '0' Test::More: '0' version: v2.0.7 MARC-Record-2.0.7/Changes0000644000175100017510000006565013111154100013050 0ustar gmcgmcRevision history for Perl extension MARC::Record. 2.0.7 Tue May 23 20:41:13 EDT 2017 [FIXES] - RT#108123: clean up MANIFEST.SKIP - GH#1: marcdump now prints warnings (Johann Rolschewski) - remove a reference to SourceForge - fix a reference to the per4lib mailing list 2.0.6 Tue Oct 22 16:17:06 UTC 2013 [ENHANCEMENTS] - MARC::Field->as_string() now accepts an optional second parameter to specify the delimiter to use between subfields. (Tomas Cohen Arazi) - MARC::Field->delete_subfield() can now accept a regexp to specify the subfields to remove. For example, to remove all numeric subfields, one can say: $field->delete_subfield(code => qr/\d/); (Jason Stephenson) [FIXES] - the warnings pragma is now used throughout MARC::Record - $field->as_string('0') now returns the contents of subfield $0 rather than the contents of all of the subfields in the field. - RT#88421: add newline after printing warnings (Jason Stephenson) - RT#85804: fix spelling glitch (Gregor Herrmann) 2.0.5 Mon Feb 11 20:39:10 PST 2013 - fix use of qw(...) in test case so that module passes tests with Perl 5.17.x. 2.0.4 Sat Feb 9 19:01:47 PST 2013 [ENHANCEMENTS] - add MARC::Field->set_indicator($indpos, $indval), a mutator for indicators - add MARC::Field->set_tag to allow tags to be renamed (Robin Sheat) - delete_subfield(), if given a single subfield label as its argument, will delete all instances of the specified subfield, increasing its DWIM factor - improved POD for MARC::Field->delete_subfield() [FIXES] - RT#70346: delete_subfield() no longer clears entire field if arguments are badly formatted - croak if invalid arguments are passed to delete_subfield() - fix error in tutorial (thanks to Tom Burton-West for the catch) - RT#76990: emit leader of correct length even if record longer than 99,999 octets (Julian Maurice) - RT#67094: croak with correct error if attempting to create MARC::Field sans subfields - corrected POD for indicator() method - move tag validity check to new class method, is_valid_tag($tagno) - move indicator validity check to new class method, is_valid_indicator($indval) - have MARC::Record pass perlcritic --gentle (mostly) - remove function prototypes (see http://www.perlmonks.org/?node_id=861966) 2.0.3 Fri Jan 14 17:50:12 EST 2011 - RT#62296: fix crash when dealing with record bigger than 99999 bytes (Alex Arnaud) - test cases for MARC::Field->subfields() - RT#61198: let subfields return an empty array on control fields (Colin Campbell) 2.0.2 Tue May 4 13:04:07 EDT 2010 - RT#57180: put back and expanded copyright statement in README at Debian request - set license element in META.yml 2.0.1 Sat May 1 15:59:54 EDT 2010 [ENHANCEMENTS] - improve support for subclassing MARC::Field (Dan Wells) - RT#55993: MARC::Record->insert_fields_after can now insert after last field in record (Frédéric Demians) - added methods to MARC::Field to allow a (class-level) list of fields that should be considered control fields in addition to 001-009. Includes test t/extra_controlfields.t, and supports alphabetic characters in the tag labels. The new methods are allow_controlfield_tags disallow_controlfield_tags is_controlfield_tag (Bill Dueber) - added MARC::Record::delete_fields() and t/delete-field.t (Ed Summers) - documentation improvements (Mike Rylander and Dan Scott) - baked in minimum Perl version required: 5.8.2 2.0 [THINGS THAT MAY BREAK YOUR CODE] - Perl 5.8.2 required for utf8 handling [ENHANCEMENTS] - removed dead utf8 handling code - added MARC::File::Encode wrapper around Encode module since Encode exports encode() by default which conflicts with existing MARC::File::Encode::encode (yuck). - added MARC::Record::encoding() for getting/setting record encoding - modified t/utf8.t to unconditionally do tests since a modern perl will now be required. - Added --hex switch to marcdump, which dumps the record in hexadecimal. The offsets are in decimal so that you can match them up to values in the leader. The offset is reset to 0 when we're past the directory so that you can match up the data with the offsets in the directory. - docfixes in Record.pm (thanks Todd Holbrook) - added MARC::Field->delete_subfields 1.39_02 Tue Dec 21 09:29:45 CST 2004 [THINGS THAT MAY BREAK YOUR CODE] - Removed the ability to call new from an instance of MARC::Record or MARC::Field. Any place where you might have code like: my $rec = MARC::Record->new(); ... my $another = $rec->new(); will have to be changed to: my $rec = MARC::Record->new(); ... my $class = ref( $rec ); my $another = $class->new(); or: my $rec = MARC::Record->new(); ... my $another = MARC::Record->new(); - Removed MARC::Lint and the marclint utility to a separate package on CPAN. - MARC::Doc::Tutorial.pod updated to reflect the change. - Fixed t/50.batch.t to use File::Spec in the MicroLIF section - Other tests in t/ also use File::Spec to specify paths - MARC::File::USMARC ignores \x1a, the DOS end-of-file character, between records and at the end of files. - Added corresponding tests dosEOF.t, cameleof.usmarc, and sample1eof.usmarc. [FIXES] - Clarified docs on the interface to field(), and fixed problem whereby in scalar context if no match was found we were returning an empty list instead of undef. Strictly speaking, this is an interface change, but in practice anyone making this call in a scalar context was going to get 0, which if used as a MARC::Field would bomb. We therefore don't expect the change to affect anything that wasn't already blowing up. - Fixed the doc and example for MARC::Field::subfields() so that they match the behavior of the function, namely returning a list rather than a list ref. - Fixed behavior of MARC::Batch::next() to not reset warnings on the MARC::Record object that it returns. Also added test to t/75.warnings.t - Added code to MARC::MicroLIF::decode() to change line endings to those of the platform before decoding the passed-in string. Also added test to t/81.decode.t - Turned off utf8 handling until it can safely be done without converting all MARC data to utf8. - Made marcdump respect --noquiet as documented. [ENHANCEMENTS] - added MARC::Field::delete_subfields() and tests to t/67.subfield.t - Added tests to make sure that MARC::Record::leader() adds warnings if called as a setter with data that isn't the right length. - Added explicit tests for convenience function behavior (title(), edition(), etc.) when there's no data. - Added test to verify insert_fields_before() behavior when the field to insert before isn't in the record. - Added tests to MARC::Field::indicator() to make sure that when called on a control field the return is undef. 1.39_01 Mon Jul 26 11:48:33 PDT 2004 [ENHANCEMENTS] - Support for UTF8 in Perls >= 5.8.1. When using a utf8 friendly Perl all file streams will be opened in utf8 mode, and the bytes pragma will be used to create and use direcotry byte offsets. - Added MARC::File::Utils which contains utf8 safe functions. - marcdump now sets STDOUT to utf8 if it is able to. - t/utf8.t is no longer skipped. - removed redundant record length check in MARC::File::USMARC::_next() and adjusted tests in t/75.warnings.t - All tests run under -T. 1.38 March 16th, 2004 [ENHANCEMENTS] - Performance tweak on MARC::Field->is_control_field() since it gets called a lot when cloning records. - Performance tweak on MARC::Field->as_string(), since it gets called all the time. 1.36 March 9th, 2004 [THINGS THAT MAY BREAK YOUR CODE] - Renamed MARC::Field->is_control_tag() to is_control_field(). [FIXES] - fixed SYNOPSIS in MARC::Batch to use constructor. Thanks Ed Sperr New England College of Optometry. - fixed reference to the tutorial in README. Thanks Stephen Graham, London Business School. - marcdump and marclint didn't recognize the -v flag. - calls to MARC::Field::subfield() on a control field (tag < 010 ) will cause a fatal error, with a friendly message telling you to use data(). Similarly a call to data() on a field >= 010 will result in a friendly error telling you to use subfield(). Previously a warning was generated, and MARC::Field continued along only to barf when it was unable to find an array ref in $self->{ _subfields }. [ENHANCEMENTS] - Finished documentation on all modules. Updated t/pod-coverage.t to keep us in line. 1.34 December 16th, 2003 [ENHANCEMENTS] - modified MARC::File::in() to allow passing in filehandles instead of a filename. Useful in situations where you might have data compressed on disk, and want to read from a decompression pipe. This effects MARC::Batch of course as well, which has had its documentation updated. - added t/85.fh.t to test new filehandle passing - Incorrect filetypes passed in to the MARC::Batch constructor now croak instead of die, so you can see where in your code it was called. [FIXES] - etc/specs modified to correctly parse LCs docs to get the 250 $b properly. Thanks Bryan Baldus at Quality Books. - new Lint.pm with 250 $b. - MARC::Field now leaves alphabetic indicators as they are instead of squashing to a space. Added test of new functionailty. Thanks Leif Andersson from Stockholms Universitet. - MARC::File::USMARC no longer checks the validity of indicators but leaves that up to MARC::Field (instead of having the check twice). - In MARC::Batch, the 'warn' elements weren't quoted. - warnings_on and strict_on should now be respected. 1.33 November 24th, 2003 MARC::Record should now run on Perls back to 5.00503! [FIXES] - fixed behavior in MARC::File::USMARC which was causing MARC::File::next() to return a partial record when the record lacked a proper end of directory byte. RT #4474. Added regression test t/82.baddir.t. - we now warn on improper 010 tag access, not croak. - fixed t/80.alphatag to test new MARC::Field::data() behavior - doc fix to insert_field_grouped() - tons of fixes and additions to MARC::Doc::Tutorial [INTERNALS] - Moved pl/ to bin/ - Split out the sfdocs stuff from Makefile.PL to bin/makesfdocs 1.32 November 5th, 2003 [ENHANCEMENTS] - added insert_ordered_fields(), thanks Leif Andersson. 1.31 October 16th, 2003 [FIXES] - set_leader_lengths() will now also set other MARC21 leader defaults. Postitions 10-11, 20-23. For details on the defaults see: http://www.loc.gov/marc/bibliographic/ecbdldrd.html - MARC::Batch::next() now accepts a filter function. - Fixed an incorrect instruction in MARC::File::MicroLIF. - marclint actually counts the number of records now. [DOCUMENTATION] - Added sample usage for insert_grouped_fields() - Added example about subfield v to x conversion to tutorial. - Documentation fix for MARC::Field::new(). - Fixed useage of MARC::Record::append_fields() in example 17 of the Tutorial. - Added TODO test for utf8 handling (utf8.t) - Fixed doc bug in MARC::File::USMARC (#2937) 1.30 There is no 1.30. We skipped a number. 1.29 June 05, 2003 [ENHANCEMENTS] - MARC::Field::subfield() will return a list of all subfield data when called in a list context...and only the first when called in a scalar context. Also added a test 67.subfield.t to test new functionality. 1.28 May 23, 2003 [FIXES] - Fixed MARC::Lint::check_record()'s checking for multiple 1XX tags. - Fixed the docs for MARC::Lint and what errors it says it catches. 1.27 May 22, 2003 [ENHANCMENTS] - MARC::Field::update() by default will append any subfields which do not exist in the record to the end of the field. Added tests to test the new functionality to 60.update.t [FIXES] - Updated MARC::Lint to use the latest field/subfield designations from the Library of Congress. The data for MARC::Lint is now automatically generated from the LC webpage. Thanks to Colin Campbell of Sirsi for the program that does the translation. - removed MARC::Lint check_260() since a subfield c is not mandatory (see RT #1565). 1.26 May 8, 2003 [FIXES] - Removed the "use warnings" in the couple of files that used it. This obviates the need for the pre5006.patch file. - Fixed some warnings for undefs. These only turned up because Test::Harness now has warnings turned on. 1.25 April 22, 2003 NO CHANGES. Just compensating for upload problems. 1.24 April 22, 2003 [ENHANCEMENTS] - expanded documentation for MARC::Field::as_string() [FIX] - modified MARC::File::USMARC to silently ignore any combination of nulls, spaces, CRs, and LFs between records. (They're not allowed to be there, but some vendors put them there anyway.) With this change in place you will now get the complete record--if the inter-record garbage is the only problem--rather than a record with (usually) zero fields. 1.23 March 30, 2003 [FIX] - removed t/85.utf8.t since it did not work - removed bytes pragma usage since there is no feasible way to get MARC::Record to properly handle utf8 while it is using substr() so heavily. substr() uses character lengths, and directory positions measure lengths in bytes. - updated pre5006.patch to only remove warnings pragma 1.22 March 23, 2003 - added t/85.utf8.t to test record lengths work when utf8 data is present in a record (regression test for RT #2165) - warnings and bytes pragmas are now explicit - added patch for removing warnings and bytes pragmas for Perl versions < 5.006 - updated README to include information about the patch [FIX] - removed warnings pragma from MARC/File/USMARC.pm and MARC/File/MicroLIF.pm since with warnings on, they generate quite a few warnings. These are mainly thrown by substr() when working with invalid MARC data. 1.21 March 14, 2003 [ENHANCEMENTS] - MARC::File::MicroLIF now reads the MicroLIF header from the input file and makes it available via the header() call. If there is no header in the file, header() will return undef. Because the header is now taken care of when the file is opened, MARC::File::MicroLIF::decode no longer supports skipping the file header. - MARC:File::MicroLIF::decode now detects fields that have no subfields (other than 001-009) rather than passing them through to MARC::Field which croak()s. When such a tag is encountered it is thrown away and a warning added to the MARC::Record, rather than allowing MARC::Field to croak(). - Updated data files used to test MARC::File::MicroLIF so that they have a header. [FIXES] - MARC:File::MicroLIF now supports input files with any type of line ending--\x0d, \x0a, or \x0d\0a. A file no longer has to have created on a system with compatible line endings. - Fixed invalid assumption in MARC::File::MicroLIF that the MicroLIF header is supposed to begin with 'HDR'. 1.20 February 26, 2003 [FIXES] - Removed $VERSION from all modules except for MARC::Record itself. - Fixed a $VERSION problem in MARC::Record that prevented CPAN from indexing the module correctly. - Added more tests to the .t files. 1.18 February 16, 2003 [ENHANCEMENTS] - when MARC::Batch::no_strict() will allow you to read in records with invalid record lengths. [FIXES] - Changes to MARC::File::USMARC->decode() to fix the rt.cpan.org bug #2017, "MARC::File::USMARC assumes that fields apper in directory order". - Stricter checking on MARC directory entries. 1.17 January 29, 2003 [ENHANCEMENTS] - Added optional subfield string to MARC::Field::as_string(). - Added tag-based filtering on the USMARC constructors and passthru support for this in MARC::File::next(). Now you can select which tags get put into your MARC record, and not have to pay the processing costs for fields you're going to ignore. - title_proper() now returns the _a, _n and _p from the 245 in whatever order they happen to appear. Thanks to Anne Highsmith for the change and the test data. - Minor speed tweaks when checking for tags < 010 - Made the POD checking in t/99.pod.t work better. Eventually I need to make the same changes into Test::Pod. 1.16 January 28, 2003 [ENHANCEMENTS] - title() and author() now return empty strings, rather than "" - Added title_proper(), edition() and publication_date() convenience methods to MARC::Record. - Added more unit tests. [FIXES] - marcdump utility will not output LDR when running under --field option, unless the LDR is specifically asked for. 1.15 December 8, 2002 [FIXES] - Ignores and warns about any completely empty subfields (i.e. not even any indicators) - MARC::File::USMARC::decode and MARC::File::MicroLIF::decode needed to be able to be called in a variety of ways: $obj->decode(), MARC::File::MicroLIF->decode() and MARC::File::MicroLIF::decode() Added t/081.decode.t to make sure things are shipshape. 1.14 November 27, 2002 [FIXES] - Fixed bug in MARC::File::USMARC that was set off by failure of t/75.warnings.t under ActivePerl and CygWin. 1.13 November 26, 2002 [ENHANCEMENTS] - Moved new_from_usmarc() docs & code up right after new() to be more prominent. Thanks to Chris Biemesderfer for pointing this out. - Added Chris Biemesderfer's section to the tutorial which discusses using MARC::Record with Net::Z3950. - Yet another overhaul to MARC::Batch to allow for error trapping. Added the warnings_on() warnings_off() methods to turn on/off warnings on STDERR. Also added strict_on() and strict_off() to change the behavior of next() when an error is encountered. Thanks to Rob Fox of Notre Dame for providing guidance on the type of behavior that is really needed when batch processing. - Added new tests for the improved handling of errors in MARC::Batch. - Added new warnings and strict methods to MARC::Doc::Tutorial, also added more use of MARC::Batch instead of using MARC::File directly. - Improved docs on some functions to explicitly says what gets returned from each function. 1.12 October 9, 2002 [ENHANCEMENTS] - Makefile.PL will now generate PDF and HTML documentation for Sourceforge when asked to. - Added a test for insert_field_grouped() - Added subject heading example to Tutorial - Fixed typo in docs for MARC::Record::append_fields() - Added code (and tests) for allowing users to specify alphanumeric tags. This is little used, but it's in the spec, and someone asked for it (Notre Dame). Edits were to MARC::Field and to a lesser extent MARC::Record. 1.11 September 10, 2002 [ENHANCEMENTS] - Added a 99.pod.t to check pod - insert_fields_before(), insert_fields_after(), appned_fields(), and insert_grouped_fields() now call croak() instead of _gripe in order to help MARC::Record users to locate where their call is failing. Thanks to Jackie Shieh for pointing this out. - MARC::Batch is now fault tolerant, in that it will store warnings about file format problems, but will not bomb out. The method MARC::Batch::warnings() can be used to get info about what went wrong while reading a record, and users can determine what to do. Thanks to Betsy Earl for solidifying the need for this. 1.10 August 30, 2002 [ENHANCEMENTS] - Now runs under Perl 5.005. All you people who have older Perls can now share in the joy that is MARC::Record. - Added warnings() and _warn methods to MARC::Batch, MARC::File to support warning collection and reporting. - Added use bytes to MARC::File::USMARC so that calls to length() will return actual bytes rather than characters if Unicode characters are found in the data. This only works if you're using 5.6.0+. [FIXES] - Modified MARC::File::USMARC::_next() to slurp in a record using local $/ = 0x1D, rather than reading record length and then calling read(). This will allow recovery from invalid leaders in batch reading. 1.00 July 3, 2002 - _gripe() fires off warnings instead of dying silently. - MARC::File::USMARC no longer creates an error if it's and the end of a file when it tries to next(). - Tests use the isa_ok() function to be more stringent in checking return values from functions. 0.94 June 10, 2002 - Added $MARC::Record::DEBUG - Added --debug flag to marcdump to enable $MARC::Record::DEBUG - Added 'Validation' section to MARC::Doc::Tutorial - Added append_fields(), insert_fields_after(), insert_fields_before() and deprecated add_fields() - Added test of new methods (t/60.insert.t) - Updated MARC::Doc::Tutorial to reflect change in add_fields() 0.93 May 21, 2002 - Added update() and replace_with() methods to MARC::Field - Added more stuff to MARC::Doc::Tutorial - Added MARC::Doc::Tutorial - Changed method call description for as_usmarc() in MARC::Record. - Removed IDEA for cloning in MARC::Record docs since it's been done. 0.92 April 2, 2002 - Fixed marclint to use the new MARC::File object - Added MARC::Record::new_from_usmarc() for backward compatibility. This is in addition to the MARC::Record::as_usmarc() function. 0.91 April 2, 2002 - Fixed a bad build: MARC::Batch wasn't included in the tarball. - marcdump now takes a --lif parm to be able to dump MicroLIF records. 0.90 April 1, 2002 - Alpha version of what will become MARC::Record 1.00. - MAJOR infrastructure changes. Scripts WILL break. - The file-handling has been removed from the MARC::Record class and moved into its own MARC::File::* set of classes. - First rudimentary MARC::Batch functionality. This will make it easy to handle bunches of files at once without having to muck with what file you're on. - Now fully embracing all the glory of 5.6+ Perl, such as the "our" keyword and $fh filehandles. 0.15 March 19, 2002 - Added clone() methods for MARC::Field and MARC::Record, so you can make a copy of an existing record. Plus, this acts as a filter to create records that are subsets of another. - Added selective printing of fields in marcdump. Now you can do something like this: marcdump myfile.marc --field=245 --field=1XX and only get back the title and author fields 0.14 March 7, 2002 - Added skip_from_file() to read and ignore a record. It's the same as next_from_file(), without the overhead of the parsing. 0.13 November 18, 2001 - MARC::Lint now squawks if there are inappropriate control characters in the data. 0.12 November 13, 2001 - new_from_microlif() now allows underscores that are embedded in a subfield, and ignores any HDR line that gets passed to it. 0.11 November 12, 2001 - Added inbound microlif support. - Added lif2marc program. 0.10 September 27, 2001 - Correctly updates the base address in the leader. Thanks to Tim Wentz (twentz@mc.net) for finding & fixing. 0.09 August 9, 2001 - Updated rules from "Understanding MARC" book. - Added delete_field() method. 0.08 May 25, 2001 - Added MARC::Record::title and ::author methods - Added the marclint program. - Added the rest of the rules for the 5XX tags forward. - Made the modules compatible with Perl 5.004. The exception is MARC::Lint, which requires 5.005 because of the qr// operator. - as_string() methods now return raw strings, without any special formatting. To get the formatted strings from versions <=0.07, use as_formatted(). 0.07 May 22, 2001 - Added the rudimentary MARC::Lint module. - Added parms to marcdump program 0.06 May 16, 2001 - Added marcdump program as demo and actual useful code 0.05 May 16, 2001 - Created t/camel.t as the basis for a test suite. - Removed the MARC::Field::subfields() method - Documentation cleanup. 0.04 May 15, 2001 - Sped up the MARC::Record and MARC::Field constructors about 30%. 0.01 Apr 20, 2001 - First version. MARC-Record-2.0.7/t/0000755000175100017510000000000013111154233012013 5ustar gmcgmcMARC-Record-2.0.7/t/10.camel.t0000644000175100017510000000772413111151774013521 0ustar gmcgmc#!perl -Tw use strict; use Test::More tests => 32; use File::Spec; BEGIN { use_ok( 'MARC::Record' ); use_ok( 'MARC::File::USMARC' ); } # Test 1: Testing as_usmarc() my $marc = MARC::Record->new(); isa_ok( $marc, 'MARC::Record', 'MARC record' ); $marc->leader("00000nam 22?????8a 4500"); # The ????? represents meaningless digits at this point my $nfields = $marc->add_fields( ["001","fol05865967"], ["003","IMchF"], ["010", "","", a => " 00055799", ], [100, "1","", a => "Wall, Larry." ], [245, "1","0", a => "Programming Perl / ", c => "Larry Wall, Tom Christiansen & Jon Orwant.", ], [250, "", "", a => "3rd ed.", ], [260, "", "", a => "Cambridge, Mass. : ", b => "O'Reilly, ", c => "2000.", ], [650, " ","0", a => "Perl (Computer program language)", ], [700, "1"," ", a => "Christiansen, Tom.", ], [700, "1"," ", a => "Orwant, Jon.", ], ); is( $nfields, 10, 'Expected 10 fields' ); my $expected = "00397nam 22001458a 4500001001200000003000600012010001600018100001700034245006800051250001200119260004300131650003700174700002300211700001700234\x1Efol05865967\x1EIMchF\x1E \x1Fa 00055799\x1E1 \x1FaWall, Larry.\x1E10\x1FaProgramming Perl / \x1FcLarry Wall, Tom Christiansen & Jon Orwant.\x1E \x1Fa3rd ed.\x1E \x1FaCambridge, Mass. : \x1FbO'Reilly, \x1Fc2000.\x1E 0\x1FaPerl (Computer program language)\x1E1 \x1FaChristiansen, Tom.\x1E1 \x1FaOrwant, Jon.\x1E\x1D"; is( MARC::File::USMARC->encode( $marc ), $expected, 'encode()' ); is( $marc->as_usmarc(), $expected, 'as_usmarc()' ); my $marc_from_blob = MARC::Record->new_from_usmarc( $expected ); isa_ok( $marc_from_blob, 'MARC::Record', 'MARC record imported from a blob' ); is( $marc->as_usmarc(), $expected, 'MARC from blob encodes correctly' ); # Test 2: as_string() $expected = join( "", ); my $generated = $marc->as_formatted; chomp $expected; chomp $generated; ok( $generated eq $expected, 'as_formatted()' ); # Test 3: multiple fields by number TEST3: { my @fields = $marc->field("700"); is( scalar @fields, 2, 'Multiple 700 tags' ); my $field = $fields[0]; isa_ok( $field, "MARC::Field" ); is( $field->subfield("a"), 'Christiansen, Tom.', ' Tom Christiansen' ); $field = $fields[1]; isa_ok( $field, "MARC::Field" ); is( $field->subfield("a"), 'Orwant, Jon.', ' Jon Orwant' ); } # Test 4: multiple fields by the ".." notation TEST4: { my @fields = $marc->field("7.."); is( scalar @fields, 2, 'Multiple 7.. tags' ); my $field = $fields[0]; isa_ok( $field, "MARC::Field" ); is( $field->subfield("a"), 'Christiansen, Tom.', ' Tom Christiansen' ); $field = $fields[1]; isa_ok( $field, "MARC::Field" ); is( $field->subfield("a"), 'Orwant, Jon.', ' Jon Orwant' ); } # Test 5: field/subfield is( $marc->subfield( 100, "a" ), "Wall, Larry.", 'Field/subfield lookup' ); # Test 6: Reading from disk my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $file = MARC::File::USMARC->in( $filename ); isa_ok( $file, 'MARC::File', "Opened input file" ); my $diskmarc; for my $n ( 1..8 ) { $diskmarc = $file->next(); isa_ok( $diskmarc, 'MARC::Record', " Record #$n" ); } if ( $diskmarc ) { is( $diskmarc->subfield(245,"c"), $marc->subfield(245,"c"), "Disk MARC matches built MARC" ); } $file->close; # Test 7: return from field() when nothing matches TEST7: { my @fields = $marc->field( '999' ); # doesn't exist in the record is( scalar @fields, 0, "nothing returned for tag 999--array context" ); my $field = $marc->field( '999' ); # doesn't exist in the record ok( !defined $field, "nothing returned for tag 999-scalar context" ); } __END__ LDR 00397nam 22001458a 4500 001 fol05865967 003 IMchF 010 _a 00055799 100 1 _aWall, Larry. 245 10 _aProgramming Perl / _cLarry Wall, Tom Christiansen & Jon Orwant. 250 _a3rd ed. 260 _aCambridge, Mass. : _bO'Reilly, _c2000. 650 0 _aPerl (Computer program language) 700 1 _aChristiansen, Tom. 700 1 _aOrwant, Jon. MARC-Record-2.0.7/t/file-filter.t0000644000175100017510000000150213111151774014407 0ustar gmcgmc#!perl -Tw use strict; use integer; use constant CAMEL_SKIPS => 8; use Test::More tests=>(CAMEL_SKIPS * 2) + 7; use File::Spec; BEGIN { use_ok( 'MARC::File::USMARC' ); } my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $file = MARC::File::USMARC->in( $filename ); isa_ok( $file, 'MARC::File::USMARC', 'USMARC file' ); my $marc; for ( 1..CAMEL_SKIPS ) { # Skip to the camel $marc = $file->next( sub { $_[0] == 245 } ); # Only want 245 in the record isa_ok( $marc, 'MARC::Record', 'Got a record' ); is( scalar $marc->fields, 1, 'Should only have one tag' ); } is( $marc->author, '' ); is( $marc->title, 'Programming Perl / Larry Wall, Tom Christiansen & Jon Orwant.' ); is( $marc->title_proper, 'Programming Perl /' ); is( $marc->edition, '' ); is( $marc->publication_date, '' ); $file->close; MARC-Record-2.0.7/t/sample100.lif0000644000175100017510000010363513111151774014230 0ustar gmcgmcheader 100 rec MicroLIF file LDR01306pam 22 5a 4500^ 003IMchF^ 00520000404110431.6^ 008940823s1996 nyua j 000 0 eng ^ 010 _a 94031110 /AC^ 020 _a0590441515 :_c$14.95^ 040 _aDLC_cDLC_dDLC_dICrlF_dIMchF-DB_dICrlF^ 043 _an-us---_an-us-ny^ 05000_aJV6450_b.M34 1996^ 08200_a304.8/73/009_221^ 1001 _aMaestro, Betsy.^ 24510_aComing to America :_bthe story of immigration /_cby Betsy Maestro ; illustrated by Susannah Ryan.^ 260 _aNew York :_bScholastic,_cc1996.^ 300 _a[40] p. :_bcol. ill. ;_c29 cm.^ 520 _aTraces the history of immigration to the United States and tells people's reasons for choosing to move to America.^ 61020_aEllis Island Immigration Station (New York, N.Y.)_xHistory_xJuvenile literature.^ 61021_aEllis Island Immigration Station (New York, N.Y.)_xHistory.^ 61027_aEllis Island Immigration Station (New York, N.Y.)_xHistory._2sears^ 650 0_aImmigrants_zUnited States_xHistory_xJuvenile literature.^ 650 1_aImmigrants.^ 650 7_aImmigrants._2sears^ 651 0_aUnited States_xEmigration and immigration_xHistory_xJuvenile literature.^ 651 1_aUnited States_xEmigration and immigration_xHistory.^ 651 7_aUnited States_xImmigration and emigration_xHistory._2sears^ 7001 _aRyan, Susannah,_eill.^ 900 _a304.8 MAE^ 9401 _a4.8_bK-3_sWilson's Children_sElem. School Library Collection_sSchool Library Journal^ 952 _a25877_cR_d304.8 MAE^` LDR01287pam 22 7a 4500^ 003IMchF^ 00520000321104353.2^ 008931102s1996 nyua j b 001 0 eng ^ 010 _a 93040296 /AC^ 020 _a0679873929 (pbk.)^ 020 _a0329031058^ 020 _a0679943250^ 020 _a0679887717 (pbk.)^ 040 _aDLC_cDLC_dDLC_dICrlF_dKyLxBWI_dICrlF^ 043 _an-us---^ 05000_aHQ798_b.J85 1996^ 08200_a305.23/5_221^ 1001 _aJukes, Mavis.^ 24510_aIt's a girl thing :_bhow to stay healthy, safe, and in charge /_cby Mavis Jukes ; illustrations by Debbie Tilley.^ 260 _aNew York, N.Y. :_bAlfred A. Knopf :_bdistributed by Random House,_cc1996.^ 300 _aviii, 135 p. :_bill. ;_c23 cm.^ 504 _aIncludes bibliographical references (p. 130-132) and index.^ 520 _aA guide for preteen girls discussing the physical changes associated with puberty and addressing other issues that teens face, such as drugs, drinking, sex, disease, and safety.^ 650 0_aTeenage girls_zUnited States_xJuvenile literature.^ 650 0_aPuberty_zUnited States_xJuvenile literature.^ 650 0_aSex instruction for girls_zUnited States.^ 650 1_aPuberty.^ 650 1_aSex instruction for girls.^ 650 7_aPuberty._2sears^ 650 7_aSex education._2sears^ 650 7_aAdolescence._2sears^ 7001 _aTilley, Debbie,_eill.^ 900 _a305.23 JUK^ 9401 _a7.5_b5-8_sWilson's Children_sWilson's Junior High School_sElem. School Library Collection^ 952 _a26036_cR_d305.23 JUK^` LDR01186pam 22 a 4500^ 003IMchF^ 00519960807153651.5^ 008920115s1993 nyua j b 000 0 eng ^ 010 _a 92003698 /AC^ 020 _a0803712928 (trade) :_c$14.99^ 020 _a0803712936 (lib. bdg.) :_c$14.89^ 040 _aDLC_cDLC_dICrlF_dIMchF-DB_dICrlF^ 043 _an-us---^ 05000_aGT4403_b.P56 1993^ 08204_a394.26_220^ 1001 _aPinkney, Andrea Davis.^ 24510_aSeven candles for Kwanzaa /_cAndrea Davis Pinkney ; pictures by Brian Pinkney.^ 2463 _a7 candles for Kwanzaa^ 250 _a1st ed.^ 260 _aNew York :_bDial Books for Young Readers,_cc1993.^ 300 _a[32] p. :_bcol. ill. ;_c24 x 29 cm.^ 504 _aIncludes bibliographical references (p. [32]).^ 520 _aDescribes the origins and practices of Kwanzaa, the seven-day festival during which people of African descent rejoice in their ancestral values.^ 650 0_aKwanzaa_xJuvenile literature.^ 650 0_aAfro-Americans_xSocial life and customs_xJuvenile literature.^ 650 1_aKwanzaa.^ 650 1_aAfro-Americans_xSocial life and customs.^ 650 7_aKwanzaa._2sears^ 650 7_aAfrican Americans_xSocial life and customs._2sears^ 7001 _aPinkney, J. Brian,_eill.^ 900 _a394.26 PIN^ 9401 _a4.9_bK-3_sWilson's Children_sElem. School Library Collection_sSchool Library Journal^ 952 _a26038_cR_d394.26 PIN^` LDR00971pam 22 4a 4500^ 003IMchF^ 00520000321083032.8^ 008880225s1988 flua j 001 0 eng ^ 010 _a 88004686 /AC^ 020 _a0865924627^ 040 _aDLC_cDLC_dICrlF^ 0500 _aQL638.95.L3_bP35 1989^ 08204_a597.3/3_221^ 08200_a597/.31_219^ 1001 _aPalmer, Sarah,_d1955-^ 24510_aGreat white sharks /_cSarah Palmer ; illustrated by Ernest Nicol and Libby Turner.^ 260 _aVero Beach, FL :_bRourke,_cc1988.^ 300 _a24 p. :_bcol. ill. ;_c19 cm.^ 4901 _aShark discovery library^ 500 _aIncludes index.^ 520 _aA brief description of the physical characteristics, habits, and natural environment of the great white shark, considered to be the most dangerous shark of all.^ 650 0_aWhite shark_vJuvenile literature.^ 650 1_aWhite shark.^ 650 1_aSharks.^ 650 7_aWhite shark._2sears^ 650 7_aSharks._2sears^ 7001 _aHadler, Sally,_eill.^ 7001 _aNicol, Ernest,_eill.^ 8001 _aPalmer, Sarah,_d1955- _tShark discovery library.^ 900 _a597.3 PAL^ 9402 _a3.8_b3-6_sSchool Library Journal^ 952 _a1319_cR_d597.3 PAL^` LDR00887pam 22 4a 4500^ 003IMchF^ 00519991026155912.6^ 008880205c19891988flua j 001 0 eng ^ 010 _a 88003242 /AC^ 020 _a0865924775^ 040 _aDLC_cDLC_dICrlF^ 0500 _aQL737.C425_bP34 1989^ 08204_a599.5/22_221^ 08200_a599.5/1_219^ 1001 _aPalmer, Sarah,_d1955-^ 24510_aGray whales /_cSarah Palmer ; illustrated by Sally Hadler.^ 260 _aVero Beach, Fla. :_bRourke Enterprises,_c[1989], c1988.^ 300 _a23 p. :_bcol. ill. ;_c19 x 20 cm.^ 4901 _aThe Whale discovery library^ 500 _aIncludes index.^ 520 _aDescribes gray whales, where they live, what they eat, and their family life.^ 650 0_aPacific gray whale_xJuvenile literature.^ 650 1_aPacific gray whale.^ 650 1_aWhales.^ 650 7_aPacific gray whale._2sears^ 650 7_aWhales._2sears^ 7001 _aHadler, Sally,_eill.^ 8001 _aPalmer, Sarah,_d1955-_tWhale discovery library.^ 900 _a599.5 PAL^ 9402 _a3.6_b3-6_sSchool Library Journal^ 952 _a1325_cR_d599.5 PAL^` LDR00914pam 22 4a 4500^ 003IMchF^ 00519991027074126.3^ 008880204s1988 flua j 001 0 eng ^ 010 _a 88003238 /AC/r89^ 020 _a0865924783^ 040 _aDLC_cDLC_dDLC_dICrlF^ 05000_aQL737.C424_bP35 1988^ 08204_a599.5/25_221^ 08200_a599.5/1_219^ 1001 _aPalmer, Sarah,_d1955-^ 24510_aHumpback whales /_cSarah Palmer ; illustrated by Tony Gibbon.^ 260 _aVero Beach, Fla. :_bRourke Enterprises,_cc1988.^ 300 _a23 p. :_bcol. ill. ;_c19 x 20 cm.^ 4901 _aThe Whale discovery library^ 500 _aIncludes index.^ 520 _aIntroduces the physical appearance, habits, diet, and habitat of the humpback whale and threats to its existence.^ 650 0_aHumpback whale_xJuvenile literature.^ 650 1_aHumpback whale.^ 650 1_aWhales.^ 650 7_aHumpback whale._2sears^ 650 7_aWhales._2sears^ 7001 _aGibbon, Tony,_eill.^ 8001 _aPalmer, Sarah,_d1955-_tWhale discovery library.^ 900 _a599.5 PAL^ 9402 _a3.5_b3-6_sSchool Library Journal^ 952 _a1328_cR_d599.5 PAL^` LDR00879pam 22 4a 4500^ 003IMchF^ 00519991027074426.9^ 008880205s1988 flua j 001 0 eng ^ 010 _a 88003240 /AC^ 020 _a0865924767^ 040 _aDLC_cDLC_dDLC_dICrlF^ 05000_aQL737.C433_bP34 1988^ 08204_a599.5/43_221^ 08200_a599.5/3_219^ 1001 _aPalmer, Sarah,_d1955-^ 24510_aNarwhals /_cSarah Palmer ; illustrated by Sally Hadler.^ 260 _aVero Beach, Fla. :_bRourke Enterprises,_cc1988.^ 300 _a23 p. :_bcol. ill. ;_c19 cm.^ 4901 _aThe Whale discovery library^ 500 _aIncludes index.^ 520 _aIntroduces the physical appearance, habits, diet, and habitat of this toothed whale and threats to its existence.^ 650 0_aNarwhal_xJuvenile literature.^ 650 1_aNarwhal.^ 650 1_aWhales.^ 650 7_aNarwhal._2sears^ 650 7_aWhales._2sears^ 7001 _aHadler, Sally,_eill.^ 8001 _aPalmer, Sarah,_d1955-_tWhale discovery library.^ 900 _a599.5 PAL^ 9402 _a3.5_b3-6_sSchool Library Journal^ 952 _a1326_cR_d599.5 PAL^` LDR00804pam 22 4a 4500^ 003IMchF^ 00519991026121742.0^ 008891205s1990 flua j 001 0 eng ^ 010 _a 89070168 /AC^ 020 _a0865930422^ 040 _aDLC_cDLC_dDLC_dICrlF^ 05000_aQL737.C27_bS76 1990^ 08204_a599.78_221^ 08200_a599.74/446_220^ 1001 _aStone, Lynn M.^ 24510_aBears /_cLynn M. Stone.^ 260 _aVero Beach, Fla. :_bRourke Corp.,_cc1990.^ 300 _a24 p. :_bcol. ill ;_c19 cm.^ 4901 _aNorth American animal discovery library^ 500 _aIncludes index.^ 520 _aAn introduction to the physical characteristics, habits, natural environment, and future prospects of the three species of bears that live in North America.^ 650 0_aBears_xJuvenile literature.^ 650 1_aBears.^ 650 7_aBears._2sears^ 8001 _aStone, Lynn M._tNorth American animal discovery library.^ 900 _a599.74 STO^ 9402 _a2.8_b3-6^ 952 _a1308_cR_d599.74 STO^` LDR00978pam 22 4a 4500^ 003IMchF^ 008880815s1989 nyua j 001 0 eng ^ 010 _a 88026408 /AC^ 020 _a0671671227 :_c$14.95^ 040 _aDLC_cDLC_dICrlF^ 0500 _aQL737.C43_bM35 1989^ 0820 _a639.9/7953_219^ 1001 _aMallory, Kenneth.^ 24510_aRescue of the stranded whales /_cKenneth Mallory and Andrea Conley.^ 260 _aNew York :_bSimon and Schuster Books for Young Readers in association with the New England Aquarium,_c1989.^ 300 _a63 p. :_bcol. ill. ;_c27 cm.^ 520 _aDescribes the rescue, rehabilitation, and successful release of three young pilot whales that were stranded on a Cape Cod beach during the winter of 1986.^ 650 0_aWhales_xJuvenile literature.^ 650 0_aWildlife rescue_xJuvenile literature.^ 650 1_aWhales.^ 650 1_aWildlife rescue.^ 650 7_aWhales._2sears^ 650 7_aWildlife rescue._2sears^ 70010_aConley, Andrea.^ 71020_aNew England Aquarium Corporation.^ 900 _a639.9 MAL^ 9401 _a5.8_b3-6_sSchool Library Journal starred_sBook Links (A.L.A.)_sBooklist^ 952 _a20382_cR_d639.9 MAL^` LDR00815pam 22 2a 4500^ 003IMchF^ 00519970512073945.4^ 008960830s1996 nyua j 001 0 eng ^ 010 _a 96035196 /AC^ 020 _a0865056307 (RLB)^ 020 _a0865057303 (paper)^ 040 _aDLC_cDLC_dDLC_dICrlF^ 05000_aGV552_b.K35 1996^ 08204_a791.3_221^ 08200_a796.47_220^ 1001 _aKalman, Bobbie,_d1947-^ 24510_aKids perform circus arts /_cBobbie Kalman.^ 260 _aNew York :_bCrabtree Pub.,_cc1997.^ 300 _a32 p. :_bcol. ill. ;_c25 cm.^ 440 0_aCrabapples^ 500 _aIncludes index.^ 520 _aShows children learning and performing many of the acts that are used in a circus, including juggling, walking on a tightrope, swinging on a trapeze, and more.^ 650 0_aAcrobatics_xJuvenile literature.^ 650 0_aCircus_xJuvenile literature.^ 650 1_aCircus.^ 650 7_aCircus._2sears^ 900 _a791.3 KAL^ 9401 _a4.2_bK-3_sLibrary Talk^ 952 _a35078_cR_d791.3 KAL^` LDR00898nam 22 2a 4500^ 003IMchF^ 008890209s1989 enka j 001 0beng ^ 010 _a 89050205 /AC^ 020 _a0531108260 (lib. bdg.)^ 040 _aDLC_cDLC_dDLC_dICrlF^ 043 _ae-uk---^ 05000_aGV461_b.W64 1989^ 08200_a796.44/092_aB_220^ 1001 _aWood, Tim.^ 24510_aGymnastics /_cTim Wood ; photographs, Chris Fairclough.^ 260 _aLondon ;_aNew York :_bF. Watts,_cc1989.^ 300 _a32 p. :_bcol. ill. ;_c23 cm.^ 4901 _aMy sport^ 520 _aFollows gymnast Catherine Bain as she practices at her gymnastics club and participates in a championship competition.^ 60010_aBain, Catherine_xJuvenile literature.^ 60011_aBain, Catherine.^ 650 0_aGymnastics_xJuvenile literature.^ 650 0_aGymnasts_zGreat Britain_xBiography_xJuvenile literature.^ 650 1_aGymnastics.^ 650 7_aGymnastics._2sears^ 70011_aFairclough, Chris,_eill.^ 8001 _aWood, Tim._tMy sport.^ 900 _a796.44 WOO^ 9402 _a3.9_bK-3_sSchool Library Journal^ 952 _a20711_cR_d796.44 WOO^` LDR00751pam 22 7a 4500^ 003IMchF^ 00519900823110348.6^ 008891127s1990 nyua j 001 0 eng ^ 010 _a 89039677 /AC^ 020 _a0531140520^ 040 _aDLC_cDLC_dDLC_dICrlF^ 05000_aGV1114_b.W66 1990^ 08200_a796.8/152_220^ 1001 _aWood, Tim.^ 24510_aJudo /_cTim Wood ; photographs, Chris Fairclough.^ 260 _aNew York :_bF. Watts,_cc1990.^ 300 _a32 p. :_bchiefly col. ill. ;_c23 cm.^ 4901 _aMy sport^ 520 _aOutlines the training, special preparation, and techniques needed to compete successfully in judo.^ 650 0_aJudo_xJuvenile literature.^ 650 0_aJudo_xTraining_xJuvenile literature.^ 650 1_aJudo.^ 650 7_aJudo._2sears^ 70011_aFairclough, Chris,_eill.^ 8001 _aWood, Tim._tMy sport.^ 900 _a796.8 WOO^ 9401 _a4.4_bK-3_sSchool Library Journal^ 952 _a21173_cR_d796.8 WOO^` LDR00946cam 22 8a 4500^ 003IMchF^ 00519950911093837.1^ 008931206s1996 mnua j 000 0 eng ^ 010 _a 93048449 /AC^ 020 _a0886826845^ 040 _aDLC_cDLC_dDLC_dICrlF^ 043 _an-us-pa^ 05000_aGV848.P58_bG55 1994^ 08200_a796.962/64/0974886_220^ 1001 _aGilbert, John,_d1942-^ 24510_aPittsburgh Penguins /_cJohn Gilbert.^ 24630_aPenguins^ 260 _aMankato, Minn. :_bCreative Education,_cc1996.^ 300 _a32 p. :_bill. (some col.) ;_c25 cm.^ 440 0_aNHL today^ 520 _aPresents a history of the Pittsburgh Penguins hockey team, highlighting the games and players that have contributed to the team's success through the years.^ 61020_aPittsburgh Penguins (Hockey team)_xHistory_xJuvenile literature.^ 61021_aPittsburgh Penguins (Hockey team)_xHistory.^ 61027_aPittsburgh Penguins (Hockey team)_xHistory._2sears^ 61027_aNational Hockey League._2sears^ 650 1_aHockey_xHistory.^ 650 7_aHockey_xHistory._2sears^ 900 _a796.962 GIL^ 9401 _a6.5_b3-6^ 952 _a1353_cR_d796.962 GIL^` LDR00898pam 22 a 4500^ 003IMchF^ 00519900501094349.1^ 008890504s1990 njua j 000 0 eng ^ 010 _a 89034372 /AC^ 020 _a0816717354 (lib. bdg.) :_c$9.79^ 020 _a0816717362 (pbk.) :_c$2.95^ 040 _aDLC_cDLC_dDLC_dICrlF^ 043 _an-us-wi^ 05000_aTL721.6.O84_bC75 1990^ 08200_a797.5_220^ 1001 _aCrisfield, Deborah.^ 24513_aAn air show adventure /_cby Deborah Crisfield ; photography by Donald Emmerich.^ 260 _aMahwah, N.J. :_bTroll Associates,_cc1990.^ 300 _a32 p. :_bcol. ill. ;_c24 cm.^ 440 0_aLet's take a trip^ 520 _aDescribes events at the EAA Fly-in, an air show held in Oshkosh, Wisconsin, focusing on the unique aircraft on display.^ 650 0_aAir shows_zWisconsin_zOshkosh_xJuvenile literature.^ 650 1_aAir shows.^ 650 1_aAirplanes.^ 650 7_aAir shows._2sears^ 650 7_aAirplanes._2sears^ 70011_aEmmerich, Donald,_eill.^ 900 _a797.5 CRI^ 9401 _a5.3_b3-6_sSchool Library Journal^ 952 _a20779_cR_d797.5 CRI^` LDR00839pam 22 1a 4500^ 003IMchF^ 00519980204093521.4^ 008881013c19891963nyua j 000 1 eng ^ 010 _a 88007902 /AC^ 020 _a0689712995 :_c$4.95^ 020 _a0329035959^ 040 _aDLC_cDLC_dDLC_dICrlF^ 05000_aPZ8.3.B348_bAm 1989^ 08200_a811/.54_aE_219^ 1001 _aBaylor, Byrd.^ 24510_aAmigo /_cby Byrd Baylor ; illustrated by Garth Williams.^ 250 _a1st Aladdin Books ed.^ 260 _aNew York :_bAladdin Books,_c1989, c1963.^ 300 _a41 p. :_bcol. ill. ;_c23 cm.^ 520 _aDesperately wanting a pet to love, a boy decides to tame a prairie dog who has already decided to tame the boy for his own pet.^ 650 1_aPrairie dogs_xFiction.^ 650 1_aPets_xFiction.^ 650 1_aStories in rhyme.^ 650 7_aPrairie dogs_xFiction._2sears^ 650 7_aPets_xFiction._2sears^ 650 7_aStories in rhyme._2sears^ 70011_aWilliams, Garth,_eill.^ 900 _a811 BAY^ 9402 _a2.5_bK-3^ 952 _a622_cR_d811 BAY^` LDR00866cam 22 a 4500^ 003IMchF^ 008791101c19791978nyua j 001 0 eng ^ 010 _a 78068532 /AC/r84^ 020 _a0531091244^ 040 _aDLC_cDLC_dICrlF^ 043 _ae-gr---^ 0500 _aDF77_b.F23 1978^ 082 _a938^ 1001 _aFagg, Christopher.^ 24510_aAncient Greece /_c[Christopher Fagg ; editor, Frances M. Clapham ; illustrators, Constance Dear ... et al.].^ 260 _aNew York :_bWarwick Press,_c1979, c1978.^ 300 _a44 p. :_bcol. ill. ;_c28 cm.^ 4900 _aModern knowledge library^ 500 _aIncludes index.^ 520 _aDiscusses the civilization of the ancient Greeks who were the first to develop a democratic way of life.^ 650 7_aCivilization, Greek._2sears^ 651 0_aGreece_xCivilization_yTo 146 B.C._xJuvenile literature.^ 651 1_aGreece_xCivilization_yTo 146 B.C.^ 651 7_aGreece_xHistory._2sears^ 70010_aDear, Constance.^ 900 _a938 FAG^ 9401 _a6.6_b5-8_sSchool Library Journal^ 952 _a31798_cR_d938 FAG^` LDR00846cam 22 5a 4500^ 003IMchF^ 00519931020141518.6^ 008860407s1986 iluab j 001 0 eng ^ 010 _a 86009631 /AC/r93^ 020 _a0516012886^ 040 _aDLC_cDLC_dDLC_dICrlF^ 043 _aa------^ 05000_aDS10_b.G42 1986^ 08200_a950_219^ 1001 _aGeorges, D. V.^ 24510_aAsia /_cby D.V. Georges.^ 260 _aChicago :_bChildrens Press,_cc1986.^ 300 _a45 p. :_bill. (some col.), maps (some col.) ;_c23 cm.^ 4900 _aA New true book^ 500 _aIncludes index.^ 520 _aIdentifies the continent of Asia, divides it into seven regions, including the Middle East, Siberia, Far East, and Himalayas, and discusses their countries, cities, and geographical features.^ 651 0_aAsia_xDescription and travel_xJuvenile literature.^ 651 1_aAsia_xDescription and travel.^ 651 7_aAsia_xGeography._2sears^ 651 7_aAsia_xDescription._2sears^ 900 _a950 GEO^ 9402 _a3.2_bK-3^ 952 _a25031_cR_d950 GEO^` LDR00916pam 22 a 4500^ 003IMchF^ 00520000829122433.8^ 008910430s1992 flua j 001 0 eng ^ 010 _a 91004114 /AC^ 020 _a0866253904^ 040 _aDLC_cDLC_dDLC_dICrlF^ 043 _anp-----_an-ust--^ 05000_aE99.C85_bL63 1992^ 08204_a978.004/9745_221^ 08200_a973/.04974_220^ 1001 _aLodge, Sally,_d1953-^ 24514_aThe Comanche /_cby Sally Lodge ; illustrated by Katherine Ace.^ 260 _aVero Beach, Fla. :_bRourke Publications,_cc1992.^ 300 _a31 p. :_bill. (some col.) ;_c29 cm.^ 440 0_aNative American people^ 500 _aIncludes index.^ 520 _aExamines the history, traditional lifestyle, and current situation of the Comanche Indians.^ 650 0_aComanche Indians_xJuvenile literature.^ 650 1_aComanche Indians.^ 650 1_aIndians of North America.^ 650 7_aComanche Indians._2sears^ 650 7_aNative Americans_zUnited States._2sears^ 7001 _aAce, Katherine,_eill.^ 900 _a973 LOD^ 9401 _a6.9_b5-8_sSchool Library Journal_sBooklist^ 952 _a1263_cR_d973 LOD^` LDR00192nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAbe Lincoln :_bthe young years.^ 260 _bTroll,_c1982.^ 300 _a[ ] p.^ 900 _aABE^ 952 _a31897_cR_dABE^` LDR00236nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAbe Lincoln goes to Washington.^ 260 _a[Washington, D.C.] :_bNational Geographic Society,_c1996.^ 300 _a[ ] p.^ 900 _aABE^ 952 _a25846_cR_dABE^` LDR00199nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAbigail Adams :_bdear partner.^ 260 _bChelsea House,_c1991.^ 300 _a[ ] p.^ 900 _aABI^ 952 _a25333_cR_dABI^` LDR00169nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAbiyoyo.^ 260 _bPuffin,_c1986.^ 300 _a[ ] p.^ 900 _aABI^ 952 _a2000_cR_dABI^` LDR00203nam 22 2 4500^ 00520011119075709.0^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 3_aAn aboriginal family.^ 260 _bLerner,_c1985.^ 300 _a[ ] p.^ 900 _aABO^ 952 _a32051_cR_dABO^` LDR00202nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAbracadabra kid :_ba writer's life.^ 260 _bGreenwillow,_c1996.^ 300 _a[ ] p.^ 900 _aABR^ 952 _a25847_cR_dABR^` LDR00183nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAbraham Lincoln.^ 260 _bBridgestone,_c1998.^ 300 _a[ ] p.^ 900 _aABR^ 952 _a35259_cR_dABR^` LDR00178nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAbraham Lincoln.^ 260 _bPebble,_c1998.^ 300 _a[ ] p.^ 900 _aABR^ 952 _a35258_cR_dABR^` LDR00197nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAbraham Lincoln :_bfor the people.^ 260 _bChelsea,_c1991.^ 300 _a[ ] p.^ 900 _aABR^ 952 _a25334_cR_dABR^` LDR00237nam 22 2 4500^ 00520011119075709.0^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 4_aThe absoluetly true story - how I visted Yellow Stone P^ 260 _bAladdin,_c1994.^ 300 _a[ ] p.^ 900 _aABS^ 952 _a2207_cR_dABS^` LDR00178nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAbsolute rulers.^ 260 _bGarret,_c1992.^ 300 _a[ ] p.^ 900 _aABS^ 952 _a35154_cR_dABS^` LDR00189nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAbuelitas paradise.^ 260 _a[S.l. :_bs.n.],_c1992.^ 300 _a[ ] p.^ 900 _aABU^ 952 _a25189_cR_dABU^` LDR00177nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAce defense men.^ 260 _bRourke,_c1994.^ 300 _a[ ] p.^ 900 _aACE^ 952 _a1223_cR_dACE^` LDR00181nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAcross the lines.^ 260 _bAtheneum,_c1997.^ 300 _a[ ] p.^ 900 _aACR^ 952 _a25848_cR_dACR^` LDR00180nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAcross the stream.^ 260 _bMulberry,_c1986.^ 300 _a[ ] p.^ 900 _aACR^ 952 _a777_cR_dACR^` LDR00170nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aActor.^ 260 _bCapstone,_c1998.^ 300 _a[ ] p.^ 900 _aACT^ 952 _a35392_cR_dACT^` LDR00182nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAddie meets Max.^ 260 _bHarper Trophy,_c1985.^ 300 _a[ ] p.^ 900 _aADD^ 952 _a41_cR_dADD^` LDR00179nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAddition Annie.^ 260 _bChildrens,_c1991.^ 300 _a[ ] p.^ 900 _aADD^ 952 _a2001_cR_dADD^` LDR00189nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAddy learns a lesson.^ 260 _bPleasant Co.,_c1993.^ 300 _a[ ] p.^ 900 _aADD^ 952 _a26006_cR_dADD^` LDR00187nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAddy saves the day.^ 260 _bPleasant Co.,_c1994.^ 300 _a[ ] p.^ 900 _aADD^ 952 _a25849_cR_dADD^` LDR00199nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAddy's surprise :_ba Christmas.^ 260 _bPleasant Co.,_c1993.^ 300 _a[ ] p.^ 900 _aADD^ 952 _a26007_cR_dADD^` LDR00209nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAdopted by the eagles.^ 260 _bMaxwell Macmillan International,_c1994.^ 300 _a[ ] p.^ 900 _aADO^ 952 _a25703_cR_dADO^` LDR00193nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAdoption is for always.^ 260 _bAlbert Whitman,_c1986.^ 300 _a[ ] p.^ 900 _aADO^ 952 _a20181_cR_dADO^` LDR00199nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAdventures of a 2-minute werewolf.^ 260 _bDoubleday,_c1983.^ 300 _a[ ] p.^ 900 _aADV^ 952 _a31944_cR_dADV^` LDR00197nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAdventures of Captain Underpants.^ 260 _bBlue Sky,_c1997.^ 300 _a[ ] p.^ 900 _aADV^ 952 _a26039_cR_dADV^` LDR00221nam 22 2 4500^ 00520011119075709.0^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 4_aThe adventures of High John.^ 260 _bOrchard Conqueror,_c1989.^ 300 _a[ ] p.^ 900 _aADV^ 952 _a20515_cR_dADV^` LDR00187nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAdventures with a string.^ 260 _bDutton,_c1965.^ 300 _a[ ] p.^ 900 _aADV^ 952 _a30147_cR_dADV^` LDR00187nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAdventurs of a paper cup.^ 260 _bDutton,_c1968.^ 300 _a[ ] p.^ 900 _aADV^ 952 _a30076_cR_dADV^` LDR00179nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAdvertising.^ 260 _bGarrett Ed.,_c1990.^ 300 _a[ ] p.^ 900 _aADV^ 952 _a35155_cR_dADV^` LDR00187nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAesop for children.^ 260 _bRand McNally,_c1919.^ 300 _a[ ] p.^ 900 _aAES^ 952 _a32780_cR_dAES^` LDR00182nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAesop's fables.^ 260 _bJunior Bks.,_c1988.^ 300 _a[ ] p.^ 900 _aAES^ 952 _a20118_cR_dAES^` LDR00202nam 22 2 4500^ 00520011119075709.0^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 4_aThe African rhinos.^ 260 _bMaxwell,_c1992.^ 300 _a[ ] p.^ 900 _aAFR^ 952 _a25190_cR_dAFR^` LDR00205nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAfter the goat man.^ 260 _bPuffin,_c1974.^ 300 _a[ ] p.^ 900 _aAFT^ 952 _a42_t1_cR_dAFT^ 952 _a31583_t2_cR_dAFT^` LDR00198nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAge of Aquarius; you and astrology.^ 260 _bCrowell,_c1979.^ 300 _a[ ] p.^ 900 _aAGE^ 952 _a31791_cR_dAGE^` LDR00197nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAids :_bhow it works in the body.^ 260 _bF. Watts,_c1992.^ 300 _a[ ] p.^ 900 _aAID^ 952 _a25191_cR_dAID^` LDR00175nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAir.^ 260 _bChildrens Press,_c1982.^ 300 _a[ ] p.^ 900 _aAIR^ 952 _a25020_cR_dAIR^` LDR00182nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAir assault teams.^ 260 _bCapstone,_c1996.^ 300 _a[ ] p.^ 900 _aAIR^ 952 _a33001_cR_dAIR^` LDR00179nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAircraft carriers.^ 260 _bWatts,_c1986.^ 300 _a[ ] p.^ 900 _aAIR^ 952 _a20403_cR_dAIR^` LDR00182nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAircraft carriers.^ 260 _bCapstone,_c1998.^ 300 _a[ ] p.^ 900 _aAIR^ 952 _a35000_cR_dAIR^` LDR00171nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAirliners.^ 260 _bWatts,_c1984.^ 300 _a[ ] p.^ 900 _aAIR^ 952 _a30798_cR_dAIR^` LDR00177nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAirplanes.^ 260 _bCopper Beech,_c1995.^ 300 _a[ ] p.^ 900 _aAIR^ 952 _a1161_cR_dAIR^` LDR00172nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlabama.^ 260 _bCapstone,_c1998.^ 300 _a[ ] p.^ 900 _aALA^ 952 _a35393_cR_dALA^` LDR00194nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlabama in words and pictures.^ 260 _bChildren,_c1980.^ 300 _a[ ] p.^ 900 _aALA^ 952 _a31850_cR_dALA^` LDR00181nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlarming animals.^ 260 _bRaintree,_c1994.^ 300 _a[ ] p.^ 900 _aALA^ 952 _a25509_cR_dALA^` LDR00171nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlaska.^ 260 _bCapstone,_c1998.^ 300 _a[ ] p.^ 900 _aALA^ 952 _a35394_cR_dALA^` LDR00182nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlbert Schweitzer.^ 260 _bBardett,_c[19--]^ 300 _a[ ] p.^ 900 _aALB^ 952 _a21033_cR_dALB^` LDR00181nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlberts ballgame.^ 260 _bAtheneum,_c1996.^ 300 _a[ ] p.^ 900 _aALB^ 952 _a25757_cR_dALB^` LDR00200nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlbum or rocks and minerals.^ 260 _bCheckboard Press,_c1987.^ 300 _a[ ] p.^ 900 _aALB^ 952 _a25023_cR_dALB^` LDR00239nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlexander and the terrible, horrible, no good very bad^ 260 _bAladdin,_c1972.^ 300 _a[ ] p.^ 900 _aALE^ 952 _a44_t1_cR_dALE^ 952 _a781_t2_cR_dALE^` LDR00204nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlexander who used to be rich last Sunday.^ 260 _bMacmillan,_c1988.^ 300 _a[ ] p.^ 900 _aALE^ 952 _a45_cR_dALE^` LDR00185nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlfonse, where are you?.^ 260 _bCrown,_c1996.^ 300 _a[ ] p.^ 900 _aALF^ 952 _a26008_cR_dALF^` LDR00214nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAl Gore, vice president.^ 260 _bMillbrook,_c1994.^ 300 _a[ ] p.^ 900 _aALG^ 952 _a25508_t1_cR_dALG^ 952 _a764_t2_cR_dALG^` LDR00173nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlgeria.^ 260 _bChildrens,_c1990.^ 300 _a[ ] p.^ 900 _aALG^ 952 _a25026_cR_dALG^` LDR00191nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAli Baba & the forty thieves.^ 260 _bAbrams,_c1988.^ 300 _a[ ] p.^ 900 _aALI^ 952 _a20480_cR_dALI^` LDR00200nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlice and the boa constrictor.^ 260 _a[S.l. :_bs.n.],_c1983.^ 300 _a[ ] p.^ 900 _aALI^ 952 _a30725_cR_dALI^` LDR00202nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlice Nizzy Nazzy, the witch of Santa Fe.^ 260 _bPutnam,_c1995.^ 300 _a[ ] p.^ 900 _aALI^ 952 _a2002_cR_dALI^` LDR00190nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAliens don't wear braces.^ 260 _bScholastic,_c1993.^ 300 _a[ ] p.^ 900 _aALI^ 952 _a2003_cR_dALI^` LDR00186nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAliens for breakfast.^ 260 _bRandom House,_c1988.^ 300 _a[ ] p.^ 900 _aALI^ 952 _a46_cR_dALI^` LDR00182nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAliens for lunch.^ 260 _bRandom House,_c1991.^ 300 _a[ ] p.^ 900 _aALI^ 952 _a47_cR_dALI^` LDR00179nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll aboard!.^ 260 _bGreenwillow,_c1995.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a25631_cR_dALL^` LDR00187nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll about alligators.^ 260 _bScholastic,_c1994.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a25623_cR_dALL^` LDR00174nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll about Stacey.^ 260 _bDell,_c1988.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a49_cR_dALL^` LDR00180nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll about whales.^ 260 _bHoliday,_c1987.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a20571_cR_dALL^` LDR00183nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll about where.^ 260 _bGreenwillow,_c1991.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a21379_cR_dALL^` LDR00218nam 22 2 4500^ 00520011119075709.0^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 4_aThe all around Cristmas.^ 260 _bRinehart & Winston,_c1982.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a30716_cR_dALL^` LDR00206nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll God's critters got a place in the choir.^ 260 _bDutton,_c1978.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a20516_cR_dALL^` LDR00173nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll I see.^ 260 _bOrchard,_c1988.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a20275_cR_dALL^` LDR00181nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll Joseph Wanted.^ 260 _bMacmillan,_c1991.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a536_cR_dALL^` LDR00215nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll night, all day :_ba child's first-- spirituals.^ 260 _bAtheneum,_c1991.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a25851_cR_dALL^` LDR00208nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll of our noses are here & other tales.^ 260 _bHarper & Row,_c1985.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a32095_cR_dALL^` LDR00190nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll the colors of the earth.^ 260 _bMorrow,_c1994.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a25510_cR_dALL^` LDR00184nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll-terrian bicyclaling.^ 260 _bHolt,_c1987.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a20911_cR_dALL^` LDR00170nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlligators.^ 260 _bAbdo,_c1994.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a1160_cR_dALL^` LDR00200nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlligators and others all year long!.^ 260 _bMaxwell,_c1993.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a25402_cR_dALL^` LDR01079pam 22 4a 4500^ 003IMchF^ 00519900517135337.0^ 008890912r1990 maua j 000 1 eng ^ 010 _a 89013282 /AC^ 020 _a0316034134 :_c$12.95^ 040 _aDLC_cDLC_dDLC_dICrlF^ 05000_aPZ7.A4277_bWh 1990^ 08200_a[Fic]_220^ 1001 _aAllen, Linda.^ 24010_aParrot in the house^ 24510_aWhen grandfather's parrot inherited Kennington Court /_cby Linda Allen ; illustrated by Katinka Kew.^ 250 _a1st U.S. ed.^ 260 _aBoston :_bJoy Street Books,_c1990.^ 300 _a68 p. :_bill. ;_c22 cm.^ 500 _aPreviously published under title: A parrot in the house.^ 500 _a"First published in the U.K. in 1988 by Hodder and Stoughton Ltd."--T.p. verso.^ 520 _aAppalled that Grandfather left his inheritance to his parrot, the relatives seek to break the will; but young Miranda, who is caring for the parrot, makes a discovery that settles everything.^ 650 1_aMystery and detective stories.^ 650 1_aParrots_xFiction.^ 650 7_aMystery and detective stories._2sears^ 650 7_aParrots_xFiction._2sears^ 651 1_aEngland_xFiction.^ 651 7_aEngland_xFiction._2sears^ 70011_aKew, Katinka,_eill.^ 900 _aALL^ 952 _a21117_cR_dALL^` LDR00178nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlmost good-bye.^ 260 _bDutton,_c1990.^ 300 _a[ ] p.^ 900 _aALM^ 952 _a21497_cR_dALM^` LDR00186nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlmost starring skinnybones.^ 260 _bKnopf,_c1988.^ 300 _a[ ] p.^ 900 _aALM^ 952 _a51_cR_dALM^` LDR00186nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlmost the real thing.^ 260 _bBradbury,_c1991.^ 300 _a[ ] p.^ 900 _aALM^ 952 _a21369_cR_dALM^` LDR00185nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlong came a dog.^ 260 _bHarper & Trophy,_c1958.^ 300 _a[ ] p.^ 900 _aALO^ 952 _a52_cR_dALO^` LDR00176nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlphabet city.^ 260 _bViking,_c1995.^ 300 _a[ ] p.^ 900 _aALP^ 952 _a25758_cR_dALP^` LDR00201nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlzheimer's disease :_bsilent epidemic.^ 260 _bLerner,_c1985.^ 300 _a[ ] p.^ 900 _aALZ^ 952 _a32074_cR_dALZ^` LDR00191nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAmanda Pig and her big brother.^ 260 _bDial,_c1982.^ 300 _a[ ] p.^ 900 _aAMA^ 952 _a32294_cR_dAMA^` MARC-Record-2.0.7/t/62.before.t0000644000175100017510000000402013111151774013673 0ustar gmcgmc#!perl -Tw use strict; use integer; use Test::More tests=>10; use File::Spec; BEGIN { use_ok( 'MARC::Batch' ); use_ok( 'MARC::Field' ); } my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $batch = new MARC::Batch( 'MARC::File::USMARC', $filename ); isa_ok( $batch, 'MARC::Batch', 'Batch object creation' ); my $record = $batch->next(); isa_ok( $record, 'MARC::Record', 'Record object creation' ); my $f650 = $record->field('650'); isa_ok( $f650, 'MARC::Field', 'Field retrieval'); my $new = MARC::Field->new('650','','0','a','World Wide Web.'); isa_ok( $new, 'MARC::Field', 'Field creation'); my $nadds = $record->insert_fields_before($f650,$new); is( $nadds, 1, "inserted exactly one field" ); my $expected = <as_formatted,$expected,'insert_fields_before'); # make sure we get undef if the insert-before field isn't there my $not_in_record = MARC::Field->new('655','','0','a','World Wide Web','y','Stories.'); $record->warnings(); # get rid of any warnings lying around my $hopefully_undef = $record->insert_fields_before( $not_in_record, $new ); ok( !defined $hopefully_undef, "must return undef if can't find field to insert before" ); is( scalar($record->warnings), 1, "got warning about not being able to insert" ); MARC-Record-2.0.7/t/decode-filter.t0000644000175100017510000000216213111151774014716 0ustar gmcgmc#!perl -Tw use strict; use Test::More tests => 3; BEGIN { use_ok( 'MARC::Record' ); } sub wanted { my $tag = shift; my $data = shift; return $tag == 245 || $tag >= 600; } my $blob = "00397nam 22001458a 4500001001200000003000600012010001600018100001700034245006800051250001200119260004300131650003700174700002300211700001700234\x1Efol05865967\x1EIMchF\x1E \x1Fa 00055799\x1E1 \x1FaWall, Larry.\x1E10\x1FaProgramming Perl / \x1FcLarry Wall, Tom Christiansen & Jon Orwant.\x1E \x1Fa3rd ed.\x1E \x1FaCambridge, Mass. : \x1FbO'Reilly, \x1Fc2000.\x1E 0\x1FaPerl (Computer program language)\x1E1 \x1FaChristiansen, Tom.\x1E1 \x1FaOrwant, Jon.\x1E\x1D"; my $marc = MARC::Record->new_from_usmarc( $blob, \&wanted ); isa_ok( $marc, "MARC::Record" ); my $expected = join( "", ); chomp $expected; my $generated = $marc->as_formatted; chomp $generated; is( $generated, $expected, 'as_formatted()' ); __END__ LDR 00397nam 22001458a 4500 245 10 _aProgramming Perl / _cLarry Wall, Tom Christiansen & Jon Orwant. 650 0 _aPerl (Computer program language) 700 1 _aChristiansen, Tom. 700 1 _aOrwant, Jon. MARC-Record-2.0.7/t/11.astring.t0000644000175100017510000000167413111151774014106 0ustar gmcgmc#!perl -T use strict; use warnings; use Test::More ( tests => 7 ); use File::Spec; BEGIN { use_ok( 'MARC::Batch' ); } my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $b = MARC::Batch->new( 'USMARC', $filename ); isa_ok( $b, 'MARC::Batch' ); my $r = $b->next(); isa_ok( $r, 'MARC::Record' ); my $f245 = $r->field( '245' ); is( $f245->as_string( 'a' ), 'ActivePerl with ASP and ADO /', 'as_string() with one subfield' ); is( $f245->as_string( 'ac' ), 'ActivePerl with ASP and ADO / Tobias Martinsson.', 'as_string() with two subfields' ); is( $f245->as_string( 'ac', "\t" ), 'ActivePerl with ASP and ADO /' . "\t" . 'Tobias Martinsson.', 'as_string() with two subfields and delimiter' ); my $field = MARC::Field->new('650', ' ', ' ', a => 'History', '0' => '(DLC)12345'); is( $field->as_string('0'), '(DLC)12345', q{as_string('0') includes only subfield $0, not entire field} ); MARC-Record-2.0.7/t/00.load.t0000644000175100017510000000046313111151774013347 0ustar gmcgmc#!perl -Tw use strict; use Test::More tests=>6; BEGIN { use_ok( 'MARC::Record' ); use_ok( 'MARC::Batch' ); use_ok( 'MARC::Field' ); use_ok( 'MARC::File' ); use_ok( 'MARC::File::MicroLIF' ); use_ok( 'MARC::File::USMARC' ); } diag( "Testing MARC::Record $MARC::Record::VERSION" ); MARC-Record-2.0.7/t/66.grouped.t0000644000175100017510000000272413111151774014113 0ustar gmcgmc#!perl -Tw use strict; use integer; use Test::More tests=>7; use File::Spec; BEGIN { use_ok( 'MARC::Batch' ); use_ok( 'MARC::Field' ); } my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $batch = new MARC::Batch( 'MARC::File::USMARC', $filename ); isa_ok( $batch, 'MARC::Batch', 'Batch object creation' ); my $record = $batch->next(); isa_ok( $record, 'MARC::Record', 'Record object creation' ); my $new = MARC::Field->new('270','','','a','1 Whitehouse Drive, DC.'); isa_ok( $new, 'MARC::Field', 'Field creation'); my $nadds = $record->insert_grouped_field($new); is( $nadds, 1 ); my $expected = <as_formatted,$expected,'insert_grouped_field'); MARC-Record-2.0.7/t/title_proper.usmarc0000644000175100017510000002211313111151774015745 0ustar gmcgmc02179cas 2200553 a 45e000100070000000500170000700800410002401000170006503500230008203500140010503500110011904001180013001600200024801900380026802200140030603500180032004200130033804300120035105000160036306000140037907400140039308200100040708600190041708600180043604900090045421000470046322200720051024500750058224600310065726001190068826500650080730000310087236200220090350000350092550000700096051000320103051000410106253000770110365100560118071000420123674000330127878001060131185000490141785600540146689100240152089100410154493600280158599400120161391338020030124101153.0751101c19479999dcuuu1m f0 a0eng  a 52002169  a(OCoLC)ocm01768314 9ADZ9243AM a913380 aDLCcMULdCOOdNSDdDLCdGPOdNSTdDLCdRCSdGPOdAIPdOCLdNSDdOCLdIULdHULdNSTdIULdHULdNSTdMYGdSYSdTXA7 aC566430002DNLM a2260037a2260038a5087003a8532160 a0363-6836 a0755033bMULS ansdpalc an-us---00aHA195b.A530 aW2 A B9CU a0142-C-010 a312.90 aC 56.218:P-20/0 aC 3.186:P-20/ aTXAM0 aCurr. popul. rep., Ser. P-20, Popul. char. 0aCurrent population reports. Series P-20, Population characteristics00aCurrent population reports.nSeries P-20,pPopulation characteristics.10aPopulation characteristics a[Washington, D.C.] :bU.S. Dept. of Commerce, Bureau of the Census :bFor sale by the Supt. of Docs., U.S. G.P.O., aSupt. of Docs., U.S. Govt. Print. Off., Washington, DC 20402 av. :bill., maps ;c27 cm.1 aBegan with No. 1. aDescription based on: No. 352. aPrior to January 1976 issues were classified C 56.218:P-20/(nos.)2 aPopulation indexx0032-47010 aAmerican statistics indexx0091-1658 aSome issues also available online via the World Wide Web, in PDF format. 0aUnited StatesxPopulationvStatisticsvPeriodicals.1 aUnited States.bBureau of the Census.0 aPopulation-special subjects.05tCurrent population reports. Series P-27, Farm populationx1048-6283w(DLC)sf 87037999w(OCoLC)7226532 aAUaDLCaInUaMH-KGaMH-PAaMH-SRaMdUaPU-W41uhttp://www.census.gov/mp/www/pub/pop/mspop01.html03985381ano.i(year)40986381a<324>-i<1978>-xprovisional aNo. 404 (Nov. 1985) LIC aE0bTXA01858cas 2200457 a 450000100070000000500170000700800410002401000230006501900330008802200140012103500200013503500140015503500110016904001230018004200130030304300120031604900090032805000180033706000160035506900140037107400140038508200210039908600180042021000490043822200610048724500640054824600200061226001190063226500660075130000170081736200220083450001680085650000350102451000410105953000770110050000620117765000270123965000300126671000420129685600620133891338520030124101154.0790313c19489999dcuuu1m f0 a0eng  a 52002108 //r822 a01779114a07619124a118103510 a0730-4803 a(OCoLC)04738786 9ADZ9248AM a913385 aDLCcCPOdNLMdMULdGPOdNSDdGPOdHULdDLCdNSTdDLCdNSTdRCSdOCLdNSDdHULdNSTdDLCdOCLdNSTdDLCdNSTdMYGdTXA ansdpalc an-us--- aTXAO00aHC110.I5bA530 aW2 A B9CUBM1 aC56641000 a0142-C-0700a339.2/2/09732190 aC 3.186:P-60/0 aCurr. popul. rep., Ser. P-60, Consum. income 0aCurrent population reports. Series P-60, Consumer income00aCurrent population reports.nSeries P-60,pConsumer income.10aConsumer income a[Washington, D.C.?] :bU.S. Dept. of Commerce, Bureau of the Census :bFor sale by the Supt. of Docs, U.S. G.P.O., aSupt. of Docs., U.S. Govt. Print. Off., Washington, DC, 20402 av. ;c27 cm.1 aBegan with No. 1. aPrior to January 1976 issues were classified C 56.218:P-60/ during the time the Census Bureau was subordinate to the Social and Economic Statistics Administration. aDescription based on: No. 115.0 aAmerican statistics indexx0091-1658 aSome issues available also online via the World Wide Web, in PDF format. aPoverty in the United States is classed under C 3.186/22: 0aIncomezUnited States. 0aConsumerszUnited States.1 aUnited States.bBureau of the Census.41uhttp://www.census.gov/ftp/pub/mp/www/pub/pop/mspop10.html01866cas 2200469 a 4500001000800000005001700008008004100025006001900066007000700085010001700092022001400109035002000123035001400143035001200157040002300169042001400192049000900206082001200215130003300227210004700260222007300307245008900380246005300469246000800522246004300530260005000573310001200623500008100635506008800716516010700804530006500911538003600976500003001012650002601042650003401068650003401102655003801136710003101174776006801205780008701273856003601360166545420030124102744.0970618c199u9999mdumr1p 0 a0eng dm d crucnu asn 97004211 0 a1094-1622 a(OCoLC)37142044 9AHN6270AM a1665454 aNSDcNSDdHLSdOCL ansdpalcd aTXAM10a5302120 aPhysical review. A (Online)0 aPhys. rev., A At. mol. opt. phy.b(Online) 0aPhysical review. A, Atomic, molecular, and optical physicsb(Online)00aPhysical review.nA,pAtomic, molecular, and optical physicsh[electronic resource].1 iTitle on "entry" page:aPhysical review A online3 aPRA30aAtomic, molecular, and optical physics aCollege Park, MD :bAmerican Physical Society aMonthly aDescription based on: Vol. 55, issue 1 (Jan. 1997); title from title screen. aAvailable to those with print subscription; requires special login ID and password.8 aTable of contents available in HTML and PDF format; articles are Acrobat PDF only (electronic journal) aOnline version of the print publication: Physical review. A. aMode of access: World Wide Web. aText (electronic journal) 0aPhysicsxPeriodicals. 0aNuclear physicsxPeriodicals. 0aPhysical opticsxPeriodicals. 7aComputer network resources.2lcsh2 aAmerican Physical Society.1 tPhysical review. Ax1050-2947w(DLC) 90656533w(OCoLC) 2126602500tPhysical review. A, General physicsx0556-2791w(DLC) 75021361w(OCoLC) 10839257 uhttp://ojps.aip.org/prao/2http02267cas 2200517 a 45e0001000800000005001700008006001900025007001500044008004100059010001700100035002300117035002000140035001400160035001200174040002800186022001400214042001400228082001200242049000900254050001900263130005200282210004500334222005100379245006700430246005800497246003100555246000800586246002100594260006000615310001600675362004800691500011900739500008400858500003000942506003600972516012101008530008301129538003601212650003501248710003101283776008601314785009801400856018901498856005001687994001201737166545520030124102745.0m d cr cnu--------970826d199u1997mdusr1p s 0 a0eng d asn 97004477  a(OCoLC)ocm37528569 a(OCoLC)37528569 9AHN6271AM a1665455 aNSDcNSDdEYMdOCLdIUL0 a1095-3795 ansdpalcd10a530212 aTXAM14aQC176.A1bP5130 aPhysical review.nB,pCondensed matter (Online)0 aPhys. rev., B, Condens. matterb(Online) 0aPhysical review. B, Condensed matterb(Online)00aPhysical review.nB,pCondensed matterh[electronic resource].1 iTitle on journal home page:aPhysical review B online1 iAlso known as:aPRB online30aPRB30aCondensed matter aCollege Park, Md. :bAmerican Physical Society,c-1997. aSemimonthly1 aCeased with Vol. 56, no. 24 (15 Dec. 1997). aDescription based on: Vol. 55, issue 1 (Jan. 1997); title from title screen of HTML file (viewed on June 9, 1998). aDescription based on: Vol. 55, issue 1 (Jan. 1, 1997); title from title screen. aText (electronic journal) aAvailable by subscription only.8 aTable of contents and abstracts available in HTML and PDF format; articles are Acrobat PDF only (electronic journal) aOnline version of print publication including Rapid communications and Briefs. aMode of access: World Wide Web. 0aCondensed mattervPeriodicals.2 aAmerican Physical Society.1 tPhysical review. B, Condensed matterx0163-1829w(DLC) 80644831w(OCoLC)420624500tPhysical review. B, Condensed matter and materials physicsw(DLC)sn 98034465w(OCoLC)3929665740uhttp://library.tamu.edu/resources/ASP/track.asp?resource=Physical+Review+Online+Archive+%28PROLA%29zOnline version of articles available through Physical Review Online Archive (PROLA)40xhttp://ojps.aip.org/journals/doc/PRBMDO-home/ aE0bTXA01121nam 2200301 a 4500001000800000005001700008008004100025020001500066035002000081035001400101040001800115043002100133049000900154090002400163100002500187245009500212260005800307300002100365490004500386504005100431651005300482651005300535651004400588651005200632610005700684830005800741948002000799166545619991130062525.0970908s1997 enk b 001 0 eng d a1860641067 a(OCoLC)37587441 9AHN6272AM aDGUcDGUdTXA ae-uk---an-us--- aTXAM aE183.8.G7bJ65 19971 aJones, Peter,d1945-10aAmerica and the British Labour Party :bthe "special relationship" at work /cPeter Jones. aLondon ;aNew York :bTauris Academic Studies,c1997. a252 p. ;c22 cm.1 aLibrary of international relations ;v10 aIncludes bibliographical references and index. 0aGreat BritainxForeign relationszUnited States. 0aUnited StatesxForeign relationszGreat Britain. 0aGreat BritainxForeign relationsy1945- 0aUnited StatesxForeign relationsy20th century.20aLabour Party (Great Britain)xHistoryy20th century. 0aLibrary of international relations (Series) ;vv. 10. ac:cerd20021105MARC-Record-2.0.7/t/67.subfield.t0000644000175100017510000000152413111151774014241 0ustar gmcgmc#!perl -Tw use Test::More tests => 6; use strict; ## make sure that MARC::Field::subfield() is aware of the context ## in which it is called. In list context it returns *all* subfields ## and in scalar just the first. use_ok( 'MARC::Field' ); my $field = MARC::Field->new( '245', '', '', a=>'foo', b=>'bar', a=>'baz' ); isa_ok( $field, 'MARC::Field' ); my $subfieldA = $field->subfield( 'a' ); is( $subfieldA, 'foo', 'subfield() in scalar context' ); my @subfieldsA = $field->subfield( 'a' ); is( $subfieldsA[0], 'foo', 'subfield() in list context 1' ); is( $subfieldsA[1], 'baz', 'subfield() in list context 2' ); ## should not be able to call subfield on field < 010 $field = MARC::Field->new( '000', 'foobar' ); eval { $field->subfield( 'a' ) }; like( $@, qr/just tags below 010/, 'subfield cannot be called on fields < 010' ); MARC-Record-2.0.7/t/66.ordered.t0000644000175100017510000000154113111151774014066 0ustar gmcgmc#!perl -Tw use strict; use integer; use Test::More tests => 9; BEGIN { use_ok( 'MARC::Record' ); } my $r = MARC::Record->new(); $r->insert_fields_ordered( MARC::Field->new( '100', '', '', a => 'foo' ) ); my @fields = $r->fields(); isa_ok( $fields[0], 'MARC::Field' ); is( $fields[0]->tag(), '100', 'insert_fields_ordered works with empty rec' ); $r->insert_fields_ordered( MARC::Field->new( '110', '', '', a => 'bar' ), MARC::Field->new( '105', '', '', b => 'bez' ), MARC::Field->new( '008', '', '', c => 'fez' ) ); @fields = $r->fields(); my @tags = (); foreach (@fields ) { isa_ok( $_, 'MARC::Field' ); push( @tags, $_->tag() ); } is( scalar(@fields), 4, 'insert_fields_ordered added multiple fields' ); is_deeply( \@tags, [ '008', '100', '105', '110' ], 'insert_fields_ordered() added fields in numeric order' ); MARC-Record-2.0.7/t/utf8.t0000644000175100017510000000461413111151774013102 0ustar gmcgmc##!perl -Tw use Test::More tests => 20; use strict; use MARC::Record; use MARC::Batch; use MARC::File::USMARC; use Encode; use File::Spec; ## we are going to create a MARC record with a utf8 character in ## it (a Hebrew Aleph), write it to disk, and then attempt to ## read it back from disk as a MARC::Record. my $aleph = chr(0x05d0); ok( Encode::is_utf8($aleph), 'is_utf8()' ); my $filename = File::Spec->catfile( 't', 'utf8.marc' ); CREATE_FILE: { my $r = MARC::Record->new(); isa_ok( $r, 'MARC::Record' ); is( $r->encoding(), 'MARC-8', 'default encoding' ); $r->encoding( 'UTF-8' ); is( $r->encoding(), 'UTF-8', 'set encoding' ); my $f = MARC::Field->new( 245, 0, 0, a => $aleph, c => 'Mr. Foo' ); isa_ok( $f, 'MARC::Field' ); my $nadds = $r->append_fields( $f ); is( $nadds, 1, "Added one field" ); ## write record to disk, telling perl (as we should) that we ## will be writing utf8 unicode open( my $OUT, '>', $filename ); binmode( $OUT, ':utf8' ); # so we don't get a warning print $OUT $r->as_usmarc(); close( $OUT ); } ## open the file back up, get the record, and see if our Aleph ## is there REREAD_FILE: { my $f = MARC::File::USMARC->in( $filename ); isa_ok( $f, 'MARC::File::USMARC' ); my $r = $f->next(); isa_ok( $r, 'MARC::Record' ); # check encoding is( $r->encoding(), 'UTF-8', 'encoding is utf-8' ); # check for warnings is( scalar( $r->warnings() ), 0, 'Reading it generated no warnings' ); my $a = $r->field( 245 )->subfield( 'a' ); ok( Encode::is_utf8( $a ), 'got actual utf8' ); is( $a, $aleph, 'got aleph' ); unlink( $filename ); } WRITE_ANSEL: { my $r = MARC::Record->new(); isa_ok( $r, 'MARC::Record' ); is( $r->encoding(), 'MARC-8', 'default encoding' ); my $f = MARC::Field->new( 245, 0, 0, a => "foo".chr(0xE2)."e" ); isa_ok( $f, 'MARC::Field' ); my $nadds = $r->append_fields( $f ); is( $nadds, 1, "Added one field" ); open( my $OUT, '>', $filename ); print $OUT $r->as_usmarc(); close( $OUT ); } READ_ANSEL: { my $f = MARC::File::USMARC->in( $filename ); isa_ok( $f, 'MARC::File::USMARC' ); my $r = $f->next(); isa_ok( $r, 'MARC::Record' ); is( scalar( $r->warnings() ), 0, 'Reading it generated no warnings' ); is( $r->field('245')->subfield('a'), "foo".chr(0xE2)."e", 'non-utf8' ); unlink( $filename ); } MARC-Record-2.0.7/t/lineendings-0a.lif0000644000175100017510000000041513111151774015313 0ustar gmcgmcMicroLIF: x0a line end LDR00180nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll about whales.^ 260 _bHoliday,_c1987.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a20571_cR_dALL^` MARC-Record-2.0.7/t/68.subfields.t0000644000175100017510000000122613111151774014424 0ustar gmcgmc#!perl -Tw use Test::More tests => 4; use strict; ## make sure that MARC::Field::subfield() is aware of the context ## in which it is called. In list context it returns *all* subfields ## and in scalar just the first. use_ok( 'MARC::Field' ); my $field = MARC::Field->new( '245', '', '', a=>'foo', b=>'bar', a=>'baz' ); isa_ok( $field, 'MARC::Field' ); my @subfields = $field->subfields(); is_deeply(\@subfields, [ ['a' => 'foo'], ['b' => 'bar'], ['a' => 'baz'] ], 'subfields() returns same subfields'); $field = MARC::Field->new( '000', 'foobar' ); @subfields = $field->subfields(); ok(!@subfields, 'subfields() on a controlfield returns empty array'); MARC-Record-2.0.7/t/cameleof.usmarc0000644000175100017510000001470213111151774015015 0ustar gmcgmc00755cam 22002414a 4500001001300000003000600013005001700019008004100036010001700077020004300094040001800137042000800155050002600163082001700189100003100206245005400237260004200291300007200333500003300405650003700438630002500475630001300500fol05731351 IMchF20000613133448.0000107s2000 nyua 001 0 eng  a 00020737  a0471383147 (paper/cd-rom : alk. paper) aDLCcDLCdDLC apcc00aQA76.73.P22bM33 200000a005.13/32211 aMartinsson, Tobias,d1976-10aActivePerl with ASP and ADO /cTobias Martinsson. aNew York :bJohn Wiley & Sons,c2000. axxi, 289 p. :bill. ;c23 cm. +e1 computer laser disc (4 3/4 in.) a"Wiley Computer Publishing." 0aPerl (Computer program language)00aActive server pages.00aActiveX.00647pam 2200241 a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001800109042000800127050002600135082001500161100002600176245006700202260003800269263000900307300001100316650003700327650002500364700001600389fol05754809 IMchF20000601115601.0000203s2000 mau 001 0 eng  a 00022023  a1565926994 aDLCcDLCdDLC apcc00aQA76.73.P22bD47 200000a005.742211 aDescartes, Alligator.10aProgramming the Perl DBI /cAlligator Descartes and Tim Bunce. aCmabridge, MA :bO'Reilly,c2000. a1111 ap. cm. 0aPerl (Computer program language) 0aDatabase management.1 aBunce, Tim.00605cam 22002054a 4500001001300000003000600013005001700019008004100036010001700077040001800094042000800112050002700120082001700147100002100164245005500185260004500240300002600285504005100311650003700362fol05843555 IMchF20000525142739.0000318s1999 cau b 001 0 eng  a 00501349  aDLCcDLCdDLC apcc00aQA76.73.P22bB763 199900a005.13/32211 aBrown, Martin C.10aPerl :bprogrammer's reference /cMartin C. Brown. aBerkeley :bOsborne/McGraw-Hill,cc1999. axix, 380 p. ;c22 cm. aIncludes bibliographical references and index. 0aPerl (Computer program language)00579cam 22002054a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001800109042000800127050002700135082001700162100002100179245005500200260004500255300003600300650003700336fol05843579 IMchF20000525142716.0000318s1999 caua 001 0 eng  a 00502116  a0072120002 aDLCcDLCdDLC apcc00aQA76.73.P22bB762 199900a005.13/32211 aBrown, Martin C.10aPerl :bthe complete reference /cMartin C. Brown. aBerkeley :bOsborne/McGraw-Hill,cc1999. axxxv, 1179 p. :bill. ;c24 cm. 0aPerl (Computer program language)00801nam 22002778a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001300109042000800122050002600130082001800156100002000174245008800194250003200282260004100314263000900355300001100364650003700375650003600412650002600448700002500474700002400499fol05848297 IMchF20000524125727.0000518s2000 mau 001 0 eng  a 00041664  a1565924193 aDLCcDLC apcc00aQA76.73.P22bG84 200000a005.2/7622211 aGuelich, Scott.10aCGI programming with Perl /cScott Guelich, Shishir Gundavaram & Gunther Birznieks. a2nd ed., expanded & updated aCambridge, Mass. :bO'Reilly,c2000. a0006 ap. cm. 0aPerl (Computer program language) 0aCGI (Computer network protocol) 0aInternet programming.1 aGundavaram, Shishir.1 aBirznieks, Gunther.00665nam 22002298a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001300109042000800122050002700130082001700157111005200174245008600226250001200312260004100324263000900365300001100374650005000385fol05865950 IMchF20000615103017.0000612s2000 mau 100 0 eng  a 00055759  a0596000138 aDLCcDLC apcc00aQA76.73.P22bP475 200000a005.13/32212 aPerl Conference 4.0d(2000 :cMonterey, Calif.)10aProceedings of the Perl Conference 4.0 :bJuly 17-20, 2000, Monterey, California. a1st ed. aCambridge, Mass. :bO'Reilly,c2000. a0006 ap. cm. 0aPerl (Computer program language)vCongresses.00579nam 22002178a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001300109042000800122050002600130082001700156100002800173245006200201260004100263263000900304300001100313650003700324fol05865956 IMchF20000615102948.0000612s2000 mau 000 0 eng  a 00055770  a1565926099 aDLCcDLC apcc00aQA76.73.P22bB43 200000a005.13/32211 aBlank-Edelman, David N.10aPerl for system administration /cDavid N. Blank-Edelman. aCambridge, Mass. :bO'Reilly,c2000. a0006 ap. cm. 0aPerl (Computer program language)00661nam 22002538a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001300109042000800122050002600130082001700156100001700173245006700190250001200257260004100269263000900310300001100319650003700330700002300367700001700390fol05865967 IMchF20000615102611.0000614s2000 mau 000 0 eng  a 00055799  a0596000278 aDLCcDLC apcc00aQA76.73.P22bW35 200000a005.13/32211 aWall, Larry.10aProgramming Perl /cLarry Wall, Tom Christiansen & Jon Orwant. a3rd ed. aCambridge, Mass. :bO'Reilly,c2000. a0007 ap. cm. 0aPerl (Computer program language)1 aChristiansen, Tom.1 aOrwant, Jon.00603cam 22002054a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001800109042000800127050002600135082001700161100003200178245006000210260005700270300003300327650003700360fol05872355 IMchF20000706095105.0000315s1999 njua 001 0 eng  a 00500678  a013020868X aDLCcDLCdDLC apcc00aQA76.73.P22bL69 199900a005.13/32211 aLowe, Vincentq(Vincent D.)10aPerl programmer's interactive workbook /cVincent Lowe. aUpper Saddle River, NJ :bPrentice Hall PTP,cc1999. axx, 633 p. :bill. ;c23 cm. 0aPerl (Computer program language)00696nam 22002538a 4500001001300000003000600013005001700019008004100036010001700077020002800094040001300122042000800135050002600143082001700169100002600186245004400212260005100256263000900307300001100316500002000327650003700347650001700384650004100401fol05882032 IMchF20000707091904.0000630s2000 cau 001 0 eng  a 00058174  a0764547291 (alk. paper) aDLCcDLC apcc00aQA76.73.P22bF64 200000a005.13/32212 aFoster-Johnson, Eric.10aCross-platform Perl /cEric F. Johnson. aFoster City, CA :bIDG Books Worldwide,c2000. a0009 ap. cm. aIncludes index. 0aPerl (Computer program language) 0aWeb servers. 0aCross-platform software development.MARC-Record-2.0.7/t/batch-filter.t0000644000175100017510000000110313111151774014546 0ustar gmcgmc#!perl -Tw use strict; use Test::More; use File::Spec; plan( tests => 5 ); use_ok( 'MARC::Batch' ); my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $b = MARC::Batch->new( 'USMARC', $filename ); isa_ok( $b, 'MARC::Batch' ); my $r = $b->next( \&wanted ); isa_ok( $r, 'MARC::Record' ); my @fields = $r->fields(); is( scalar( @fields ), 1, 'filter worked' ); eval { $r = $b->next( 'barf' ); }; like( $@, qr/filter function in next\(\)/, 'error message' ); sub wanted { my ( $tag, $data ) = @_; if ( $tag ne '245' ) { return ( 0 ); } return( 1 ); } MARC-Record-2.0.7/t/12.ldr.t0000644000175100017510000000261113111151774013211 0ustar gmcgmc#!perl -Tw use strict; use Test::More tests => 14; use_ok( 'MARC::Record' ); # test to make sure leader is being populated properly my $r = MARC::Record->new(); isa_ok( $r, 'MARC::Record' ); $r->append_fields( MARC::Field->new( 245, 0, 0, a => 'Curious George battles the MARC leader' ) ); my $marc = $r->as_usmarc(); like( substr( $marc,0, 5 ), qr/^\d+$/, 'leader length' ); is( substr( $marc, 10, 1 ), '2', 'indicator count' ); is( substr( $marc, 11, 1 ), '2', 'subfield code count' ); like( substr( $marc, 12, 5 ), qr/^\d+$/, 'base address' ); is( substr( $marc, 20, 4 ), '4500', 'entry map' ); LEADER: { # setup my $r = MARC::Record->new(); isa_ok( $r, 'MARC::Record' ); $r->append_fields( MARC::Field->new( 245, 0, 0, a => 'MARC leader') ); my $default = $r->leader(); is( length($default), 24, 'default leader is the right length' ); is( scalar($r->warnings()), 0, 'no warnings yet' ); $r->leader( $default ); is( scalar($r->warnings()), 0, 'no warnings yet' ); $r->leader( substr($default, 0, -1) ); is( scalar($r->warnings()), 1, 'got a warning about bogus leader' ); # note that the warnings() call above cleared out all warnings, so # we're still expecting just one. is( scalar($r->warnings()), 0, 'no warnings yet' ); $r->leader( $default . ' ' ); is( scalar($r->warnings()), 1, 'got a warning about bogus leader' ); } MARC-Record-2.0.7/t/rt67094_field_sans_subfields.t0000644000175100017510000000043013111151774017472 0ustar gmcgmc#!perl -T use strict; use warnings; use Test::More tests => 1; use MARC::Field; eval { my $field = MARC::Field->new( '245', '0', '4', () ); }; like( $@, qr/must have at least one subfield/, 'RT#67094: croak with correct error if trying to create field without subfields'); MARC-Record-2.0.7/t/sample1.usmarc0000644000175100017510000000036013111151774014577 0ustar gmcgmc00240nam 22001092 4500008004100000040001000041245002200051260002000073300001100093900000800104952001800112891207s19xx xxu 00010 eng d cIMchF 0aAll about whales. bHoliday,c1987. a[ ] p. aALL a20571cRdALLMARC-Record-2.0.7/t/alphatag.lif0000644000175100017510000000024313111151774014276 0ustar gmcgmcheader alpha tag MicroLIF file LDR00107 2200061 4500 RAZ12_a123_bTweak 100 _aGates, Bill 110 _aMicrosoft MARC-Record-2.0.7/t/83.indicators.t0000644000175100017510000000627113111151774014605 0ustar gmcgmc#!perl -T use strict; use warnings; use Test::More tests => 25; use File::Spec; use_ok( 'MARC::Record' ); my $r = MARC::Record->new(); # alphabetic indicators are legal in some dialects of MARC $r->append_fields( MARC::Field->new( 245, 'z', 'Z', a => 'foo' ) ); is( $r->field(245)->indicator(1), 'z', 'indicator 1 can be non-numeric' ); is( $r->field(245)->indicator(2), 'Z', 'indicator 2 can be non-numeric' ); # rumor had it that invalid indicators sometimes invalidated other # valid indicators, so these tests make sure that is not the case $r->append_fields( MARC::Field->new( 100, 'dk', 2, a=> 'foo' ) ); is( $r->field(100)->indicator(1), ' ', 'invalid indicator squashed to space' ); is( $r->field(100)->indicator(2), 2, 'not disturbed' ); $r->append_fields( MARC::Field->new( 111, 2, '-didk', a=> 'foo' ) ); is ($r->field(111)->indicator(1), 2, 'not disturbed' ); is ($r->field(111)->indicator(2), ' ', 'invalid indicator squashed to space' ); # make sure eval { my $ind = $r->field(100)->indicator(3); }; like($@, qr/Indicator number must be 1 or 2/, 'croaked trying to retrieve indicator 3'); ## read a file which has an invalid indicator (a hyphen) and make sure it does ## not affect a valid indicator use_ok( 'MARC::Batch' ); my $filename = File::Spec->catfile( 't', 'badind.usmarc' ); my $batch = MARC::Batch->new( 'USMARC', $filename ); $batch->strict_off(); $batch->warnings_off(); $r = $batch->next(); my @warnings = $batch->warnings(); is( $warnings[0], 'Invalid indicator "-" forced to blank', 'got expected warning message' ); is( $r->field(245)->indicator(1),' ','hyphen forced to blank in indicator 1' ); is( $r->field(245)->indicator(2),'0','indicator 2 undisturbed' ); CONTROLFIELD: { my $field; $field = MARC::Field->new( '003', 'ICrlF' ); is( scalar($field->warnings()), 0, 'no warnings for field' ); ok( !defined $field->indicator(1), 'indicator(1) for control field returns undef' ); is( scalar($field->warnings()), 1, 'indicator(1) for control field generates warning' ); $field = MARC::Field->new( '003', 'ICrlF' ); is( scalar($field->warnings()), 0, 'no warnings for field' ); ok( !defined $field->indicator(2), 'indicator(2) for control field returns undef' ); is( scalar($field->warnings()), 1, 'indicator(2) for control field generates warning' ); } # check indicator setting my $field = MARC::Field->new('245', ' ', '0', a => 'The wind in the wilows' ); is( $field->indicator(1), ' ', 'first indicator starts as blank' ); $field->set_indicator(1, '0' ); is( $field->indicator(1), '0', 'first indicator is now 0' ); is( $field->indicator(2), '0', 'second indicator starts as 0' ); $field->set_indicator(2, '4' ); is( $field->indicator(2), '4', 'second indicator is now 4' ); eval { $field->set_indicator(3, 'a'); }; like( $@, qr/Indicator number must be 1 or 2/, 'cannot set indicator value at invalid position' ); eval { $field->set_indicator(1, "\n"); }; like( $@, qr/Indicator value is invalid/, 'cannot set indicator to invalid value' ); my $control_field = MARC::Field->new('003', 'abc'); eval { $control_field->set_indicator(1, ' '); }; like( $@, qr/Cannot set indicator for control field/, 'cannot set indicator for control field' ); MARC-Record-2.0.7/t/title_proper.t0000644000175100017510000000167413111151774014727 0ustar gmcgmc#!perl -Tw # $Id: title_proper.t,v 1.6 2005/01/05 04:30:24 eijabb Exp $ use strict; use integer; use File::Spec; use Test::More tests=>14; BEGIN { use_ok( 'MARC::File::USMARC' ); } my @titles = ( 'Current population reports. Series P-20, Population characteristics.', 'Current population reports. Series P-60, Consumer income.', 'Physical review. A, Atomic, molecular, and optical physics', 'Physical review. B, Condensed matter', 'America and the British Labour Party :', ); my $filename = File::Spec->catfile( 't', 'title_proper.usmarc' ); my $file = MARC::File::USMARC->in( $filename ); isa_ok( $file, 'MARC::File::USMARC', 'USMARC file' ); while ( my $marc = $file->next() ) { isa_ok( $marc, 'MARC::Record', 'Got a record' ); my $title = shift @titles; is( $marc->title_proper, $title ); } ok( !$MARC::File::ERROR, "Should have no error" ); is( scalar @titles, 0, "no titles left to check" ); $file->close; MARC-Record-2.0.7/t/61.append.t0000644000175100017510000000302313111151774013701 0ustar gmcgmc#!perl -Tw use strict; use integer; use Test::More tests=>8; use File::Spec; BEGIN { use_ok( 'MARC::Batch' ); use_ok( 'MARC::Field' ); } my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $batch = new MARC::Batch( 'MARC::File::USMARC', $filename ); isa_ok( $batch, 'MARC::Batch', 'Batch object creation' ); my $record = $batch->next(); isa_ok( $record, 'MARC::Record', 'Record object creation' ); my $f650 = $record->field('650'); isa_ok( $f650, 'MARC::Field', 'Field retrieval' ); my $new = MARC::Field->new('650','','0','a','World Wide Web.'); isa_ok( $new, 'MARC::Field', 'Field creation' ); my $nadded = $record->append_fields($new); is( $nadded, 1 ); my $expected = <as_formatted, $expected, "append_fields"); MARC-Record-2.0.7/t/convenience.t0000644000175100017510000000520113111151774014501 0ustar gmcgmc#!perl -Tw use strict; use integer; use constant EMPTY_TESTS => 10; use constant PERLCONF_SKIPS => 6; use constant CAMEL_SKIPS => 2; use constant XPLATFORM_SKIPS => 2; use File::Spec; # the 10 is for the EMPTY: block of tests use Test::More tests=>( 2 + EMPTY_TESTS + (5*3) + CAMEL_SKIPS + PERLCONF_SKIPS + XPLATFORM_SKIPS ); BEGIN { use_ok( 'MARC::File::USMARC' ); } EMPTY: { my $marc = MARC::Record->new(); ok( defined $marc->title(), 'if data not present, title() is not undef' ); is( $marc->title(), '', 'if data not present, title() is empty string' ); ok( defined $marc->title_proper(), 'if data not present, title_proper() is not undef' ); is( $marc->title_proper(), '', 'if data not present, title_proper() is empty string' ); ok( defined $marc->author(), 'if data not present, author() is not undef' ); is( $marc->author(), '', 'if data not present, author() is empty string' ); ok( defined $marc->edition(), 'if data not present, edition() is not undef' ); is( $marc->edition(), '', 'if data not present, edition() is empty string' ); ok( defined $marc->publication_date(), 'if data not present, publication_date() is not undef' ); is( $marc->publication_date(), '', 'if data not present, publication_date() is empty string' ); } my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $file = MARC::File::USMARC->in( $filename ); isa_ok( $file, 'MARC::File::USMARC', 'USMARC file' ); my $marc; for ( 1..PERLCONF_SKIPS ) { # Skip to the Perl conference $marc = $file->next(); isa_ok( $marc, 'MARC::Record', 'Got a record' ); } is( $marc->author, 'Perl Conference 4.0 (2000 : Monterey, Calif.)' ); is( $marc->title, 'Proceedings of the Perl Conference 4.0 : July 17-20, 2000, Monterey, California.' ); is( $marc->title_proper, 'Proceedings of the Perl Conference 4.0 :' ); is( $marc->edition, '1st ed.' ); is( $marc->publication_date, '2000.' ); for ( 1..CAMEL_SKIPS ) { # Skip to the camel $marc = $file->next(); isa_ok( $marc, 'MARC::Record', 'Got a record' ); } is( $marc->author, 'Wall, Larry.' ); is( $marc->title, 'Programming Perl / Larry Wall, Tom Christiansen & Jon Orwant.' ); is( $marc->title_proper, 'Programming Perl /' ); is( $marc->edition, '3rd ed.' ); is( $marc->publication_date, '2000.' ); for ( 1..XPLATFORM_SKIPS ) { # Skip to Cross-Platform Perl $marc = $file->next(); isa_ok( $marc, 'MARC::Record', 'Got a record' ); } is( $marc->author, 'Foster-Johnson, Eric.' ); is( $marc->title, 'Cross-platform Perl / Eric F. Johnson.' ); is( $marc->title_proper, 'Cross-platform Perl /' ); is( $marc->edition, '' ); is( $marc->publication_date, '2000.' ); $file->close; MARC-Record-2.0.7/t/pod.t0000644000175100017510000000036213111151774012772 0ustar gmcgmc#!perl -T use strict; use warnings; use Test::More; eval { require Test::Pod; Test::Pod->import(); die unless $Test::Pod::VERSION >= 1.14; }; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); MARC-Record-2.0.7/t/delete-subfield.t0000644000175100017510000000601313111151774015244 0ustar gmcgmcuse strict; use warnings; use Test::More tests => 16; use MARC::Field; my $field = MARC::Field->new('245', '0', '1', a=>'foo', b=>'bar', a=>'baz'); $field->delete_subfield(code => 'a'); is $field->as_string, 'bar', 'delete by subfield code'; $field = MARC::Field->new('245', '0', '1', a=>'foo', b=>'bar', a=>'baz'); $field->delete_subfield(code => qr/[^a]/); is $field->as_string(), 'foo baz', 'delete by regex on subfield code'; $field = MARC::Field->new('245', '0', '1', a=>'foo', b=>'bar', c=>'baz'); $field->delete_subfield(code => ['a','c']); is $field->as_string, 'bar', 'delete by multiple subfield codes'; $field = MARC::Field->new('245', '0', '1', a=>'foo', b=>'bar', a=>'baz'); $field->delete_subfield(pos => 0); is $field->as_string, 'bar baz', 'delete by pos'; $field = MARC::Field->new('245', '0', '1', a=>'foo', b=>'bar', a=>'baz'); $field->delete_subfield(pos => [0,2]); is $field->as_string, 'bar', 'delete by multiple pos'; $field = MARC::Field->new('245', '0', '1', a=>'foo', b=>'bar', a=>'baz'); $field->delete_subfield(code => 'a', pos => [0,2]); is $field->as_string, 'bar', 'delete by multiple pos with code'; $field = MARC::Field->new('245', '0', '1', a=>'foo', b=>'bar', a=>'baz'); $field->delete_subfield(code => 'b', pos => [0,2]); is $field->as_string, 'foo bar baz', 'delete by multiple pos with wrong code'; $field = MARC::Field->new('245', '0', '1', a=>'foo', b=>'bar', a=>'baz'); $field->delete_subfield(code => 'a', match => qr/baz/); is $field->as_string, 'foo bar', 'delete all subfield a that match /baz/'; $field = MARC::Field->new('245', '0', '1', z => 'quux baz', a=>'foo', b=>'bar', a=>'baz'); $field->delete_subfield(match => qr/baz/); is $field->as_string, 'foo bar', 'delete all subfields that match /baz/'; $field = MARC::Field->new('245', '0', '1', a=>'foo', b=>'bar', a=>'baz'); $field->delete_subfield(code => 'a', match => qr/bar/); is $field->as_string, 'foo bar baz', 'do not delete wrong subfield match'; eval { $field->delete_subfield(match => 'uhoh'); }; like $@, qr/match must be a compiled regex/, 'exception if match is not regex'; $field = MARC::Field->new('245', '0', '1', a=>'foo', b=>'bar', a=>'baz'); $field->delete_subfields('a'); is $field->as_string, 'bar', 'backwards compat with delete_subfields()'; $field = MARC::Field->new('245', '0', '1', a=>'foo', b=>'bar'); $field->delete_subfield('a'); is $field->as_string, 'bar', q(RT#70346: calling delete_subfield('a') should DWIM, not clear entire field); eval { $field->delete_subfield('a', 'b', 'c'); }; like $@, qr/delete_subfield must be called with single scalar or a hash/, 'exception if called with args that are neither single scalar or hash'; eval { $field->delete_subfield(); }; like $@, qr!must supply subfield code\(s\) and/or subfield position\(s\) and/or match patterns to delete_subfield!, 'exception if called no args'; eval { $field->delete_subfield(garbage => '123'); }; like $@, qr!must supply subfield code\(s\) and/or subfield position\(s\) and/or match patterns to delete_subfield!, 'exception if called unrecognized args'; MARC-Record-2.0.7/t/60.insert.t0000644000175100017510000001066013111151774013742 0ustar gmcgmc#!perl -Tw use strict; use integer; use File::Spec; use Test::More tests=>20; BEGIN { use_ok( 'MARC::Batch' ); use_ok( 'MARC::Field' ); } my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $batch = new MARC::Batch( 'MARC::File::USMARC', $filename ); isa_ok( $batch, 'MARC::Batch', 'Batch object creation' ); my $record = $batch->next(); isa_ok( $record, 'MARC::Record', 'Record object creation' ); my $f650 = $record->field('650'); isa_ok( $f650, 'MARC::Field', 'Field retrieval' ); my $new = MARC::Field->new('650','','0','a','World Wide Web.'); isa_ok( $new, 'MARC::Field', 'Field creation' ); my $newagain = MARC::Field->new('650','','0','a','Hockey etiquette.'); isa_ok( $newagain, 'MARC::Field', 'Field creation' ); ## test append_fields() my $nappended = $record->append_fields($new); is( $nappended, 1, "Added one field" ); my $expected = <as_formatted, $expected, "append_fields"); my $ndeleted = $record->delete_field($new); is( $ndeleted, 1, "Deleted one field" ); ## test insert_fields_after my $nadds = $record->insert_fields_after($f650,$new,$newagain); is( $nadds, 2, 'Added 2 fields' ); $expected = <as_formatted,$expected,'insert_fields_after'); my $n = $record->delete_field($new); is( $n, 1 ); $n = $record->delete_field($newagain); is( $n, 1 ); # marker field for last field of record - testing rt55993 my $new999 = MARC::Field->new('999', ' ', ' ', a => 'last field'); $nappended = $record->append_fields($new999); is ( $nappended, 1, 'added 999 field as last field (RT#55993 test)' ); $nadds = $record->insert_fields_after($new999,$newagain); is( $nadds, 1, 'added 650 after last field in record (RT#55993 test)' ); $n = $record->delete_field($newagain); is( $n, 1 ); $n = $record->delete_field($new999); is( $n, 1, 'deleted 999 field' ); ## test insert_record_before $nadds = $record->insert_fields_before($f650, MARC::Field->new('650','4','3','a','House painting.'), $new ); is( $nadds, 2, 'Added 2 more fields' ); $expected = <as_formatted,$expected,'insert_fields_before'); MARC-Record-2.0.7/t/81.decode.t0000644000175100017510000001166713111151774013674 0ustar gmcgmc#!perl -Tw use Test::More tests => 40; use strict; use File::Spec; BEGIN { use_ok( 'MARC::Record' ); use_ok( 'MARC::File::MicroLIF' ); use_ok( 'MARC::File::USMARC' ); } ## decode can be called in a variety of ways ## ## $obj->decode() ## MARC::File::MicroLIF->decode() ## MARC::File::MicroLIF::decode() ## ## $obj->decode() ## MARC::File::USMARC->decode() ## MARC::File::USMARC::decode() ## ## these tests make sure we don't break any of them ## slurp up some microlif (one file of each type of line endings) my @lifnames = ( 'lineendings-0a.lif', 'lineendings-0d.lif', 'lineendings-0d0a.lif' ); foreach my $lifname (@lifnames) { my $liffile = File::Spec->catfile( 't', $lifname ); open(my $IN, '<', $liffile ); my $str = join( '', <$IN> ); close $IN; ## attempt to use decode() on it DECODE_MICROLIF_METHOD: { my $rec = MARC::File::MicroLIF->decode( $str ); isa_ok( $rec, 'MARC::Record' ); like( $rec->title(), qr/all about whales/i, "retrieved title from file $lifname" ); } DECODE_MICROLIF_FUNCTION: { my $rec = MARC::File::MicroLIF::decode( $str ); isa_ok( $rec, 'MARC::Record' ); like( $rec->title(), qr/all about whales/i, "retrieved title from file $lifname" ); } } #foreach lif file ## slurp up some usmarc my $marcname = File::Spec->catfile( 't', 'sample1.usmarc' ); open(my $IN, '<', $marcname ); my $str = join( '', <$IN> ); close $IN; ## attempt to use decode on it DECODE_USMARC_METHOD: { my $rec = MARC::File::USMARC->decode( $str ); isa_ok( $rec, 'MARC::Record' ); like( $rec->title(), qr/all about whales/i, 'retrieved title' ); } DECODE_USMARC_FUNCTION: { my $rec = MARC::File::USMARC::decode( $str ); isa_ok( $rec, 'MARC::Record' ); like( $rec->title(), qr/all about whales/i, 'retrieved title' ); } # # make sure that MARC decode() can handle gaps in the record # body and data in the body not being in directory order # my @fragments = ( "00214nam 22000978a 4500", "001001500000", "010000900015", "100002000024", "245001100044", # length is 11 "260003300059", "650002400092", "\x1e", "control number\x1e", " \x1f" . "aLCCN\x1e", "1 \x1f" . "aName, Inverted.\x1e", # '@@@@' here is dead space after then end of the field. # The directory is set up so that the 245 field consists just # of two indicators, \x1f, 'a', 'Title.', and \x1e. The four # characters after the \x1e constitute an (allowed) unused gap in the # record body. "10\x1f" . "aTitle.\x1e@@@@", "3 \x1f" . "aPlace : \x1f" . "bPublisher, \x1f" . "cYear.\x1e", " 0\x1f" . "aLC subject heading.\x1e", "\x1d" ); INITIAL_FRAGMENTS: { my $rec = MARC::File::USMARC->decode( join('', @fragments) ); my @w = $rec->warnings(); is( scalar @w, 0, 'should be no warnings' ); is( $rec->field('245')->as_usmarc(), "10\x1f" . "aTitle.\x1e", 'gap after field data should not be returned' ); my $the260 = $rec->field('260'); isa_ok( $the260, "MARC::Field" ); is( $the260->indicator(1), '3', 'indicators in tag after gap should be OK' ); is( $the260->subfield('a'), "Place : ", 'subfield a in tag after gap should be OK' ); is( $the260->subfield('b'), "Publisher, ", 'subfield b in tag after gap should be OK' ); is( $the260->subfield('c'), "Year.", 'subfield c in tag after gap should be OK' ); } # rearrange the directory for next test @fragments[1,6] = @fragments[6,1]; @fragments[2,5] = @fragments[5,2]; SHUFFLED_FRAGMENTS: { my $rec = MARC::File::USMARC->decode( join('', @fragments) ); isa_ok( $rec, "MARC::Record" ); is( $rec->field('001')->as_string(), 'control number', '001 field correct' ); is( $rec->field('010')->as_string(), 'LCCN', '010 field correct' ); is( $rec->field('100')->as_string(), 'Name, Inverted.', '100 field correct' ); is( $rec->field('245')->as_string(), 'Title.', '245 field correct' ); is( $rec->field('260')->as_string(), 'Place : Publisher, Year.', '260 field correct' ); is( $rec->field('650')->as_string(), 'LC subject heading.', '650 field correct' ); } # # make sure that MARC::File::MicroLIF::decode can handle # fields with no subfields without causing MARC::Field # to croak(). # MICROLIF_NOSUBFIELDS: { # both the 040 and 041 should be discarded my $str = <warnings(); is( scalar @warnings, 2, 'check for appropriate warnings count' ); ok( grep( /Tag 040.*discarded/, @warnings ), '040 warning present' ); ok( grep( /Tag 041.*discarded/, @warnings ), '041 warning present' ); ok( $rec->field('245'), '245 should not exist' ); ok( !$rec->field('040'), '040 should not exist' ); ok( !$rec->field('041'), '041 should not exist' ); } MARC-Record-2.0.7/t/64.create.t0000644000175100017510000000145413111151774013706 0ustar gmcgmc#!perl -Tw use strict; use integer; use Test::More tests=>7; BEGIN { use_ok( 'MARC::Record'); use_ok( 'MARC::Field'); } my $record = MARC::Record->new(); isa_ok( $record, 'MARC::Record', 'Record object creation' ); my $f245 = MARC::Field->new('245','1','0','a','Test create.'); isa_ok( $f245, 'MARC::Field', '245 creation'); my $f650 = MARC::Field->new('650','','0','a','World Wide Web.'); isa_ok( $f650, 'MARC::Field', '650 creation'); my $nadds = $record->append_fields($f245,$f650); is( $nadds, 2, 'two fields appended' ); $record->as_usmarc(); ## side effect is that leader offsets are calculated my $expected = <as_formatted,$expected,'New record matches'); MARC-Record-2.0.7/t/85.fh.t0000644000175100017510000001025513111151774013042 0ustar gmcgmc#!perl -Tw # test that we can pass filehandles to MARC::File::USMARC and MARC::Batch use Test::More tests => 206; use strict; use IO::File; use File::Spec; use_ok( 'MARC::File::USMARC' ); use_ok( 'MARC::File::MicroLIF' ); use_ok( 'MARC::Batch' ); # first try globs with MARC::File::USMARC USMARC_FILE_GLOB: { my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); open( MARCDATA, '<', $filename ); my $fh = *MARCDATA; my $file = MARC::File::USMARC->in( $fh ); isa_ok( $file, "MARC::File::USMARC" ); my $count = 0; while ( my $r = $file->next() ) { ++$count; isa_ok( $r, "MARC::Record" ); } is( $count, 10, 'MARC::File::USMARC avec globbed file handle works' ); } # now try IO::File objects with MARC::File::USMARC USMARC_IO_FILE: { my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $fh = IO::File->new( $filename ); isa_ok( $fh, "IO::File" ); my $file = MARC::File::USMARC->in( $fh ); isa_ok( $file, "MARC::File::USMARC" ); my $count = 0; while ( my $r = $file->next() ) { ++$count; isa_ok( $r, "MARC::Record" ); } is( $count, 10, 'MARC::File::USMARC avec IO::File object works' ); } # now try globs with MARC::File::MicroLIF MICROLIF_FILE_GLOB: { my $filename = File::Spec->catfile( 't', 'sample20.lif' ); open( LIFDATA, '<', $filename ); my $fh = *LIFDATA; my $file = MARC::File::MicroLIF->in( $fh ); isa_ok( $file, "MARC::File::MicroLIF" ); my $count = 0; while ( my $r = $file->next() ) { ++$count; isa_ok( $r, "MARC::Record" ); } is( $count, 20, 'MARC::File::MicroLIF avec globbed file handle works' ); } # and IO::File object with MARC::File::MicroLIF MICROLIF_IO_FILE: { my $filename = File::Spec->catfile( 't', 'sample20.lif' ); my $fh = IO::File->new( $filename ); isa_ok( $fh, "IO::File" ); my $file = MARC::File::MicroLIF->in( $fh ); isa_ok( $file, "MARC::File::MicroLIF" ); my $count = 0; while ( my $r = $file->next() ) { ++$count; isa_ok( $r, "MARC::Record" ); } is( $count, 20, 'MARC::File::MicroLIF avec IO::File object works' ); } # ok now lets check that MARC::Batch works as expected MARC_BATCH_FILEHANDLE: { my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $fh = IO::File->new( $filename ); isa_ok( $fh, "IO::File" ); my $batch = MARC::Batch->new( 'USMARC', $fh ); isa_ok( $batch, "MARC::Batch" ); my $count = 0; while ( my $r = $batch->next() ) { ++$count; isa_ok( $r, "MARC::Record" ); } is( $count, 10, 'MARC::Batch avec IO::File object and USMARC' ); } # now lets try two filehandles MARC_BATCH_FILEHANDLES: { my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $fh1 = IO::File->new( $filename ); isa_ok( $fh1, "IO::File" ); my $fh2 = IO::File->new( $filename ); isa_ok( $fh2, "IO::File" ); my $batch = MARC::Batch->new( 'USMARC', $fh1, $fh2 ); isa_ok( $batch, "MARC::Batch" ); my $count = 0; while ( my $r = $batch->next() ) { ++$count; isa_ok( $r, "MARC::Record" ); } is( $count, 20, 'MARC::Batch avec IO::File objects and USMARC' ); } # now lets try a mix of filenames, IO::File objects and globs MARC_BATCH_MIX: { my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); open( MARCDATA, '<', $filename ); my $fh1 = *MARCDATA; my $fh2 = IO::File->new( $filename ); isa_ok( $fh2, "IO::File" ); my $batch = MARC::Batch->new( 'USMARC', $fh1, $fh2, $filename ); isa_ok( $batch, "MARC::Batch" ); my $count = 0; while ( my $r = $batch->next() ) { ++$count; isa_ok( $r, "MARC::Record" ); } is( $count, 30, 'MARC::Batch avec mixture of handles and names and Lif'); } MICROLIF_BATCH_MIX: { my $filename = File::Spec->catfile( 't', 'sample20.lif' ); open( LIFDATA, '<', $filename ); my $fh1 = *LIFDATA; my $fh2 = IO::File->new( $filename ); isa_ok( $fh2, "IO::File" ); my $batch = MARC::Batch->new( 'MicroLIF', $fh1, $fh2, $filename ); isa_ok( $batch, "MARC::Batch" ); my $count = 0; while ( my $r = $batch->next() ) { ++$count; isa_ok( $r, "MARC::Record" ); } is( $count, 60, 'MARC::Batch avec mixture of handles and names and Lif' ); } MARC-Record-2.0.7/t/camel.usmarc0000644000175100017510000001467713111151774014336 0ustar gmcgmc00755cam 22002414a 4500001001300000003000600013005001700019008004100036010001700077020004300094040001800137042000800155050002600163082001700189100003100206245005400237260004200291300007200333500003300405650003700438630002500475630001300500fol05731351 IMchF20000613133448.0000107s2000 nyua 001 0 eng  a 00020737  a0471383147 (paper/cd-rom : alk. paper) aDLCcDLCdDLC apcc00aQA76.73.P22bM33 200000a005.13/32211 aMartinsson, Tobias,d1976-10aActivePerl with ASP and ADO /cTobias Martinsson. aNew York :bJohn Wiley & Sons,c2000. axxi, 289 p. :bill. ;c23 cm. +e1 computer laser disc (4 3/4 in.) a"Wiley Computer Publishing." 0aPerl (Computer program language)00aActive server pages.00aActiveX.00647pam 2200241 a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001800109042000800127050002600135082001500161100002600176245006700202260003800269263000900307300001100316650003700327650002500364700001600389fol05754809 IMchF20000601115601.0000203s2000 mau 001 0 eng  a 00022023  a1565926994 aDLCcDLCdDLC apcc00aQA76.73.P22bD47 200000a005.742211 aDescartes, Alligator.10aProgramming the Perl DBI /cAlligator Descartes and Tim Bunce. aCmabridge, MA :bO'Reilly,c2000. a1111 ap. cm. 0aPerl (Computer program language) 0aDatabase management.1 aBunce, Tim.00605cam 22002054a 4500001001300000003000600013005001700019008004100036010001700077040001800094042000800112050002700120082001700147100002100164245005500185260004500240300002600285504005100311650003700362fol05843555 IMchF20000525142739.0000318s1999 cau b 001 0 eng  a 00501349  aDLCcDLCdDLC apcc00aQA76.73.P22bB763 199900a005.13/32211 aBrown, Martin C.10aPerl :bprogrammer's reference /cMartin C. Brown. aBerkeley :bOsborne/McGraw-Hill,cc1999. axix, 380 p. ;c22 cm. aIncludes bibliographical references and index. 0aPerl (Computer program language)00579cam 22002054a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001800109042000800127050002700135082001700162100002100179245005500200260004500255300003600300650003700336fol05843579 IMchF20000525142716.0000318s1999 caua 001 0 eng  a 00502116  a0072120002 aDLCcDLCdDLC apcc00aQA76.73.P22bB762 199900a005.13/32211 aBrown, Martin C.10aPerl :bthe complete reference /cMartin C. Brown. aBerkeley :bOsborne/McGraw-Hill,cc1999. axxxv, 1179 p. :bill. ;c24 cm. 0aPerl (Computer program language)00801nam 22002778a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001300109042000800122050002600130082001800156100002000174245008800194250003200282260004100314263000900355300001100364650003700375650003600412650002600448700002500474700002400499fol05848297 IMchF20000524125727.0000518s2000 mau 001 0 eng  a 00041664  a1565924193 aDLCcDLC apcc00aQA76.73.P22bG84 200000a005.2/7622211 aGuelich, Scott.10aCGI programming with Perl /cScott Guelich, Shishir Gundavaram & Gunther Birznieks. a2nd ed., expanded & updated aCambridge, Mass. :bO'Reilly,c2000. a0006 ap. cm. 0aPerl (Computer program language) 0aCGI (Computer network protocol) 0aInternet programming.1 aGundavaram, Shishir.1 aBirznieks, Gunther.00665nam 22002298a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001300109042000800122050002700130082001700157111005200174245008600226250001200312260004100324263000900365300001100374650005000385fol05865950 IMchF20000615103017.0000612s2000 mau 100 0 eng  a 00055759  a0596000138 aDLCcDLC apcc00aQA76.73.P22bP475 200000a005.13/32212 aPerl Conference 4.0d(2000 :cMonterey, Calif.)10aProceedings of the Perl Conference 4.0 :bJuly 17-20, 2000, Monterey, California. a1st ed. aCambridge, Mass. :bO'Reilly,c2000. a0006 ap. cm. 0aPerl (Computer program language)vCongresses.00579nam 22002178a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001300109042000800122050002600130082001700156100002800173245006200201260004100263263000900304300001100313650003700324fol05865956 IMchF20000615102948.0000612s2000 mau 000 0 eng  a 00055770  a1565926099 aDLCcDLC apcc00aQA76.73.P22bB43 200000a005.13/32211 aBlank-Edelman, David N.10aPerl for system administration /cDavid N. Blank-Edelman. aCambridge, Mass. :bO'Reilly,c2000. a0006 ap. cm. 0aPerl (Computer program language)00661nam 22002538a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001300109042000800122050002600130082001700156100001700173245006700190250001200257260004100269263000900310300001100319650003700330700002300367700001700390fol05865967 IMchF20000615102611.0000614s2000 mau 000 0 eng  a 00055799  a0596000278 aDLCcDLC apcc00aQA76.73.P22bW35 200000a005.13/32211 aWall, Larry.10aProgramming Perl /cLarry Wall, Tom Christiansen & Jon Orwant. a3rd ed. aCambridge, Mass. :bO'Reilly,c2000. a0007 ap. cm. 0aPerl (Computer program language)1 aChristiansen, Tom.1 aOrwant, Jon.00603cam 22002054a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001800109042000800127050002600135082001700161100003200178245006000210260005700270300003300327650003700360fol05872355 IMchF20000706095105.0000315s1999 njua 001 0 eng  a 00500678  a013020868X aDLCcDLCdDLC apcc00aQA76.73.P22bL69 199900a005.13/32211 aLowe, Vincentq(Vincent D.)10aPerl programmer's interactive workbook /cVincent Lowe. aUpper Saddle River, NJ :bPrentice Hall PTP,cc1999. axx, 633 p. :bill. ;c23 cm. 0aPerl (Computer program language)00696nam 22002538a 4500001001300000003000600013005001700019008004100036010001700077020002800094040001300122042000800135050002600143082001700169100002600186245004400212260005100256263000900307300001100316500002000327650003700347650001700384650004100401fol05882032 IMchF20000707091904.0000630s2000 cau 001 0 eng  a 00058174  a0764547291 (alk. paper) aDLCcDLC apcc00aQA76.73.P22bF64 200000a005.13/32212 aFoster-Johnson, Eric.10aCross-platform Perl /cEric F. Johnson. aFoster City, CA :bIDG Books Worldwide,c2000. a0009 ap. cm. aIncludes index. 0aPerl (Computer program language) 0aWeb servers. 0aCross-platform software development.MARC-Record-2.0.7/t/delete-field.t0000644000175100017510000000134113111151774014531 0ustar gmcgmcuse strict; use warnings; use Test::More tests => 4; use MARC::Record; my $record = MARC::Record->new(); $record->append_fields(MARC::Field->new('035', '', '', 'a' => 'Foo')); $record->append_fields(MARC::Field->new('035', '', '', 'a' => 'Bar')); $record->append_fields(MARC::Field->new('035', '', '', 'a' => 'Baz')); my @original_035s = $record->field('035'); is scalar(@original_035s), 3, 'found 3 035 fields'; my @delete_035s = @original_035s[1..2]; is scalar(@delete_035s), 2, 'going to delete last 2 035 fields'; $record->delete_fields(@delete_035s); # now should have just one 035 my @new_035s = $record->field('035'); is scalar(@new_035s), 1, 'found 1 035 field'; is $new_035s[0]->subfield('a'), 'Foo', 'got the right 035'; MARC-Record-2.0.7/t/filler.t0000644000175100017510000000305513111151774013467 0ustar gmcgmc#!perl -Tw use strict; use integer; use File::Spec; use Test::More 'no_plan'; BEGIN { use_ok( 'MARC::File::USMARC' ); } my $filename = File::Spec->catfile( 't', 'filler.usmarc' ); my $file = MARC::File::USMARC->in( $filename ); isa_ok( $file, 'MARC::File::USMARC', 'opened the test file' ); my $marc; # There are exactly three records in the file, and there are # various problems with leading and trailing spaces, nulls, # and newlines. There should be no warnings or errors # reading the file. $marc = $file->next(); isa_ok( $marc, 'MARC::Record', 'got record 1' ); is( scalar $marc->fields(), 18, 'should be 18 fields' ); is( scalar $marc->warnings(), 0, 'should be 0 warnings' ); ok( !defined $MARC::Record::ERROR, 'should be no errors' ); $marc = $file->next(); isa_ok( $marc, 'MARC::Record', 'got record 2' ); is( scalar $marc->fields(), 18, 'should be 18 fields' ); is( scalar $marc->warnings(), 0, 'should be 0 warnings' ); ok( !defined $MARC::Record::ERROR, 'should be no errors' ); $marc = $file->next(); isa_ok( $marc, 'MARC::Record', 'got record 3' ); is( scalar $marc->fields(), 15, 'should be 15 fields' ); is( scalar $marc->warnings(), 0, 'should be 0 warnings' ); ok( !defined $MARC::Record::ERROR, 'should be no errors' ); # Last record has been read. The only thing remaining # before eof is a newline, which should be consumed # by this next() and undef then returned because we're # at the file eof. $marc = $file->next(); ok( !defined $marc, 'no record, just eof' ); ok( !defined $MARC::Record::ERROR, 'should be no errors' ); $file->close; MARC-Record-2.0.7/t/60.update.t0000644000175100017510000000366313111151774013725 0ustar gmcgmc#!perl -Tw use strict; use integer; use Data::Dumper; use File::Spec; use Test::More tests=>20; BEGIN { use_ok( 'MARC::File::USMARC' ); } my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $file = MARC::File::USMARC->in( $filename ); isa_ok( $file, 'MARC::File::USMARC', 'USMARC file' ); my $marc = $file->next(); isa_ok( $marc, 'MARC::Record' ) or die "Can't read the test record"; $file->close; my $field = $marc->field('245'); isa_ok( $field, 'MARC::Field', 'new 245' ); my $nchanges = $field->update('a' => 'Programming Python /', 'ind1' => '4' ); is( $marc->subfield('245','a') => 'Programming Python /', 'Updated 1 subfield' ); is( $field->indicator(1) => '4', 'Indicator 1 changed' ); is( $nchanges, 2, 'number of changes is correct' ); $nchanges = $field->update('a' => 'Programming Python /', 'c' => 'Mark Lutz'); is( $field->as_string() => 'Programming Python / Mark Lutz', 'Updated 2 subfields'); is( $nchanges, 2, 'number of changes is correct' ); ## make sure we can update fields with no subfields or indicators (000-009) my $f003 = $marc->field('003'); isa_ok( $f003, 'MARC::Field' ); my $n = $f003->update('XXXX'); is( $n, 1, 'number of changes is correct' ); $f003 = $marc->field('003'); isa_ok( $f003, 'MARC::Field' ); is( $f003->as_string(), 'XXXX', 'Update for fields 000-009 works' ); ## if an update is attempted on a non existent subfield it will be ## appended to the end of the subfield $field = $marc->field( '245' ); isa_ok( $field, 'MARC::Field', 'got 245' ); $n = $field->update( 'z' => 'foo bar' ); is( $n, 1, 'numer of changes correct' ); is( $field->subfield( 'z' ), 'foo bar', 'update() append worked' ); $n = $field->update( 'x' => 'homer', 'y' => 'plato', 'z' => 'bart' ); is( $n, 3, 'number of changes correct' ); is( $field->subfield( 'x' ), 'homer', 'update() append 1' ); is( $field->subfield( 'y' ), 'plato', 'update() append 2' ); is( $field->subfield( 'z' ), 'bart', 'update() append 3' ); MARC-Record-2.0.7/t/lineendings.t0000644000175100017510000000274713111151774014520 0ustar gmcgmc#!perl -Tw use strict; use Test::More; use vars qw( @endings ); use File::Spec; BEGIN { @endings = qw( 0a 0d 0d0a ); plan( tests => @endings*13 + 2 ); use_ok( 'MARC::Record' ); use_ok( 'MARC::File::MicroLIF' ); } foreach my $ending ( @endings ) { my $filename = File::Spec->catfile( 't', "lineendings-$ending.lif" ); my $file = MARC::File::MicroLIF->in( $filename ); isa_ok( $file, 'MARC::File::MicroLIF' ); is( scalar $file->warnings(), 0, 'no file warnings for $filename' ); my $record = $file->next(); isa_ok( $record, 'MARC::Record', 'successfully decoded' ); is( scalar $record->warnings(), 0, 'no record warnings' ); is( scalar $record->fields(), 7, 'checking the number of fields in the record' ); is( $record->leader(), '00180nam 22 2 4500', "checking $filename LDR" ); is( $record->field('008')->as_string(), '891207s19xx xxu 00010 eng d', "checking $filename 008" ); is( $record->field('040')->as_string(), 'IMchF', "checking $filename 040" ); is( $record->field('245')->as_string(), 'All about whales.', "checking $filename 245" ); is( $record->field('260')->as_string(), 'Holiday, 1987.', "checking $filename 260" ); is( $record->field('300')->as_string(), '[ ] p.', "checking $filename 300" ); is( $record->field('900')->as_string(), 'ALL', "checking $filename 900" ); is( $record->field('952')->as_string(), '20571 R ALL', "checking $filename 952" ); $file->close(); } MARC-Record-2.0.7/t/badldr.usmarc0000644000175100017510000000326613111151774014475 0ustar gmcgmc00240nam 2200085 4500008004100000100001800041245003400059260002000093852004100113020222n 0 und 1 aAndrews, V.C.10aFallen hearts.hMiscellaneous0 bMiscellaneous,  aPaperbacksbMFFhAiANDp1339700001500232nam 2200085 4500008004100000100002000041245002900061260002000090852003600110020222n 0 und 1 aKoontz, Dean R.10aHideaway.hMiscellaneous0 bMiscellaneous,  aPaperbackshKiKOOp1339700002400345nam 2200109 4500020001500000245006800015260003500083300001100118651002400129651002500153852005700178 a067089435410aMaclean's peopleb: a gallery of Canadian greatshMiscellaneous0 aTorontobPenguin/Vikingcc2001 a416 p. aCanadax Biography. aCanadaxBiographies. 935aAdult Non FictionbMFFhB MacliMACp1339703221700250nam 2200085 4500020001500000245005700015260003700072300001400109852004100123 a155960012810aFlying leathernecksb[videorecording]hMiscellaneous0 bTurner Home Entertainmentcc1988 a102 mins. 99.95bMFFhVID 990iFLYp1339703248000251nam 2200085 4500008004100000100001200041245005100053260002000104852004100124020222n 0 und 1 aCooper,10aBlack fire : a Star Trek novel.hMiscellaneous0 bMiscellaneous,  aPaperbacksbMFFhCiCOOp1339700005400398nam 2200157 4500001000100000005000100001008004100002020001500043082000600058100002200064245003700086260003600123300001100159440001700170852005300187 0921n xx 00011 eng u  a0553241508 aF1 aWoodruff, Marian.10aKiss me, creep.bhMiscellaneous0 a-- TorontobBantam Bookscc1984 a134 p. aSweet Dreams aJuvenile FictionhJ F Woo p.b.iWOOp133970000727MARC-Record-2.0.7/t/sample1.lif0000644000175100017510000000027413111151774014063 0ustar gmcgmcLDR00180nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll about whales.^ 260 _bHoliday,_c1987.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a20571_cR_dALL^` MARC-Record-2.0.7/t/75.warnings.t0000644000175100017510000000401313111151774014267 0ustar gmcgmc#!perl -Tw use Test::More tests=>21; use strict; use File::Spec; BEGIN { use_ok( 'MARC::Batch' ); } ## when strict is on, errors cause next() to return undef STRICT_ON: { my $filename = File::Spec->catfile( 't', 'badldr.usmarc' ); my $batch = MARC::Batch->new( 'USMARC', $filename ); isa_ok( $batch, 'MARC::Batch' ); $batch->warnings_off(); # avoid clutter on STDERR $batch->strict_on(); # the default, but might as well test my $count = 0; while ( my $r = $batch->next() ) { isa_ok( $r, "MARC::Record" ); $count++; } my @warnings = $batch->warnings(); is( scalar(@warnings), 1, "warnings() w/ strict on" ); is( $count, 2, "next() w/ strict on" ); } ## when strict is off you can keep on reading past errors STRICT_OFF: { my $filename = File::Spec->catfile( 't', 'badldr.usmarc' ); my $batch = MARC::Batch->new( 'USMARC', $filename ); isa_ok( $batch, 'MARC::Batch' ); $batch->warnings_off(); # avoid clutter on STDERR $batch->strict_off(); # turning off default behavior my $count = 0; while ( my $r = $batch->next() ) { isa_ok( $r, "MARC::Record" ); $count++; } my @warnings = $batch->warnings(); is( scalar(@warnings), 2, "warnings() w/ strict off" ); is( $count, 8, "next() w/ strict off" ); } WARNINGS_BUFFER_RESET: { my $filename = File::Spec->catfile( 't', 'badind.usmarc' ); my $batch = MARC::Batch->new( 'USMARC', $filename ); $batch->warnings_off(); $batch->strict_off(); my $r = $batch->next(); ## check the warnings on the batch my @warnings = $batch->warnings(); is( @warnings, 1, 'got expected amt of warnings off the batch' ); like( $warnings[0], qr/^Invalid indicator/, 'got expected err msg off the batch' ); ## same exact warning should be available on the record @warnings = $r->warnings(); is( @warnings, 1, 'got expected amt of warnings off the record' ); like( $warnings[0], qr/^Invalid indicator/, 'got expected err msg off the record' ); } MARC-Record-2.0.7/t/baddir.usmarc0000644000175100017510000000057713111151774014474 0ustar gmcgmc00382nam 22001455a 4500001001200000005001800012008004100030020002200071091002200093100001500115245002300130260002300153300000900176852005100185 200093220020221152100.00020221 1988 d a0394800168c$7.99 aChild. Lit. E SEU aSeuss, Dr.00aGreen Eggs and Ham bRandom Housec1988 a62p. aCTd2/21/02fGENhE SEUl220p220000174197.99 MARC-Record-2.0.7/t/pod-coverage.t0000644000175100017510000000044613111151774014566 0ustar gmcgmc#!perl -T use strict; use warnings; eval { require Test::Pod::Coverage; Test::Pod::Coverage->import(); die unless $Test::Pod::Coverage::VERSION >= 1.04; }; use Test::More; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); MARC-Record-2.0.7/t/rename-field.t0000644000175100017510000000117113111151774014537 0ustar gmcgmcuse strict; use warnings; use Test::More tests => 3; use MARC::Record; my $record = MARC::Record->new(); $record->append_fields(MARC::Field->new('035', '', '', 'a' => 'Foo')); $record->append_fields(MARC::Field->new('035', '', '', 'a' => 'Bar')); $record->append_fields(MARC::Field->new('035', '', '', 'a' => 'Baz')); my @original_035s = $record->field('035'); is scalar(@original_035s), 3, 'found 3 035 fields'; $original_035s[0]->set_tag('100'); my @new_100 = $record->field('100'); is scalar(@new_100), 1, 'found 1 new 100 field'; @original_035s = $record->field('035'); is scalar(@original_035s), 2, 'found 2 035 fields'; MARC-Record-2.0.7/t/20.clone.t0000644000175100017510000000115713111151774013533 0ustar gmcgmc#!perl -Tw use integer; use strict; use File::Spec; use Test::More tests=>6; BEGIN { use_ok( 'MARC::File::USMARC' ); } my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $file = MARC::File::USMARC->in( $filename ); isa_ok( $file, 'MARC::File::USMARC', 'USMARC input file object' ); my $marc = $file->next(); isa_ok( $marc, 'MARC::Record', 'Read from file' ); $file->close; my $clone = $marc->clone; isa_ok( $clone, 'MARC::Record', 'Cloned record' ); ok( $marc != $clone, 'Clone and original are different' ); ok( $marc->as_formatted eq $clone->as_formatted, 'Clone and original match content' ); MARC-Record-2.0.7/t/70.croak.t0000644000175100017510000000247613111151774013544 0ustar gmcgmc#!perl -T use strict; use warnings; use Test::More tests=>9; ## methods should croak when called wrong so that MARC::Record users can ## identify the location of their mistakes. BEGIN { use_ok( "MARC::Record" ); use_ok( "MARC::Field" ); } my $record = MARC::Record->new(); isa_ok( $record, "MARC::Record" ); my $f100 = MARC::Field->new( '100', '', '', 'a' => 'author' ); isa_ok( $f100, "MARC::Field", "F100 ok" ); my $f200 = MARC::Field->new( '245', '', '', 'b' => 'title' ); isa_ok( $f200, "MARC::Field", "F200 ok" ); INSERT_FIELDS_AFTER: { eval { my $n = $record->insert_fields_after( $f100, 'blah' ); }; like( $@, qr/All arguments must be MARC::Field objects/, 'insert_fields_after() croaks appropriately' ); } INSERT_FIELDS_BEFORE: { eval { $record->insert_fields_before( $f100, 'blah' ); }; like( $@, qr/All arguments must be MARC::Field objects/, 'insert_fields_before() croaks appropriately' ); } INSERT_GROUPED_FIELD: { eval { my $n = $record->insert_grouped_field( 'blah' ); }; like( $@, qr/Argument must be MARC::Field object/, 'insert_grouped_field() croaks appropriately' ); } APPEND_FIELDS: { eval { $record->append_fields( 'blah' ); }; like( $@, qr/Arguments must be MARC::Field objects/, 'append_fields() croaks appropriately' ); } MARC-Record-2.0.7/t/badind.usmarc0000644000175100017510000000036113111151774014457 0ustar gmcgmc00240nam 22001092 4500008004100000040001000041245002200051260002000073300001100093900000800104952001800112891207s19xx xxu 00010 eng d cIMchF-0aAll about whales. bHoliday,c1987. a[ ] p. aALL a20571cRdALL MARC-Record-2.0.7/t/lineendings-0d.lif0000644000175100017510000000041513111151774015316 0ustar gmcgmcMicroLIF: x0d line end LDR00180nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll about whales.^ 260 _bHoliday,_c1987.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a20571_cR_dALL^` MARC-Record-2.0.7/t/sample20.lif0000644000175100017510000001152713111151774014147 0ustar gmcgmcheader 20 rec MicroLIF file LDR00180nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll about whales.^ 260 _bHoliday,_c1987.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a20571_cR_dALL^` LDR00183nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll about where.^ 260 _bGreenwillow,_c1991.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a21379_cR_dALL^` LDR00218nam 22 2 4500^ 00520011119075709.0^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 4_aThe all around Cristmas.^ 260 _bRinehart & Winston,_c1982.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a30716_cR_dALL^` LDR00206nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll God's critters got a place in the choir.^ 260 _bDutton,_c1978.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a20516_cR_dALL^` LDR00173nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll I see.^ 260 _bOrchard,_c1988.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a20275_cR_dALL^` LDR00181nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll Joseph Wanted.^ 260 _bMacmillan,_c1991.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a536_cR_dALL^` LDR00215nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll night, all day :_ba child's first-- spirituals.^ 260 _bAtheneum,_c1991.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a25851_cR_dALL^` LDR00208nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll of our noses are here & other tales.^ 260 _bHarper & Row,_c1985.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a32095_cR_dALL^` LDR00190nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll the colors of the earth.^ 260 _bMorrow,_c1994.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a25510_cR_dALL^` LDR00184nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll-terrian bicyclaling.^ 260 _bHolt,_c1987.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a20911_cR_dALL^` LDR00170nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlligators.^ 260 _bAbdo,_c1994.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a1160_cR_dALL^` LDR00200nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlligators and others all year long!.^ 260 _bMaxwell,_c1993.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a25402_cR_dALL^` LDR01079pam 22 4a 4500^ 003IMchF^ 00519900517135337.0^ 008890912r1990 maua j 000 1 eng ^ 010 _a 89013282 /AC^ 020 _a0316034134 :_c$12.95^ 040 _aDLC_cDLC_dDLC_dICrlF^ 05000_aPZ7.A4277_bWh 1990^ 08200_a[Fic]_220^ 1001 _aAllen, Linda.^ 24010_aParrot in the house^ 24510_aWhen grandfather's parrot inherited Kennington Court /_cby Linda Allen ; illustrated by Katinka Kew.^ 250 _a1st U.S. ed.^ 260 _aBoston :_bJoy Street Books,_c1990.^ 300 _a68 p. :_bill. ;_c22 cm.^ 500 _aPreviously published under title: A parrot in the house.^ 500 _a"First published in the U.K. in 1988 by Hodder and Stoughton Ltd."--T.p. verso.^ 520 _aAppalled that Grandfather left his inheritance to his parrot, the relatives seek to break the will; but young Miranda, who is caring for the parrot, makes a discovery that settles everything.^ 650 1_aMystery and detective stories.^ 650 1_aParrots_xFiction.^ 650 7_aMystery and detective stories._2sears^ 650 7_aParrots_xFiction._2sears^ 651 1_aEngland_xFiction.^ 651 7_aEngland_xFiction._2sears^ 70011_aKew, Katinka,_eill.^ 900 _aALL^ 952 _a21117_cR_dALL^` LDR00178nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlmost good-bye.^ 260 _bDutton,_c1990.^ 300 _a[ ] p.^ 900 _aALM^ 952 _a21497_cR_dALM^` LDR00186nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlmost starring skinnybones.^ 260 _bKnopf,_c1988.^ 300 _a[ ] p.^ 900 _aALM^ 952 _a51_cR_dALM^` LDR00186nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlmost the real thing.^ 260 _bBradbury,_c1991.^ 300 _a[ ] p.^ 900 _aALM^ 952 _a21369_cR_dALM^` LDR00185nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlong came a dog.^ 260 _bHarper & Trophy,_c1958.^ 300 _a[ ] p.^ 900 _aALO^ 952 _a52_cR_dALO^` LDR00176nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlphabet city.^ 260 _bViking,_c1995.^ 300 _a[ ] p.^ 900 _aALP^ 952 _a25758_cR_dALP^` LDR00201nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAlzheimer's disease :_bsilent epidemic.^ 260 _bLerner,_c1985.^ 300 _a[ ] p.^ 900 _aALZ^ 952 _a32074_cR_dALZ^` LDR00191nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAmanda Pig and her big brother.^ 260 _bDial,_c1982.^ 300 _a[ ] p.^ 900 _aAMA^ 952 _a32294_cR_dAMA^` MARC-Record-2.0.7/t/80.alphatag.t0000644000175100017510000000567613111151774014234 0ustar gmcgmc#!perl -Tw use Test::More tests => 29; use strict; use File::Spec; BEGIN { use_ok( 'MARC::Record' ); use_ok( 'MARC::Field' ); use_ok( 'MARC::File' ); use_ok( 'MARC::File::USMARC' ); use_ok( 'MARC::File::MicroLIF' ); } ## According to the MARC spec tags can have alphanumeric ## characters in them. They are rarely seen, but they are ## allowed...and believe it or not some people actually use them! ## Tags must be alphanumeric, and three characters long. my $record = MARC::Record->new(); isa_ok( $record, "MARC::Record" ); my $field; ## this should fail since it is four chars long eval { $field = MARC::Field->new( '245A', '', '', 'a' => 'Test' ); }; ok( !defined $field ); like($@ ,qr/Tag "245A" is not a valid tag/, 'caught invalid tag "245A"' ); ## this should fail since it is a four digit number eval { $field = MARC::Field->new( '2456', '', '', 'a' => 'Test' ); }; ok( !defined $field ); like($@, qr/Tag "2456" is not a valid tag/, 'caught invalid tag "2456"' ); ## this should work be ok $field = MARC::Field->new( 'RAZ', '1', '2', 'a' => 'Test' ); isa_ok( $field, 'MARC::Field', 'field with alphanumeric tag' ); is ( $field->subfield('a'), 'Test', 'subfield()' ); my $n = $field->update( 'a' => '123' ); is( $n, 1 ); is( $field->subfield('a'), '123', 'update()' ); is_deeply( $field->subfields(), [ 'a' => 123 ], 'subfields()' ); is( $field->tag(), 'RAZ', 'tag()' ); is( $field->indicator(1), '1', 'indicator(1)' ); is( $field->indicator(2), '2', 'indicator(2)' ); $field->add_subfields( 'b' => 'Tweak' ); is( $field->subfield('b'), 'Tweak', 'add_subfields()' ); is( $field->as_string(), '123 Tweak', 'as_string()' ); my $text = "RAZ 12 _a123\n _bTweak"; is( $field->as_formatted(), $text, 'as_formatted()' ); ## make sure we can add a field with an alphanumeric tag to ## a MARC::Record object $record->append_fields( $field ); my $new = $record->field('RAZ'); isa_ok( $new, 'MARC::Field', 'able to grab field with alpha tag' ); $new = MARC::Field->new('100', '', '', 'a' => 'Gates, Bill'); $record->append_fields( $new ); $new = MARC::Field->new('110', '', '', 'a' => 'Microsoft'); $record->append_fields( $new ); my @fields = $record->field( '1..' ); is( scalar(@fields), 2, 'field(regex)' ); ## test output as USMARC my $marc = $record->as_usmarc(); my $filename = "$$.usmarc"; open(my $OUT, '>', $filename); print $OUT $record->as_usmarc(); close($OUT); my $file = MARC::File::USMARC->in( $filename ); isa_ok( $file, 'MARC::File::USMARC', "Opened $filename" ); my $newRec = $file->next(); isa_ok( $newRec, 'MARC::Record' ); is( $newRec->as_usmarc(), $marc, 'as_usmarc()' ); unlink( $filename ); ## test output as MicroLIF my $micro = $record->as_formatted(); my $lifname = File::Spec->catfile( 't', 'alphatag.lif' ); $file = MARC::File::MicroLIF->in( $lifname ); isa_ok( $file, 'MARC::File::MicroLIF' ); $newRec = $file->next(); isa_ok( $newRec, 'MARC::Record' ); is ($newRec->as_formatted(), $micro, 'as_formatted()' ); MARC-Record-2.0.7/t/82.baddir.t0000644000175100017510000000076313111151774013672 0ustar gmcgmc#!perl -Tw use strict; use Test::More tests => 4; use MARC::File::USMARC; use File::Spec; my $filename = File::Spec->catfile( 't', 'baddir.usmarc' ); my $file = MARC::File::USMARC->in( $filename ); isa_ok( $file, 'MARC::File::USMARC' ); my $r = $file->next(); isa_ok( $r, 'MARC::Record' ); my @warnings = $r->warnings(); is( $warnings[0], 'No directory found in record 1', 'got bad directory warning' ); is( $r->title(), 'Green Eggs and Ham', 'found title despite bad directory' ); MARC-Record-2.0.7/t/lineendings-0d0a.lif0000644000175100017510000000042613111151774015541 0ustar gmcgmcMicroLIF: x0dx0a line end LDR00180nam 22 2 4500^ 008891207s19xx xxu 00010 eng d^ 040 _cIMchF^ 245 0_aAll about whales.^ 260 _bHoliday,_c1987.^ 300 _a[ ] p.^ 900 _aALL^ 952 _a20571_cR_dALL^` MARC-Record-2.0.7/t/file-header.t0000644000175100017510000000141313111151774014353 0ustar gmcgmc#!perl -Tw use strict; use integer; use Test::More tests=>5; use File::Spec; BEGIN { use_ok( 'MARC::File::MicroLIF' ); } MISSINGHEADER: { my $filename = File::Spec->catfile( 't', 'sample1.lif' ); my $file = MARC::File::MicroLIF->in( $filename ); isa_ok( $file, 'MARC::File::MicroLIF', 'got a MicroLIF file' ); ok( !$file->header(), 'file contains no header' ); $file->close(); } MISSINGHEADER: { my $filename = File::Spec->catfile( 't', 'sample20.lif' ); my $file = MARC::File::MicroLIF->in( $filename ); isa_ok( $file, 'MARC::File::MicroLIF', 'got a MicroLIF file' ); is( $file->header(), 'header 20 rec MicroLIF file ', 'file header correct' ); $file->close(); } MARC-Record-2.0.7/t/50.batch.t0000644000175100017510000000210513111151774013511 0ustar gmcgmc#!perl -Tw use strict; use integer; use File::Spec; use Test::More tests=>267; BEGIN: { use_ok( 'MARC::Batch' ); } # Test the USMARC stuff USMARC: { my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $batch = new MARC::Batch( 'USMARC', $filename ); isa_ok( $batch, 'MARC::Batch', 'MARC batch' ); my $n = 0; while ( my $marc = $batch->next() ) { isa_ok( $marc, 'MARC::Record' ); my $f245 = $marc->field( '245' ); isa_ok( $f245, 'MARC::Field' ); ++$n; } is( $n, 10, 'Got 10 USMARC records' ); } # Test MicroLIF batch MicroLIF: { my @files = ( File::Spec->catfile( 't', 'sample1.lif' ), File::Spec->catfile( 't', 'sample20.lif' ), File::Spec->catfile( 't', 'sample100.lif' ) ); my $batch = new MARC::Batch( 'MicroLIF', @files ); isa_ok( $batch, 'MARC::Batch', 'MicroLIF batch' ); my $n = 0; while ( my $marc = $batch->next() ) { isa_ok( $marc, 'MARC::Record' ); my $f245 = $marc->field( '245' ); isa_ok( $f245, 'MARC::Field' ); ++$n; } is( $n, 121, 'Got 120 LIF records' ); } MARC-Record-2.0.7/t/extra_controlfields.t0000644000175100017510000000326513111151774016267 0ustar gmcgmcuse strict; use warnings; use Test::More tests => 31; use MARC::Field; # Test is_controlfield_tag foreach my $i (1..9) { my $field = MARC::Field->new('00' . $i, 'TestData $i'); ok($field->is_control_field, "$i identified as control field"); } # Should not be control fields foreach my $i (qw(010 011 555 FMT)) { my $field = MARC::Field->new($i, 0, 0, 'a', 'Hello'); ok(!$field->is_control_field, "Non-control showing up as such for $i"); } # Add the FMT MARC::Field->allow_controlfield_tags('FMT'); foreach my $i (qw(001 002 003 004 005 FMT)) { my $field = MARC::Field->new( $i, "TestData $i"); ok($field->is_control_field, "$i correctly identified as control field"); is($field->data, "TestData $i", "Got it back out"); } # Take it out again MARC::Field->disallow_controlfield_tags('FMT'); foreach my $i ('FMT') { my $field = MARC::Field->new( $i, 0, 0, 'a', 'Test'); ok(!$field->is_control_field, "$i identified as data field"); is($field->subfield('a'), 'Test', "Got it back out"); } # Add the FMT MARC::Field->allow_controlfield_tags('FMT'); # See if it throws an error trying to make a datafield out of a control field foreach my $i ('FMT', '001') { my $field = MARC::Field->new( $i, 0, 0, 'a', 'Test'); like(join(' ', $field->warnings), qr/too much data/i, "Caught error trying to make datafield out of controlfield '$i'"); }; # Take it out again MARC::Field->disallow_controlfield_tags('*'); # See if it throws an error trying to make a control field out of a data field foreach my $i ('FMT', '010') { eval { my $field = MARC::Field->new($i, 'Test'); }; like($@, qr/must have indicators/, "Correctly got error trying to make control field out of '$i'"); } MARC-Record-2.0.7/t/61.replace.t0000644000175100017510000000146613111151774014056 0ustar gmcgmc#!perl -Tw use strict; use integer; use Test::More tests=>8; use File::Spec; BEGIN { use_ok( 'MARC::File::USMARC' ); use_ok( 'MARC::Field' ); } my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $file = MARC::File::USMARC->in( $filename ); isa_ok( $file, 'MARC::File', 'MARC input file' ) or die; my $marc = $file->next(); isa_ok( $marc, 'MARC::Record', 'Read from file' ); $file->close; my $cur_245 = $marc->field('245'); isa_ok( $cur_245, 'MARC::Field' ); my $new_245 = MARC::Field->new( '245','0','0', a => 'Programming Python /', c => 'Mark Lutz' ); isa_ok( $new_245, 'MARC::Field' ); $cur_245->replace_with($new_245); my $latest_245 = $marc->field('245'); isa_ok( $latest_245, 'MARC::Field' ); is( $latest_245->as_string() => 'Programming Python / Mark Lutz', 'Replaced a field'); MARC-Record-2.0.7/t/filler.usmarc0000644000175100017510000000374213111151774014521 0ustar gmcgmc00755cam 22002414a 4500001001300000003000600013005001700019008004100036010001700077020004300094040001800137042000800155050002600163082001700189100003100206245005400237260004200291300007200333500003300405650003700438630002500475630001300500fol05731351 IMchF20000613133448.0000107s2000 nyua 001 0 eng  a 00020737  a0471383147 (paper/cd-rom : alk. paper) aDLCcDLCdDLC apcc00aQA76.73.P22bM33 200000a005.13/32211 aMartinsson, Tobias,d1976-10aActivePerl with ASP and ADO /cTobias Martinsson. aNew York :bJohn Wiley & Sons,c2000. axxi, 289 p. :bill. ;c23 cm. +e1 computer laser disc (4 3/4 in.) a"Wiley Computer Publishing." 0aPerl (Computer program language)00aActive server pages.00aActiveX. 00647pam 2200241 a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001800109042000800127050002600135082001500161100002600176245006700202260003800269263000900307300001100316650003700327650002500364700001600389fol05754809 IMchF20000601115601.0000203s2000 mau 001 0 eng  a 00022023  a1565926994 aDLCcDLCdDLC apcc00aQA76.73.P22bD47 200000a005.742211 aDescartes, Alligator.10aProgramming the Perl DBI /cAlligator Descartes and Tim Bunce. aCmabridge, MA :bO'Reilly,c2000. a1111 ap. cm. 0aPerl (Computer program language) 0aDatabase management.1 aBunce, Tim.00605cam 22002054a 4500001001300000003000600013005001700019008004100036010001700077040001800094042000800112050002700120082001700147100002100164245005500185260004500240300002600285504005100311650003700362fol05843555 IMchF20000525142739.0000318s1999 cau b 001 0 eng  a 00501349  aDLCcDLCdDLC apcc00aQA76.73.P22bB763 199900a005.13/32211 aBrown, Martin C.10aPerl :bprogrammer's reference /cMartin C. Brown. aBerkeley :bOsborne/McGraw-Hill,cc1999. axix, 380 p. ;c22 cm. aIncludes bibliographical references and index. 0aPerl (Computer program language) MARC-Record-2.0.7/t/dosEOF.t0000644000175100017510000000570113111151774013331 0ustar gmcgmc#!perl -Tw =head2 NAME DOS EOF test -- tests modification to MARC::File::USMARC to remove/ignore \x1a from MARC files. =head2 DESCRIPTION Checks t/sample1eof.usmarc and cameleof.usmarc, which are just sample1.usmarc with \x1a added as a final character, and cameleof.usmarc with \x1a added between some records. Prior to the change, MARC::File::USMARC should report 1..12 ok 1 - use MARC::File::USMARC; ok 2 - Test record 1 in file sample1eof.usmarc not ok 3 - Test record 2 in file sample1eof.usmarc # Failed test ([path_to_test_file] at line 58) # got: 'Record length "\x1a" is not numeric in record 2' # expected: undef ok 4 - Test record 1 in file cameleof.usmarc not ok 5 - Test record 2 in file cameleof.usmarc # Failed test ([path_to_test_file] at line 58) # got: 'Record length "\x1a0064" is not numeric in record 2' # expected: undef ok 6 - Test record 3 in file cameleof.usmarc ok 7 - Test record 4 in file cameleof.usmarc not ok 8 - Test record 5 in file cameleof.usmarc # Failed test ([path_to_test_file] at line 58) # got: 'Record length "\x1a0080" is not numeric in record 5' # expected: undef ok 9 - Test record 6 in file cameleof.usmarc ok 10 - Test record 7 in file cameleof.usmarc not ok 11 - Test record 8 in file cameleof.usmarc # Failed test ([path_to_test_file] at line 58) # got: 'Record length "\x1a0066" is not numeric in record 8' # expected: undef ok 12 - Test record 9 in file cameleof.usmarc ok 13 - Test record 10 in file cameleof.usmarc # Looks like you planned 12 tests but ran 1 extra. In the output above, I changed the EOF character to \x1a to prevent possible problems a real EOF may have caused. [path_to_test_file] will be dosEOF.t plus the path to the test file. The revised version should report: 1..12 ok 1 - use MARC::File::USMARC; ok 2 - Test record 1 in file sample1eof.usmarc ok 3 - Test record 1 in file cameleof.usmarc ok 4 - Test record 2 in file cameleof.usmarc ok 5 - Test record 3 in file cameleof.usmarc ok 6 - Test record 4 in file cameleof.usmarc ok 7 - Test record 5 in file cameleof.usmarc ok 8 - Test record 6 in file cameleof.usmarc ok 9 - Test record 7 in file cameleof.usmarc ok 10 - Test record 8 in file cameleof.usmarc ok 11 - Test record 9 in file cameleof.usmarc ok 12 - Test record 10 in file cameleof.usmarc =cut use strict; use File::Spec; use Test::More tests=>12; BEGIN {use_ok( 'MARC::File::USMARC' );} my @expected = (undef)x11; foreach my $file ( 'sample1eof.usmarc', 'cameleof.usmarc' ) { my $filename = File::Spec->catfile( 't', $file ); my $marcfile = MARC::File::USMARC->in( $filename ) or die "Can not open file $filename, $!"; my $reccount = 0; while ( my $marc = $marcfile->next() ) { $reccount++; my @warnings = $marc->warnings(); my $expected = shift @expected; my $warns = shift @warnings; is($warns, $expected, "Test record $reccount in file $file"); } #while } #foreach file MARC-Record-2.0.7/t/63.after.t0000644000175100017510000000304013111151774013534 0ustar gmcgmc#!perl -Tw use strict; use integer; use Test::More tests=>8; use File::Spec; BEGIN { use_ok( 'MARC::Batch' ); use_ok( 'MARC::Field' ); } my $filename = File::Spec->catfile( 't', 'camel.usmarc' ); my $batch = new MARC::Batch( 'MARC::File::USMARC', $filename ); isa_ok( $batch, 'MARC::Batch', 'Batch object creation' ); my $record = $batch->next(); isa_ok( $record, 'MARC::Record', 'Record object creation' ); my $f650 = $record->field('650'); isa_ok( $f650, 'MARC::Field', 'Field retrieval'); my $new = MARC::Field->new('650','','0','a','World Wide Web.'); isa_ok( $new, 'MARC::Field', 'Field creation'); my $nadds = $record->insert_fields_after($f650,$new); is( $nadds, 1 ); my $expected = <as_formatted,$expected,'insert_fields_after'); MARC-Record-2.0.7/t/sample1eof.usmarc0000644000175100017510000000036113111151774015272 0ustar gmcgmc00240nam 22001092 4500008004100000040001000041245002200051260002000073300001100093900000800104952001800112891207s19xx xxu 00010 eng d cIMchF 0aAll about whales. bHoliday,c1987. a[ ] p. aALL a20571cRdALLMARC-Record-2.0.7/lib/0000755000175100017510000000000013111154233012316 5ustar gmcgmcMARC-Record-2.0.7/lib/MARC/0000755000175100017510000000000013111154233013040 5ustar gmcgmcMARC-Record-2.0.7/lib/MARC/File.pm0000644000175100017510000001132713111151774014270 0ustar gmcgmcpackage MARC::File; =head1 NAME MARC::File - Base class for files of MARC records =cut use strict; use warnings; use integer; use vars qw( $ERROR ); =head1 SYNOPSIS use MARC::File::USMARC; # If you have weird control fields... use MARC::Field; MARC::Field->allow_controlfield_tags('FMT', 'LDX'); my $file = MARC::File::USMARC->in( $filename ); while ( my $marc = $file->next() ) { # Do something } $file->close(); undef $file; =head1 EXPORT None. =head1 METHODS =head2 in() Opens a file for import. Ordinarily you will use C or C to do this. my $file = MARC::File::USMARC->in( 'file.marc' ); Returns a C object, or C on failure. If you encountered an error the error message will be stored in C<$MARC::File::ERROR>. Optionally you can also pass in a filehandle, and C. will "do the right thing". my $handle = IO::File->new( 'gunzip -c file.marc.gz |' ); my $file = MARC::File::USMARC->in( $handle ); =cut sub in { my $class = shift; my $arg = shift; my ( $filename, $fh ); ## if a valid filehandle was passed in my $ishandle = do { no strict; defined fileno($arg); }; if ( $ishandle ) { $filename = scalar( $arg ); $fh = $arg; } ## otherwise check if it's a filename, and ## return undef if we weren't able to open it else { $filename = $arg; $fh = eval { local *FH; open( FH, '<', $arg ) or die; *FH{IO}; }; if ( $@ ) { $MARC::File::ERROR = "Couldn't open $filename: $@"; return; } } my $self = { filename => $filename, fh => $fh, recnum => 0, warnings => [], }; return( bless $self, $class ); } # new() sub out { die "Not yet written"; } =head2 next( [\&filter_func] ) Reads the next record from the file handle passed in. The C<$filter_func> is a reference to a filtering function. Currently, only USMARC records support this. See L's C function for details. Returns a MARC::Record reference, or C on error. =cut sub next { my $self = shift; $self->{recnum}++; my $rec = $self->_next() or return; return $self->decode($rec, @_); } =head2 skip() Skips over the next record in the file. Same as C, without the overhead of parsing a record you're going to throw away anyway. Returns 1 or undef. =cut sub skip { my $self = shift; my $rec = $self->_next() or return; return 1; } =head2 warnings() Simlilar to the methods in L and L, C will return any warnings that have accumulated while processing this file; and as a side-effect will clear the warnings buffer. =cut sub warnings { my $self = shift; my @warnings = @{ $self->{warnings} }; $self->{warnings} = []; return(@warnings); } =head2 close() Closes the file, both from the object's point of view, and the actual file. =cut sub close { my $self = shift; close( $self->{fh} ); delete $self->{fh}; delete $self->{filename}; return; } sub _unimplemented { my $self = shift; my $method = shift; warn "Method $method must be overridden"; } =head2 write() Writes a record to the output file. This method must be overridden in your subclass. =head2 decode() Decodes a record into a USMARC format. This method must be overridden in your subclass. =cut sub write { $_[0]->_unimplemented("write"); } sub decode { $_[0]->_unimplemented("decode"); } # NOTE: _warn must be called as an object method sub _warn { my ($self,$warning) = @_; push( @{ $self->{warnings} }, "$warning in record ".$self->{recnum} ); return( $self ); } # NOTE: _gripe can be called as an object method, or not. Your choice. # NOTE: it's use is now deprecated use _warn instead sub _gripe { my @parms = @_; if ( @parms ) { my $self = shift @parms; if ( ref($self) =~ /^MARC::File/ ) { push( @parms, " at byte ", tell($self->{fh}) ) if $self->{fh}; push( @parms, " in file ", $self->{filename} ) if $self->{filename}; } else { unshift( @parms, $self ); } $ERROR = join( "", @parms ); warn $ERROR; } return; } 1; __END__ =head1 RELATED MODULES L =head1 TODO =over 4 =item * C method We only handle files for input right now. =back =cut =head1 LICENSE This code may be distributed under the same terms as Perl itself. Please note that these modules are not products of or supported by the employers of the various contributors to the code. =head1 AUTHOR Andy Lester, C<< >> =cut MARC-Record-2.0.7/lib/MARC/Doc/0000755000175100017510000000000013111154233013545 5ustar gmcgmcMARC-Record-2.0.7/lib/MARC/Doc/Tutorial.pod0000644000175100017510000013771113111153773016076 0ustar gmcgmc=head1 NAME MARC::Doc::Tutorial - A documentation-only module for new users of MARC::Record =head1 SYNOPSIS perldoc MARC::Doc::Tutorial =head1 INTRODUCTION =head2 What is MARC? The MAchine Readable Cataloging format was designed by the Library of Congress in the late 1960s in order to allow libraries to convert their card catalogs into a digital format. The advantages of having computerized card catalogs were soon realized, and now MARC is being used by all sorts of libraries around the world to provide computerized access to their collections. MARC data in transmission format is optimized for processing by computers, so it's not very readable for the normal human. For more about the MARC format, visit the Library of Congress at http://www.loc.gov/marc/ =head2 What is this Tutorial? The document you are reading is a beginners guide to using Perl to processing MARC data, written in the 'cookbook' style. Inside, you will find recipes on how to read, write, update and convert MARC data using the MARC::Record CPAN package. As with any cookbook, you should feel free to dip in at any section and use the recipe you find interesting. If you are new to Perl, you may want to read from the beginning. The document you are reading is distributed with the MARC::Record package, however in case you are reading it somewhere else, you can find the latest version at CPAN: http://www.cpan.org/modules/by-module/MARC/. You'll notice that some sections aren't filled in yet, which is a result of this document being a work in progress. If you have ideas for new sections please make a suggestion to perl4lib: https://perl4lib.perl.org/. =head2 History of MARC on CPAN In 1999, a group of developers began working on MARC.pm to provide a Perl module for working with MARC data. MARC.pm was quite successful since it grew to include many new options that were requested by the Perl/library community. However, in adding these features the module swiftly outgrew its own clothes, and maintenance and addition of new features became extremely difficult. In addition, as libraries began using MARC.pm to process large MARC data files (>1000 records) they noticed that memory consumption would skyrocket. Memory consumption became an issue for large batches of records because MARC.pm's object model was based on the 'batch' rather than the record... so each record in the file would often be read into memory. There were ways of getting around this, but they were not obvious. Some effort was made to reconcile the two approaches (batch and record), but with limited success. In mid 2001, Andy Lester released MARC::Record and MARC::Field which provided a much simpler and maintainable package for processing MARC data with Perl. As its name suggests, MARC::Record treats an individual MARC record as the primary Perl object, rather than having the object represent a given set of records. Instead of forking the two projects, the developers agreed to encourage use of the MARC::Record framework, and to work on enhancing MARC::Record rather than extending MARC.pm further. Soon afterwards, MARC::Batch was added, which allows you to read in a large data file without having to worry about memory consumption. In Dec., 2004, the MARC::Lint module, an extension to check the validity of MARC records, was removed from the MARC::Record distribution, to become a separately distributed package. This tutorial contains examples for using MARC::Lint. =head2 Brief Overview of MARC Classes The MARC::Record package is made up of several separate packages. This can be somewhat confusing to people new to Perl, or Object Oriented Programming. However this framework allows easy extension, and is built to support new input/output formats as their need arises. For a good introduction to using the object oriented features of Perl, see the perlboot documentation that came with your version of Perl. Here are the packages that get installed with MARC::Record: =over 4 =item MARC::Batch A convenience class for accessing MARC data contained in an external file. =item MARC::Field An object for representing the indicators and subfields of a single MARC field. =item MARC::Record This primary class represents a MARC record, being a container for multiple MARC::Field objects. =item MARC::Doc::Tutorial This document! =item MARC::File A superclass for representing files of MARC data. =item MARC::File::MicroLIF A subclass of MARC::File for working with data encoded in the MicroLIF format. =item MARC::File::USMARC A subclass of MARC::File for working with data encoded in the USMARC format. =back =head2 Help Wanted! It's already been mentioned but it's worth mentioning again: MARC::Doc::Tutorial is a work in progress, and you are encouraged to submit any suggestions for additional recipes via the perl4lib mailing list at https://perl4lib.perl.org/. Also, patches and issue reports are welcome at https://github.com/perl4lib/marc-perl. =head1 READING =head2 Reading a record from a file Let's say you have a USMARC record in 'file.dat' and you'd like to read in the record and print out its title. 1 ## Example R1 2 3 ## create a MARC::Batch object. 4 use MARC::Batch; 5 my $batch = MARC::Batch->new('USMARC', 'file.dat'); 6 7 ## get a MARC record from the MARC::Batch object. 8 ## the $record will be a MARC::Record object. 9 my $record = $batch->next(); 10 11 ## print the title contained in the record. 12 print $record->title(),"\n"; Using the distribution's 't/camel.usmarc', your result should be: ActivePerl with ASP and ADO / Tobias Martinsson. =head2 Iterating through a batch file Now imagine that 'file.dat' actually contains multiple records and we want to print the title for each of them. Our program doesn't have to change very much at all: we just need to add a loop around our call to C. 1 ## Example R2 2 3 ## create a MARC::Batch object. 4 use MARC::Batch; 5 my $batch = MARC::Batch->new('USMARC','file.dat'); 6 7 while (my $record = $batch->next()) { 8 9 ## print the title contained in the record. 10 print $record->title(),"\n"; 11 12 } The call to the C method at line 7 returns the next record from the file. C returns C when there are no more records left in the file, which causes the C loop to end. This is a useful idiom for reading in all the records in a file. Your results with 'camel.usmarc' should be: ActivePerl with ASP and ADO / Tobias Martinsson. Programming the Perl DBI / Alligator Descartes and Tim Bunce. . . . Cross-platform Perl / Eric F. Johnson. =head2 Checking for errors It is a good idea to get in the habit of checking for errors. MARC/Perl has been designed to help you do this. Calls to C when iterating through a batch file will return C when there are no more records to return... B when an error was encountered (see the next recipe to subvert this). You probably want to make sure that you didn't abruptly stop reading a batch file because of an error. 1 ## Example R3 2 3 ## create a MARC::Batch object. 4 use MARC::Batch; 5 my $batch = MARC::Batch->new('USMARC','file.dat'); 6 7 ## get a marc record from the MARC::Batch object. 8 ## $record will be a MARC::Record object. 9 while ( my $record = $batch->next() ) { 10 print $record->title(),"\n"; 11 } 12 13 ## make sure there weren't any problems. 14 if ( my @warnings = $batch->warnings() ) { 15 print "\nWarnings were detected!\n", @warnings; 16 } The call to C at line 14 will retrieve any warning messages and store them in C<@warnings>. This allows you to detect when C has aborted prematurely (before the end of the file has been reached). When a warning is detected, an explanation is sent to C. By introducing an error into 'camel.usmarc', we'll receive the following output to C: Warnings were detected! Invalid indicators "a0" forced to blanks in record 1 for tag 245 =head2 Recovering from errors You may want to keep reading a batch file even after an error has been encountered. If so, you will want to turn strict mode off using the C method. You can also prevent warnings from being printed to C using the C method. By default, strict is on as a safety precaution to prevent you from using corrupt MARC data. Once off, you can turn both strict and warnings back on again with the C and C methods. 1 ## Example R4 2 3 use MARC::Batch; 4 my $batch = MARC::Batch->new('USMARC', 'file.dat'); 5 $batch->strict_off(); 6 7 while ( my $record = $batch->next() ) { 8 print $record->title(),"\n"; 9 } 10 11 ## make sure there weren't any problems. 12 if ( my @warnings = $batch->warnings() ) { 13 print "\nWarnings were detected!\n", @warnings; 14 } Introducing a second error to the 'camel.usmarc' file gives the following: ActivePerl with ASP and ADO / Tobias Martinsson. Programming the Perl DBI / Alligator Descartes and Tim Bunce. . . . Cross-platform Perl / Eric F. Johnson. Warnings were detected! Invalid indicators "a0" forced to blanks in record 1 for tag 245 Invalid indicators "a0" forced to blanks in record 5 for tag 245 =head2 Looking at a field Our previous examples use MARC::Record's C method to easily access the 245 field, but you will probably want programs that access lots of other MARC fields. MARC::Record's C method gives you complete access to the data found in any MARC field. The C method returns a MARC::Field object which can be used to access the data, indicators, and even the individual subfields. Our next example shows how this is done. 1 ## Example R5 2 3 ## open a file. 4 use MARC::Batch; 5 my $batch = MARC::Batch->new('USMARC','file.dat'); 6 7 ## read a record. 8 my $record = $batch->next(); 9 10 ## get the 100 field as a MARC::Field object. 11 my $field = $record->field('100'); 12 print "The 100 field contains: ",$field->as_string(),"\n"; 13 print "The 1st indicator is ",$field->indicator(1),"\n"; 14 print "The 2nd indicator is ",$field->indicator(2),"\n"; 15 print "Subfield d contains: ",$field->subfield('d'),"\n"; Which results in something like: The 100 field contains: Martinsson, Tobias, 1976- The 1st indicator is 1 The 2nd indicator is Subfield d contains: 1976- As before, use a C loop to iterate through all the records in a batch. =head2 Looking at repeatable fields So how do you retrieve data from repeatable fields? The C method can help you with this as well. In our previous example's line 11, the C method was used in a I context, since the result was being assigned to the variable C<$field>. However in a I context, C will return all the fields in the record of that particular type. For example: 1 ## Example R6 2 3 use MARC::Batch; 4 my $batch = MARC::Batch->new('USMARC','file.dat'); 5 my $record = $batch->next(); 6 7 ## get all the 650 fields (list context). 8 my @fields = $record->field('650'); 9 10 ## examine each 650 field and print it out. 11 foreach my $field (@fields) { 12 print $field->as_string(),"\n"; 13 } Which prints out the following for the first record of 't/camel.usmarc': Active server pages. ActiveX. =head2 Looking at a set of related fields C also allows you to retrieve similar fields using '.' as a wildcard. 1 ## Example R7 2 3 use MARC::Batch; 4 my $batch = MARC::Batch->new('USMARC','file.dat'); 5 my $record = $batch->next(); 6 7 # retrieve all title fields in one shot. 8 foreach my $field ($record->field('2..')) { 9 print $field->tag(),' contains ',$field->as_string(),"\n"; 10 } Notice the shorthand in line 8 which compacts lines 7-13 of our previous example. Instead of storing the fields in an array, the C still returns a list in the C loop. Line 9 uses the C method which returns the tag number for a particular MARC field, which is useful when you aren't certain what tag you are currently dealing with. Sample output from this recipe: 245 contains ActivePerl with ASP and ADO / Tobias Martinsson. 260 contains New York : John Wiley & Sons, 2000. You can also return all tags for a specific record by using '...' in C (though, see the next recipe). =head2 Looking at all the fields in a record The last example in this section illustrates how to retrieve I the fields in a record using the C method. This method is similar to passing '...' as a wildcard (see our previous recipe for alternative access). 1 ## Example R8 2 3 use MARC::Batch; 4 my $file = MARC::Batch->new('USMARC','file.dat'); 5 my $record = $batch->next(); 6 7 ## get all of the fields using the fields() method. 8 my @fields = $record->fields(); 9 10 ## print out the tag, the indicators and the field contents. 11 foreach my $field (@fields) { 12 print 13 $field->tag(), " ", 14 defined $field->indicator(1) ? $field->indicator(1) : "", 15 defined $field->indicator(2) ? $field->indicator(2) : "", 16 " ", $field->as_string, " \n"; 17 } The above code would print the following for the first record of 't/camel.usmarc': 001 fol05731351 003 IMchF . . . 300 xxi, 289 p. : ill. ; 23 cm. + 1 computer laser disc (4 3/4 in.) 500 "Wiley Computer Publishing." 650 0 Perl (Computer program language) 630 00 Active server pages. 630 00 ActiveX. =head1 CREATING The examples in the Section 1 covered how to read in existing USMARC data in a file. Section 2 will show you how to create a MARC record from scratch. The techniques in this section would allow you to write programs which create MARC records that could then be loaded into an online catalog, or sent to a third party. =head2 Creating a record To create a new MARC record, you'll need to first create a MARC::Record object, add a leader (though MARC::Record can create leaders automatically if you don't specifically define one), and then create and add MARC::Field objects to your MARC::Record object. For example: 1 ## Example C1 2 3 ## create a MARC::Record object. 4 use MARC::Record; 5 my $record = MARC::Record->new(); 6 7 ## add the leader to the record. optional. 8 $record->leader('00903pam 2200265 a 4500'); 9 10 ## create an author field. 11 my $author = MARC::Field->new( 12 '100',1,'', 13 a => 'Logan, Robert K.', 14 d => '1939-' 15 ); 16 $record->append_fields($author); 17 18 ## create a title field. 19 my $title = MARC::Field->new( 20 '245','1','4', 21 a => 'The alphabet effect /', 22 c => 'Robert K. Logan.' 23 ); 24 $record->append_fields($title); The key to creating records from scratch is to use C, which adds a field to the end of the record. Since each field gets added at the end, it's up to you to order the fields the way you want. C and C are similar methods that allow you to define where the field gets added. These methods are covered in more detail below. =head1 WRITING Sections 1 and 2 showed how to read and create USMARC data. Once you know how to read and create, it becomes important to know how to write the USMARC data to disk in order to save your work. In these examples, we will create a new record and save it to a file called 'record.dat'. =head2 Writing records to a file 1 ## Example W1 2 3 ## create a MARC::Record object. 4 use MARC::Record; 5 my $record = MARC::Record->new(); 6 7 ## add the leader to the record. optional. 8 $record->leader('00903pam 2200265 a 4500'); 9 10 ## create an author field. 11 my $author = MARC::Field->new( 12 '100',1,'', 13 a => 'Logan, Robert K.', 14 d => '1939-' 15 ); 16 17 ## create a title field. 18 my $title = MARC::Field->new( 19 '245','1','4', 20 a => 'The alphabet effect /', 21 c => 'Robert K. Logan.' 22 ); 23 24 $record->append_fields($author, $title); 25 26 ## open a filehandle to write to 'record.dat'. 27 open(OUTPUT, '> record.dat') or die $!; 28 print OUTPUT $record->as_usmarc(); 29 close(OUTPUT); The C method call at line 28 returns a scalar value which is the raw USMARC data for C<$record>. The raw data is then promptly printed to the C file handle. If you want to output multiple records to a file, simply repeat the process at line 28 for the additional records. Also of note is the C method: unlike recipe C1 which called the method once for each field added, this recipe demonstrates that C can accept multiple arguments. Note to the curious: the C method is actually an alias to the MARC::File::USMARC C method. Having separate C methods is a design feature of the MARC class hierarchy, since it allows extensions to be built that translate MARC::Record objects into different data formats. =head2 Debugging with C Since raw USMARC data isn't very easy for humans to read, it is often useful to be able to see the contents of your MARC::Record object represented in a 'pretty' way for debugging purposes. If you have a MARC::Record object you'd like to pretty-print, use the C method. 1 ## Example W2 2 3 ## create a MARC::Record object. 4 use MARC::Record; 5 my $record = MARC::Record->new(); 6 7 $record->leader('00903pam 2200265 a 4500'); 8 9 $record->append_fields( 10 MARC::Field->new('100','1','', a=>'Logan, Robert K.', d=>'1939-'), 11 MARC::Field->new('245','1','4', a=>'The alphabet effect /', c=>'Robert K. Logan.') 12 ); 13 14 ## pretty print the record. 15 print $record->as_formatted(), "\n"; This code will pretty print the contents of the newly created record: LDR 00903pam 2200265 a 4500 100 1 _aLogan, Robert K. _d1939- 245 14 _aThe alphabet effect / _cRobert K. Logan. Notice on lines 9-12 how you can add a list of new fields by creating MARC::Field objects within a call to C. This is yet another shorthand method to those shown in recipes C1 and W1. For more pretty-printing capabilities, try C in our next recipe. =head2 Debugging with marcdump() If you have written USMARC data to a file (as in recipe W2) and you would like to verify that the data is stored correctly you can use the C command line utility that was installed with the MARC::Record package: % marcdump record.dat record.dat LDR 00122pam 2200049 a 4500 100 1 _aLogan, Robert K. _d1939- 245 14 _aThe alphabet effect / _cRobert K. Logan. Recs Errs Filename ----- ----- -------- 1 0 record.dat As you can see, this command results in the record being pretty printed to your screen (C) similarly to the C method from recipe W2. It is useful for verifying your USMARC data after it has been stored on disk. More details about debugging are found later in VALIDATING. =head1 UPDATING Now that you know how to read, write and create MARC data, you have the tools you need to update or edit exiting MARC data. Updating MARC data is a common task for library catalogers. Sometimes there are huge amounts of records that need to be touched up... and while the touch ups are very detail oriented, they are also highly repetitive. Luckily, computers are tireless, and not very prone to error (assuming the programmer isn't). When libraries receive large batches of MARC records for electronic text collections such as NetLibrary, Making of America, or microfiche sets like Early American Imprints, the records are often loaded into an online system and then the system is used to update the records. Unfortunately, not all these systems are created equal, and catalogers have to spend a great deal of time touching up each individual record. An alternative would be to process the records prior to import and then, once in the system, the records would not need editing. This scenario would save a great deal of time for the cataloger who would be liberated to spend their time doing original cataloging... which computers are notably bad at! =head2 Adding a field Imagine a batch of records in 'file.dat' that you'd like to add local notes (590) to, then saving your changes: 1 ## Example U1 2 3 ## create our MARC::Batch object. 4 use MARC::Batch; 5 my $batch = MARC::Batch->new('USMARC','file.dat'); 6 7 ## open a file handle to write to. 8 open(OUT,'>new.dat') or die $!; 9 10 ## read each record, modify, then print. 11 while ( my $record = $batch->next() ) { 12 13 ## add a 590 field. 14 $record->append_fields( 15 MARC::Field->new('590','','',a=>'Access provided by Enron.') 16 ); 17 18 print OUT $record->as_usmarc(); 19 20 } 21 22 close(OUT); =head2 Preserving field order As its name suggests, C will add the 590 field in recipe U1 to the end of the record. If you want to preserve a particular order, you can use the C and C methods. In order to use these, you need to locate the field you want to insert before or after. Here is an example (C works similarly): 1 ## Example U2 2 3 use MARC::Batch; 4 my $batch = MARC::Batch->new('USMARC','file.dat'); 5 open(OUT,'>new.dat') or die $!; 6 7 ## read in each record. 8 while ( my $record = $batch->next() ) { 9 10 ## find the tag after 590. 11 my $before; 12 foreach ($record->fields()) { 13 $before = $_; 14 last if $_->tag() > 590; 15 } 16 17 ## create the 590 field. 18 my $new = MARC::Field->new('590','','',a=>'Access provided by Enron.'); 19 20 ## insert our 590 field after the $before. 21 $record->insert_fields_before($before,$new); 22 23 ## and print out the new record. 24 print OUT $record->as_usmarc(); 25 26 } =head2 Deleting a field You can also delete fields that you don't want. But you will probably want to check that the field contains what you expect before deleting it. Let's say Enron has gone out of business and the 590 field needs to be deleted: 1 ## Example U3 2 3 use MARC::Batch; 4 my $batch = MARC::Batch->new('USMARC','new.dat'); 5 open(OUT,'>newer.dat') or die $1; 6 7 while ( my $record = $batch->next() ) { 8 9 ## get the 590 record. 10 my $field = $record->field('590'); 11 12 ## if there is a 590 AND it has the word "Enron"... 13 if ($field and $field->as_string() =~ /Enron/i) { 14 15 ## delete it! 16 $record->delete_field($field); 17 18 } 19 20 ## output possibly modified record. 21 print OUT $record->as_usmarc(); 22 23 } The 590 field is retrieved on line 10, but notice how we check that we actually received a valid C<$field>, and that it then contains the word 'Enron' before we delete it. You need to pass C a MARC::Field object that can be retrieved with the C method. =head2 Changing existing fields Perhaps rather than adding or deleting a field, you need to modify an existing field. This is achieved in several steps: first, read in the MARC record you want to update, and then the field you're interested in. From there, call the field's C or C methods to modify its contents, and then resave the record. Below is an example of updating existing 590 field's containing the word 'Enron' to indicate that access is now provided through Arthur Andersen: 1 ## Example U4 2 3 use MARC::Batch; 4 my $batch = MARC::Batch->new('USMARC','new.dat'); 5 open(OUT,'>newer.dat') or die $1; 6 7 while ( my $record = $batch->next() ) { 8 9 ## look for a 590 containing "Enron"... 10 my $field = $record->field('590'); 11 if ($field and $field->as_string =~ /Enron/i) { 12 13 ## create a new 590 field. 14 my $new_field = MARC::Field->new( 15 '590','','', a => 'Access provided by Arthur Andersen.' ); 16 17 ## replace existing with our new one. 18 $field->replace_with($new_field); 19 20 } 21 22 ## output possibly modified record. 23 print OUT $record->as_usmarc(); 24 25 } In this example, we used MARC::Field's method C to replace an existing field in the record with a new field that we created. To use C, you need to retrieve the field you want to replace from a MARC::Record object (line 10), create a new field to replace the existing one with (lines 13-15), and then call the existing field's C method passing the new field as an argument (lines 18). You must pass C a valid MARC::Field object. =head2 Updating subfields and indicators If you'd rather not replace an existing field with a new one, you can also edit the contents of the field itself using the C method. Let's say you've got a batch of records and want to make sure that the 2nd indicator for the 245 field is properly set for titles that begin with 'The' (where the indicator should be '4'). 1 ## Example U5 2 3 use MARC::Batch; 4 my $batch = MARC::Batch->new('USMARC','file.dat'); 5 open(OUT,'>new.dat') or die $!; 6 7 while (my $record = $batch->next()) { 8 9 ## retrieve the 245 record. 10 my $field_245 = $record->field('245'); 11 12 ## if we got 245 and it starts with 'The'... 13 if ($field_245 and $field_245->as_string() =~ /^The /) { 14 15 ## if the 2nd indicator isn't 4, update 16 if ($field_245->indicator(2) != 4) { 17 $field_245->update( ind2 => 4 ); 18 } 19 20 } 21 22 print OUT $record->as_usmarc(); 23 24 } In a similar fashion, you can update individual or multiple subfields: $field_245->update( a => 'History of the World :', b => 'part 1' ); But beware, you can only update the first occurrence of a subfield using C. If you need to do more finer grained updates, you are advised to build a new field and replace the existing field with C. =head2 Changing a record's leader The above procedure works for fields, but editing the leader requires that you use the C method. When called with no arguments, C will return the current leader, and when you pass a scalar value as an argument, the leader will be set to this value. This example shows how you might want to update position 6 of a records leader to reflect a computer file. 1 ## Example U6 2 3 use MARC::Batch; 4 my $batch = MARC::Batch->new('USMARC','file.dat'); 5 open(OUT,'>new.dat') or die $!; 6 my $record = $batch->next(); 7 8 ## get the current leader. 9 my $leader = $record->leader(); 10 11 ## replace position 6 with 'm' 12 substr($leader,6,1) = 'm'; 13 14 ## update the leader 15 $record->leader($leader); 16 17 ## save the record to a file 18 print OUT $record->as_usmarc(); =head2 Modifying fields without indicators MARC::Record and MARC::Field are smart and know that you don't have field indicators with tags less than 010. Here's an example of updating/adding an 005 field to indicate a new transaction time. For a little pizzazz, we use Perl's C to generate the data we need for this field. 1 ## Example U7 2 3 use MARC::Batch; 4 my $batch = MARC::Batch->new('USMARC','file.dat'); 5 open(OUT,'>new.dat') or die $!; 6 7 while (my $record = $batch->next() ) { 8 9 ## see if there is a 005 field. 10 my $field_005 = $record->field('005'); 11 12 ## delete it if we find one. 13 $record->delete_field($field_005) if $field_005; 14 15 ## figure out the contents of our new 005 field. 16 my ($sec,$min,$hour,$mday,$mon,$year) = localtime(); 17 $year += 1900; $mon += 1; # catering to offsets. 18 my $datetime = sprintf("%4d%02d%02d%02d%02d%02d.0", 19 $year,$mon,$mday,$hour,$min,$sec); 20 21 ## create a new 005 field using our new datetime. 22 $record->append_fields( MARC::Field->new('005',$datetime) ); 23 24 ## save record to a file. 25 print OUT $record->as_usmarc(); 26 27 } =head2 Reordering subfields You may find yourself in the situation where you would like to programmatically reorder, and possibly modify, subfields in a particular field. For example, imagine that you have a batch of records that have 856 fields which contain subfields z, u, and possibly 3... in any order! Now imagine that you'd like to standardize the subfield z, and reorder them so that subfield 3 precedes subfield z, which precedes subfield u. This is tricky but can be done in the following manner: read in a record, extract the existing 856 field, build a new 856 field based on the existing one, replace the existing field with your newly created version. 1 ## Example U8 2 3 use MARC::Batch; 4 my $batch = MARC::Batch->new('USMARC','856.dat'); 5 open(OUT,'>856_new.dat') or die $!; 6 7 while (my $record = $batch->next()) { 8 9 my $existing = $record->field('856'); 10 11 ## make sure 856 exists. 12 if ($existing) { 13 14 ## our ordered subfields. 15 my @subfields = (); 16 17 ## if we have a subfield 3, add it. 18 if (defined($existing->subfield('3'))) { 19 push(@subfields,'3',$existing->subfield('3')); 20 } 21 22 ## now add subfields z and u. 23 push(@subfields,'z','Access restricted', 24 'u',$existing->subfield('u')); 25 26 ## create a new 856. 27 my $new = MARC::Field->new( 28 856', $existing->indicator(1), 29 $existing->indicator(2), @subfields 30 ); 31 32 ## replace the existing subfield. 33 $existing->replace_with($new); 34 35 } 36 37 ## write out the record 38 print OUT $record->as_usmarc(); 39 40 } =head2 Updating subject subfield x to subfield v As a somewhat more complicated example, you may find yourself wanting to update the last subfield x in a 650 field to be a subfield v instead. With the MARC::Field C and C methods along with some fancy footwork this can be done relatively easily. 1 ## Example U9 2 3 use MARC::Batch; 4 5 my $file = shift; 6 7 my $batch = MARC::Batch->new('USMARC', $file); 8 while ( my $record = $batch->next() ) { 9 10 # go through all 6XX fields in the record. 11 foreach my $subject ( $record->field( '6..' ) ) { 12 13 # extract subfields as an array of array refs. 14 my @subfields = $subject->subfields(); 15 16 # setup an array to store our new field. 17 my @newSubfields = (); 18 19 # a flag to indicate that we found an subfield x. 20 my $foundX = 0; 21 22 # use pop() to read the subfields backwards. 23 while ( my $subfield = pop( @subfields ) ) { 24 25 # for convenience, pull out the subfield 26 # code and data from the array ref. 27 my ($code,$data) = @$subfield; 28 29 # if the subfield code is 'x' and 30 # we haven't already found one... 31 if ( $code eq 'x' and ! $foundX ) { 32 33 # change to a v. 34 $code = 'v'; 35 36 # set flag so we know not to 37 # translate any more subfield x. 38 $foundX = 1; 39 40 } 41 42 # add our (potentially changed) subfield 43 # data to our new subfield data array. 44 unshift( @newSubfields, $code, $data ); 45 46 } 47 48 # if we did find a subfield x, then create a new field using our 49 # new subfield data, and replace the old one with the new one. 50 if ( $foundX ) { 51 my $newSubject = MARC::Field->new( 52 $subject->tag(), 53 $subject->indicator(1), 54 $subject->indicator(2), 55 @newSubfields 56 ); 57 $subject->replace_with( $newSubject ); 58 } 59 60 } 61 62 # output the potentially changed record as MARC. 63 print $record->as_usmarc(); 64 65 } =head1 VALIDATING MARC::Lint, available on CPAN and in cvs on SourceForge, has some extra goodies to allow you to validate records. MARC::Lint provides an extensive battery of tests, and it also provides a framework for adding more. =head2 Using MARC::Lint Here is an example of using MARC::Lint to generate a list of errors present in a batch of records in a file named 'file.dat': 1 ## Example V1 2 3 use MARC::Batch; 4 use MARC::Lint; 5 6 my $batch = MARC::Batch->new('USMARC','file.dat'); 7 my $linter = MARC::Lint->new(); 8 my $counter = 0; 9 10 while (my $record = $batch->next() ) { 11 12 $counter++; 13 14 ## feed the record to our linter object. 15 $linter->check_record($record); 16 17 ## get the warnings... 18 my @warnings = $linter->warnings(); 19 20 ## output any warnings. 21 if (@warnings) { 22 23 print "RECORD $counter\n"; 24 print join("\n",@warnings),"\n"; 25 26 } 27 28 } MARC::Lint is quite thorough, and will check the following when validating: presence of a 245 field, repeatability of fields and subfields, valid use of subfield within particular fields, presence of indicators and their values. All checks are based on MARC21 bibliographic format. =head2 Customizing MARC::Lint MARC::Lint makes no claim to check B that might be wrong with a MARC record. In practice, individual libraries may have their own idea about what is valid or invalid. For example, a library may mandate that all MARC records with an 856 field should have a subfield z that reads "Connect to this resource". MARC::Lint does provide a framework for adding rules. It can be done using the object oriented programming technique of inheritance. In short, you can create your own subclass of MARC::Lint, and then use it to validate your records. Here's an example: 1 ## Example V2 2 3 ## first, create our own subclass of MARC::Lint. 4 ## should be saved in a file called MyLint.pm. 5 6 package MyLint; 7 use base qw(MARC::Lint); 8 9 ## add a method to check that the 856 10 ## fields contain a correct subfield z. 11 sub check_856 { 12 13 ## your method is passed the MARC::Lint 14 ## and MARC::Field objects for the record. 15 my ($self,$field) = @_; 16 17 if ($field->subfield('z') ne 'Connect to this resource') { 18 19 ## add a warning to our lint object. 20 $self->warn("856 subfield z must read 'Connect to this resource'."); 21 22 } 23 24 } Then create a separate program that uses your subclass to validate your MARC records. You'll need to make sure your program is able to find your module (in this case, MyLint.pm)... this can be achieved by putting both MyLint.pm and the following program in the same directory: 1 ## Example V3 2 3 use MARC::Batch; 4 use MyLint; 5 6 my $linter = MyLint->new(); 7 my $batch = MARC::Batch->new('USMARC','file.marc'); 8 my $counter = 0; 9 10 while (my $record = $batch->next()) { 11 12 $counter++; 13 14 ## check the record 15 $linter->check_record($record); 16 17 ## get the warnings, and print them out 18 my @warnings = $linter->warnings(); 19 if (@warnings) { 20 print "RECORD $counter\n"; 21 print join("\n",@warnings),"\n"; 22 } 23 24 } Notice how the call to C at line 15 automatically calls the C in MARC::Lint. The property of inheritance is what makes this happen. C<$linter> is an instance of the MyLint class, and MyLint inherits from the MARC::Lint class, which allows C<$linter> to inherit all the functionality of a normal MARC::Lint object B the new functionality found in the C method. Notice also that we don't have to call C directly. The call to C automatically looks for any C methods that it can call to verify the record. Pretty neat stuff. If you've added validation checks that you think could be of use to the general public, please share them on the perl4lib mailing list, or become a developer and add them to the source! =head1 SWOLLEN APPENDICES Brian Eno fans might catch this reference to his autobiography which was comprised of a years worth of diary entries plus extra topics at the end, and was entitled "A Year With Swollen Appendices". The following section is a grab bag group of appendices. Many of them are not filled in yet; this is because they are just ideas... so perhaps the appendices aren't that swollen yet. Feel free to suggest new ones, or to fill these in. =head2 Comparing Collections =head2 Authority Records =head2 URLs =head2 ISBN/ISSNs =head2 Call numbers =head2 Subject headings Suppose you have a batch of MARC records and you want to extract all the subject headings, generating a report of how many times each subject heading appeared in the batch: 1 use MARC::File::USMARC; 2 use constant MAX => 20; 3 4 my %counts; 5 6 my $filename = shift or die "Must specify filename\n"; 7 my $file = MARC::File::USMARC->in( $filename ); 8 9 while ( my $marc = $file->next() ) { 10 for my $field ( $marc->field("6..") ) { 11 my $heading = $field->subfield('a'); 12 13 # trailing whitespace / punctuation. 14 $heading =~ s/[.,]?\s*$//; 15 16 # Now count it. 17 ++$counts{$heading}; 18 } 19 } 20 $file->close(); 21 22 # Sort the list of headings based on the count of each. 23 my @headings = reverse sort { $counts{$a} <=> $counts{$b} } keys %counts; 24 25 # Take the top N hits... 26 @headings = @headings[0..MAX-1]; 27 28 # And print out the results. 29 for my $heading ( @headings ) { 30 printf( "%5d %s\n", $counts{$heading}, $heading ); 31 } Which will generate results like this: 600 United States 140 World War, 1939-1945 78 Great Britain 63 Afro-Americans 61 Indians of North America 58 American poetry 55 France 53 West (U.S.) 53 Science fiction 53 American literature 50 Shakespeare, William 48 Soviet Union 46 Mystery and detective stories 45 Presidents 43 China 40 Frontier and pioneer life 38 English poetry 37 Authors, American 37 English language 35 Japan =head2 HTML =head2 XML =head2 MARCMaker MARC::File::MARCMaker, available on CPAN and in cvs on SourceForge, is a subclass of MARC::File for working with MARC 21 data encoded in the format used by the Library of Congress MARCMaker and MARCBreaker programs (L) and MarcEdit (). An example of a brief record in this format: =LDR 00314nam 22001215a 4500 =001 ctr00000123\ =003 XX-XxUND =005 20000613133448.0 =008 051029s2005\\\\xxua\\\\\\\\\\001\0\eng\\ =040 \\$aXX-XxUND$cXX-XxUND =245 00$aSample of MARCMaker record. =260 \\$a[United States] :$b[S.n.],$c2005. =300 \\$a1 p. ;$c28 cm. The following example converts an ISO2709 format record into MARCMaker format. 1 ## Example Maker1 2 3 use MARC::Batch; 4 use MARC::File::MARCMaker; 5 6 #mrc indicates ISO2709 format 7 my $mrc_in = 'in.mrc'; 8 #mrk indicates MARCMaker format 9 my $mrk_out = 'out.mrk'; 10 11 #initialize $batch_mrc as new MARC::Batch object 12 my $batch_mrc = MARC::Batch->new('USMARC', $mrc_in); 13 14 #open mrk (MARCMaker) format output file 15 open (OUTMRK, ">$mrk_out") || die "Cannot open $mrk_out, $!"; 16 17 my $rec_count = 0; 18 while (my $record = $batch_mrc->next()) { 19 $rec_count++; 20 21 print OUTMRK MARC::File::MARCMaker->encode($record); 22 23 } # while 24 25 print "$rec_count records processed\n"; The following example shows conversion from MARCMaker format to ISO2709 format. 1 ## Example Maker2 2 3 use MARC::Batch; 4 use MARC::File::MARCMaker; 5 6 #mrk indicates MARCMaker format 7 my $mrk_in = 'in.mrk'; 8 #mrc indicates ISO2709 format 9 my $mrc_out = 'out.mrc'; 10 11 #initialize $batch_mrk as new MARC::Batch object 12 my $batch_mrk = MARC::Batch->new( 'MARCMaker', $mrk_in); 13 14 #open mrc (ISO2709) format output file 15 open (OUTMRC, ">$mrc_out") || die "Cannot open $mrc_out, $!"; 16 17 my $rec_count = 0; 18 while (my $record = $batch_mrk->next()) { 19 $rec_count++; 20 21 print OUTMRC $record->as_usmarc(); 22 23 } # while 24 25 print "$rec_count records processed\n"; =head2 Excel =head2 Z39.50 Chris Biemesderfer was kind enough to contribute a short example of how to use MARC::Record in tandem with Net::Z3950. Net::Z3950 is a CPAN module which provides an easy to use interface to the Z39.50 protocol so that you can write programs that retrieve records from bibliographic database around the world. Chris' program is a command line utility which you run like so: ./zm.pl 0596000278 where 0596000278 is an ISBN (for the 3rd edition of the Camel incidentally). The program will query the Library of Congress Z39.50 server for the ISBN, and dump out the retrieved MARC record on the screen. The program is designed to lookup multiple ISBNs if you separate them with a space. This is just an example showing what is possible. 1 #!/usr/bin/perl -w 2 3 # GET-MARC-ISBN -- Get MARC records by ISBN from a Z39.50 server 4 5 use strict; 6 use Carp; 7 use Net::Z3950; 8 use MARC::Record; 9 10 exit if ($#ARGV < 0); 11 12 # We handle multiple ISBNs in the same query by assembling a 13 # (potentially very large) search string with Prefix Query Notation 14 # that ORs the ISBN-bearing attributes. 15 # 16 # For purposes of automation, we want to request batches of many MARC 17 # records. I am not a Z39.50 weenie, though, and I don't know 18 # offhand if there is a limit on how big a PQN query can be... 19 20 my $zq = "\@attr 1=7 ". pop(); 21 while (@ARGV) { $zq = '@or @attr 1=7 '. pop() ." $zq" } 22 23 ## HERE IS THE CODE FOR Z3950 REC RETRIEVAL 24 # Set up connection management structures, connect 25 # to the server, and submit the Z39.50 query. 26 27 my $mgr = Net::Z3950::Manager->new( databaseName => 'voyager' ); 28 $mgr->option( elementSetName => "f" ); 29 $mgr->option( preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC ); 30 31 my $conn = $mgr->connect('z3950.loc.gov', '7090'); 32 croak "Unable to connect to server" if !defined($conn); 33 34 my $rs = $conn->search($zq); 35 36 my $numrec = $rs->size(); 37 print STDERR "$numrec record(s) found\n"; 38 39 for (my $ii = 1; $ii <= $numrec; $ii++) { 40 41 # Extract MARC records from Z3950 42 # result set, and load MARC::Record. 43 my $zrec = $rs->record($ii); 44 my $mrec = MARC::Record->new_from_usmarc($zrec->rawdata()); 45 print $mrec->as_formatted, "\n\n"; 46 47 } =head2 Databases Here's a script that will do a Z39.50 query (using Chris Biemesderfer's zm.pl as a model), get a MARC record back, and store it as a binary blob in a MySQL table of this structure: +---------------+---------------+------+-----+---------+----------------+ | Field | Type | Null | Key | Default | Extra | +---------------+---------------+------+-----+---------+----------------+ | TitleID | int(7) | | PRI | NULL | auto_increment | | RecLastMod | timestamp(14) | YES | | NULL | | | ISSN | text | YES | | NULL | | | RawMARCRecord | blob | YES | | NULL | | +---------------+---------------+------+-----+---------+----------------+ 1 #!/usr/bin/perl -w 2 3 # Script that reads in a file of ISSNs, queries a Z39.50 server, 4 # and stores resulting records in a database. Limitations: Only 5 # stores 1 records per ISSN. 6 # Last updated 2004-09-08 Mark Jordan, mjordan@sfu.ca 7 8 use strict; 9 use Carp; 10 use Net::Z3950; 11 use MARC::Record; 12 use DBI; 13 14 # DB connection settings 15 my $host = "somehost"; 16 my $user = "someuser"; 17 my $password = "somepass"; 18 my $database = "somedb"; 19 20 # Input file (one ISSS/line) 21 my $InputFile = $ARGV[0]; 22 23 # Prepare list of ISSNs to search 24 my @ISSNs; 25 open (INPUT, "< $InputFile") or die "Can't find input file\n"; 26 while () { chomp $_; push (@ISSNs, $_); } 27 close INPUT; 28 29 30 # Set up connection management structures, connect to the server, 31 # and submit the Z39.50 query. 32 my $mgr = Net::Z3950::Manager->new( databaseName => 'voyager' ); 33 $mgr->option( elementSetName => "f" ); 34 $mgr->option( preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC ); 35 my $conn = $mgr->connect('z3950.loc.gov', '7090'); 36 croak "Unable to connect to server" if !defined($conn); 37 38 39 my $handle = DBI->connect("DBI:mysql:$database:$host","$user","$password") 40 or die $DBI::errstr; 41 42 foreach my $ISSN (@ISSNs) { 43 my $zq = "\@attr 1=8 ". $ISSN; 44 my $rs = $conn->search($zq); 45 my $numrec = $rs->size(); 46 if ($numrec == 0) { 47 print "Record for ISSN $ISSN not found, moving to next ISSN...\n"; 48 next; 49 } else { 50 # Extract MARC record from the result set, and invoke MARC::Record 51 my $zrec = $rs->record(1); 52 my $mrec = MARC::Record->new_from_usmarc($zrec->rawdata()); 53 my $rawdata = $zrec->rawdata(); 54 $rawdata = $handle->quote ($rawdata); 55 # Add to db 56 my $SQL = "insert into Titles values (NULL,NULL,'$ISSN',$rawdata)"; 57 my $cursor = $handle->prepare($SQL); 58 $cursor->execute; 59 print "Record for ISSN $ISSN added to database...\n"; 60 $cursor->finish; 61 } 62 } 63 $handle->disconnect; 64 65 __END__ If you want to pull records out of the same database and do something with them, here's a template script: 1 #!/usr/bin/perl -w 2 3 # Script that gets MARC records (in blobs) from a database. 4 # Last updated 2004-09-08 Mark Jordan, mjordan@sfu.ca 5 6 use strict; 7 use MARC::Record; 8 use DBI; 9 10 # DB connection settings 11 my $mysql_host = "somehost"; 12 my $mysql_user = "someuser"; 13 my $mysql_password = "somepass*"; 14 my $mysql_database = "somedb"; 15 16 17 my $handle = DBI->connect("DBI:mysql:$mysql_database:$mysql_host", 18 "$mysql_user","$mysql_password") or die $DBI::errstr; 19 20 my $SQL = "select * from Titles"; 21 my $cursor = $handle->prepare($SQL); 22 $cursor->execute; 23 24 while (my @Records = $cursor->fetchrow_array) { 25 my $RawMARC = $Records[3]; 26 my $mrec = MARC::Record->new_from_usmarc($RawMARC); 27 # Print out the title 28 print $mrec->title , "\n"; 29 } 30 31 $cursor->finish; 32 $handle->disconnect; 33 34 __END__ =head2 Procite/Endnote =head1 CONTRIBUTORS Many thanks to all the contributors who have made this document possible. =over 4 =item * Bryan Baldus =item * Chris Biemesderfer =item * Morbus Iff =item * Mark Jordan =item * Andy Lester =item * Christopher Morgan =item * Shashi Pinheiro =item * Jackie Shieh =item * Ed Summers =back MARC-Record-2.0.7/lib/MARC/Field.pm0000644000175100017510000004765213111151774014446 0ustar gmcgmcpackage MARC::Field; use strict; use warnings; use integer; use Carp; use constant SUBFIELD_INDICATOR => "\x1F"; use constant END_OF_FIELD => "\x1E"; use vars qw( $ERROR ); =head1 NAME MARC::Field - Perl extension for handling MARC fields =head1 SYNOPSIS use MARC::Field; # If your system uses wacky control field tags, add them MARC::Field->allow_controlfield_tags('FMT', 'LLE'); my $field = MARC::Field->new( 245, '1', '0', 'a' => 'Raccoons and ripe corn / ', 'c' => 'Jim Arnosky.' ); $field->add_subfields( "a", "1st ed." ); =head1 DESCRIPTION Defines MARC fields for use in the MARC::Record module. I suppose you could use them on their own, but that wouldn't be very interesting. =head1 EXPORT None by default. Any errors are stored in C<$MARC::Field::ERROR>, which C<$MARC::Record> usually bubbles up to C<$MARC::Record::ERROR>. =head1 CLASS VARIABLES B: Some systems (notably Ex Libris's Aleph) throw extra control fields in their MARC (e.g., Aleph's MARC-XML tends to have a C control field). We keep a class-level hash to track to track them; it can be manipulated with C and c. =cut my %extra_controlfield_tags = (); =head1 METHODS =head2 new() The constructor, which will return a MARC::Field object. Typically you will pass in the tag number, indicator 1, indicator 2, and then a list of any subfield/data pairs. For example: my $field = MARC::Field->new( 245, '1', '0', 'a' => 'Raccoons and ripe corn / ', 'c' => 'Jim Arnosky.' ); Or if you want to add a control field (< 010) that does not have indicators. my $field = MARC::Field->new( '001', ' 14919759' ); =cut sub new { my $class = shift; $class = $class; ## MARC spec indicates that tags can have alphabetical ## characters in them! If they do appear we assume that ## they have indicators like tags > 010 unless they've ## been previously defined as control tags using ## add_controlfield my $tagno = shift; $class->is_valid_tag($tagno) or croak( "Tag \"$tagno\" is not a valid tag." ); my $is_control = $class->is_controlfield_tag($tagno); my $self = bless { _tag => $tagno, _warnings => [], _is_control_field => $is_control, }, $class; if ( $is_control ) { $self->{_data} = shift; $self->_warn("Too much data for control field '$tagno'") if (@_); } else { for my $indcode ( qw( _ind1 _ind2 ) ) { my $indicator = shift; defined($indicator) or croak("Field $tagno must have indicators (use ' ' for empty indicators)"); unless ($self->is_valid_indicator($indicator)) { $self->_warn( "Invalid indicator \"$indicator\" forced to blank" ) unless ($indicator eq ""); $indicator = " "; } $self->{$indcode} = $indicator; } # for (@_ >= 2) or croak( "Field $tagno must have at least one subfield" ); # Normally, we go thru add_subfields(), but internally we can cheat $self->{_subfields} = [@_]; } return $self; } # new() =head2 tag() Returns the three digit tag for the field. =cut sub tag { my $self = shift; return $self->{_tag}; } =head2 set_tag(tag) Changes the tag number of this field. Updates the control status accordingly. Will C if an invalid value is passed in. =cut sub set_tag { my ( $self, $tagno ) = @_; $self->is_valid_tag($tagno) or croak("Tag \"$tagno\" is not a valid tag."); $self->{_tag} = $tagno; $self->{_is_control_field} = $self->is_controlfield_tag($tagno); } =head2 indicator(indno) Returns the specified indicator. Returns C and logs a warning if field is a control field and thus doesn't have indicators. If the field is not a control field, croaks if the I is not 1 or 2. =cut sub indicator { my $self = shift; my $indno = shift; if ($self->is_control_field) { $self->_warn( "Control fields (generally, those with tags below 010) do not have indicators" ); return; } if ( $indno == 1 ) { return $self->{_ind1}; } elsif ( $indno == 2 ) { return $self->{_ind2}; } else { croak( "Indicator number must be 1 or 2" ); } } =head2 set_indicator($indno, $indval) Set the indicator position I<$indno> to the value specified by I<$indval>. Croaks if the indicator position, is invalid, the field is a control field and thus doesn't have indicators, or if the new indicator value is invalid. =cut sub set_indicator { my $self = shift; my $indno = shift; my $indval = shift; croak('Indicator number must be 1 or 2') unless defined $indno && $indno =~ /^[12]$/; croak('Cannot set indicator for control field') if $self->is_control_field; croak('Indicator value is invalid') unless $self->is_valid_indicator($indval); $self->{"_ind$indno"} = $indval; } =head2 allow_controlfield_tags($tag, $tag2, ...) Add $tags to class-level list of strings to consider valid control fields tags (in addition to 001 through 009). Tags must have three characters. =cut sub allow_controlfield_tags { my $self = shift; foreach my $tag (@_) { $extra_controlfield_tags{$tag} = 1; } } =head2 disallow_controlfield_tags($tag, $tag2, ...) =head2 disallow_controlfield_tags('*') Revoke the validity of a control field tag previously added with allow_controlfield_tags. As a special case, if you pass the string '*' it will clear out all previously-added tags. NOTE that this will only deal with stuff added with allow_controlfield_tags; you can't disallow '001'. =cut sub disallow_controlfield_tags { my $self = shift; if ($_[0] eq '*') { %extra_controlfield_tags = (); return; } foreach my $tag (@_) { delete $extra_controlfield_tags{$tag}; } } =head2 is_valid_tag($tag) -- is the given tag valid? Generally called as a class method (e.g., MARC::Field->is_valid_tag('001')) =cut sub is_valid_tag { my $self = shift; my $tag = shift; return 1 if defined $tag && $tag =~ /^[0-9A-Za-z]{3}$/; return 0; } =head2 is_valid_indicator($indval) -- is the given indicator value valid? Generally called as a class method (e.g., MARC::Field->is_valid_indicator('4')) =cut sub is_valid_indicator { my $self = shift; my $indval = shift; return 1 if defined $indval && $indval =~ /^[0-9A-Za-z ]$/; return 0; } =head2 is_controlfield_tag($tag) -- does the given tag denote a control field? Generally called as a class method (e.g., MARC::Field->is_controlfield_tag('001')) =cut sub is_controlfield_tag { my $self = shift; my $tag = shift; return 1 if ($extra_controlfield_tags{$tag}); return 1 if (($tag =~ /^\d+$/) && ($tag < 10)); return 0; # otherwise, it's not a control field } =head2 is_control_field() Tells whether this field is one of the control tags from 001-009. =cut sub is_control_field { my $self = shift; return $self->{_is_control_field}; } =head2 subfield(code) When called in a scalar context returns the text from the first subfield matching the subfield code. my $subfield = $field->subfield( 'a' ); Or if you think there might be more than one you can get all of them by calling in a list context: my @subfields = $field->subfield( 'a' ); If no matching subfields are found, C is returned in a scalar context and an empty list in a list context. If the tag is a control field, C is returned and C<$MARC::Field::ERROR> is set. =cut sub subfield { my $self = shift; my $code_wanted = shift; croak( "Control fields (generally, just tags below 010) do not have subfields, use data()" ) if $self->is_control_field; my @data = @{$self->{_subfields}}; my @found; while ( defined( my $code = shift @data ) ) { if ( $code eq $code_wanted ) { push( @found, shift @data ); } else { shift @data; } } if ( wantarray() ) { return @found; } return( $found[0] ); } =head2 subfields() Returns all the subfields in the field. What's returned is a list of list refs, where the inner list is a subfield code and the subfield data. For example, this might be the subfields from a 245 field: ( [ 'a', 'Perl in a nutshell :' ], [ 'b', 'A desktop quick reference.' ], ) =cut sub subfields { my $self = shift; if ($self->is_control_field) { $self->_warn( "Control fields (generally, just tags below 010) do not have subfields" ); return; } my @list; my @data = @{$self->{_subfields}}; while ( defined( my $code = shift @data ) ) { push( @list, [$code, shift @data] ); } return @list; } =head2 data() Returns the data part of the field, if the tag number is less than 10. =cut sub data { my $self = shift; croak( "data() is only for control fields (generally, just tags below 010) , use subfield()" ) unless $self->is_control_field; $self->{_data} = $_[0] if @_; return $self->{_data}; } =head2 add_subfields(code,text[,code,text ...]) Adds subfields to the end of the subfield list. $field->add_subfields( 'c' => '1985' ); Returns the number of subfields added, or C if there was an error. =cut sub add_subfields { my $self = shift; croak( "Subfields are only for data fields (generally, just tags >= 010)" ) if $self->is_control_field; push( @{$self->{_subfields}}, @_ ); return @_/2; } =head2 delete_subfield() delete_subfield() allows you to remove subfields from a field: # delete any subfield a in the field $field->delete_subfield(code => 'a'); # delete any subfield a or u in the field $field->delete_subfield(code => ['a', 'u']); # delete any subfield code matching a compiled regular expression $field->delete_subfield(code => qr/[^a-z0-9]/); If you want to only delete subfields at a particular position you can use the pos parameter: # delete subfield u at the first position $field->delete_subfield(code => 'u', pos => 0); # delete subfield u at first or second position $field->delete_subfield(code => 'u', pos => [0,1]); # delete the second subfield, no matter what it is $field->delete_subfield(pos => 1); You can specify a regex to for only deleting subfields that match: # delete any subfield u that matches zombo.com $field->delete_subfield(code => 'u', match => qr/zombo.com/); # delete any subfield that matches quux $field->delete_subfield(match => qr/quux/); You can also pass a single subfield label: # delete all subfield u $field->delete_subfield('u'); =cut sub delete_subfield { my ($self, @options) = @_; my %options; if (scalar(@options) == 1) { $options{code} = $options[0]; } elsif (0 == scalar(@options) % 2) { %options = @options; } else { croak 'delete_subfield must be called with single scalar or a hash'; } my $codes = _normalize_arrayref($options{code}); my $positions = _normalize_arrayref($options{'pos'}); my $match = $options{match}; croak 'match must be a compiled regex' if $match and ref($match) ne 'Regexp'; croak 'must supply subfield code(s) and/or subfield position(s) and/or match patterns to delete_subfield' unless $match or (@$codes > 0) or (@$positions > 0); my @current_subfields = @{$self->{_subfields}}; my @new_subfields = (); my $removed = 0; my $subfield_num = $[ - 1; # users $[ preferences control indexing while (@current_subfields > 0) { $subfield_num += 1; my $subfield_code = shift @current_subfields; my $subfield_value = shift @current_subfields; if ((@$codes==0 or grep { (ref($_) eq 'Regexp' && $subfield_code =~ $_) || (ref($_) ne 'Regexp' && $_ eq $subfield_code) } @$codes) and (!$match or $subfield_value =~ $match) and (@$positions==0 or grep {$_ == $subfield_num} @$positions)) { $removed += 1; next; } push( @new_subfields, $subfield_code, $subfield_value); } $self->{_subfields} = \@new_subfields; return $removed; } =head2 delete_subfields() Delete all subfields with a given subfield code. This is here for backwards compatibility, you should use the more flexible delete_subfield(). =cut sub delete_subfields { my ($self, $code) = @_; return $self->delete_subfield(code => $code); } =head2 update() Allows you to change the values of the field. You can update indicators and subfields like this: $field->update( ind2 => '4', a => 'The ballad of Abe Lincoln'); If you attempt to update a subfield which does not currently exist in the field, then a new subfield will be appended to the field. If you don't like this auto-vivification you must check for the existence of the subfield prior to update. if ( $field->subfield( 'a' ) ) { $field->update( 'a' => 'Cryptonomicon' ); } If you want to update a field that has no indicators or subfields (000-009) just call update() with one argument, the string that you would like to set the field to. $field = $record->field( '003' ); $field->update('IMchF'); Note: when doing subfield updates be aware that C will only update the first occurrence. If you need to do anything more complicated you will probably need to create a new field and use C. Returns the number of items modified. =cut sub update { my $self = shift; ## tags 000 - 009 don't have indicators or subfields if ( $self->is_control_field ) { $self->{_data} = shift; return(1); } ## otherwise we need to update subfields and indicators my @data = @{$self->{_subfields}}; my $changes = 0; while ( @_ ) { my $arg = shift; my $val = shift; ## indicator update if ($arg =~ /^ind[12]$/) { $self->{"_$arg"} = $val; $changes++; } ## subfield update else { my $found = 0; ## update existing subfield for ( my $i=0; $i<@data; $i+=2 ) { if ($data[$i] eq $arg) { $data[$i+1] = $val; $found = 1; $changes++; last; } } # for ## append new subfield if ( !$found ) { push( @data, $arg, $val ); $changes++; } } } # while ## synchronize our subfields $self->{_subfields} = \@data; return($changes); } =head2 replace_with() Allows you to replace an existing field with a new one. You need to pass C a MARC::Field object to replace the existing field with. For example: $field = $record->field('245'); my $new_field = new MARC::Field('245','0','4','The ballad of Abe Lincoln.'); $field->replace_with($new_field); Doesn't return a meaningful or reliable value. =cut sub replace_with { my ($self,$new) = @_; ref($new) =~ /^MARC::Field$/ or croak("Must pass a MARC::Field object"); %$self = %$new; } =head2 as_string( [$subfields] [, $delimiter] ) Returns a string of all subfields run together. A space is added to the result between each subfield, unless the delimiter parameter is passed. The tag number and subfield character are not included. Subfields appear in the output string in the order in which they occur in the field. If C<$subfields> is specified, then only those subfields will be included. my $field = MARC::Field->new( 245, '1', '0', 'a' => 'Abraham Lincoln', 'h' => '[videorecording] :', 'b' => 'preserving the union /', 'c' => 'A&E Home Video.' ); print $field->as_string( 'abh' ); # Only those three subfields # prints 'Abraham Lincoln [videorecording] : preserving the union /'. print $field->as_string( 'ab', '--' ); # Only those two subfields, with a delimiter # prints 'Abraham Lincoln--preserving the union /'. Note that subfield h comes before subfield b in the output. =cut sub as_string { my $self = shift; my $subfields = shift; my $delimiter = shift; $delimiter = " " unless defined $delimiter; if ( $self->is_control_field ) { return $self->{_data}; } my @subs; my $subs = $self->{_subfields}; my $nfields = @$subs / 2; for my $i ( 1..$nfields ) { my $offset = ($i-1)*2; my $code = $subs->[$offset]; my $text = $subs->[$offset+1]; push( @subs, $text ) if !defined($subfields) || $code =~ /^[$subfields]$/; } # for return join( $delimiter, @subs ); } =head2 as_formatted() Returns a pretty string for printing in a MARC dump. =cut sub as_formatted { my $self = shift; my @lines; if ( $self->is_control_field ) { push( @lines, sprintf( "%03s %s", $self->{_tag}, $self->{_data} ) ); } else { my $hanger = sprintf( "%03s %1.1s%1.1s", $self->{_tag}, $self->{_ind1}, $self->{_ind2} ); my $subs = $self->{_subfields}; my $nfields = @$subs / 2; my $offset = 0; for my $i ( 1..$nfields ) { push( @lines, sprintf( "%-6.6s _%1.1s%s", $hanger, $subs->[$offset++], $subs->[$offset++] ) ); $hanger = ""; } # for } return join( "\n", @lines ); } =head2 as_usmarc() Returns a string for putting into a USMARC file. It's really only useful for C. =cut sub as_usmarc { my $self = shift; # Control fields are pretty easy if ( $self->is_control_field ) { return $self->data . END_OF_FIELD; } else { my @subs; my @subdata = @{$self->{_subfields}}; while ( @subdata ) { push( @subs, join( "", SUBFIELD_INDICATOR, shift @subdata, shift @subdata ) ); } # while return join( "", $self->indicator(1), $self->indicator(2), @subs, END_OF_FIELD, ); } } =head2 clone() Makes a copy of the field. Note that this is not just the same as saying my $newfield = $field; since that just makes a copy of the reference. To get a new object, you must my $newfield = $field->clone; Returns a MARC::Field record. =cut sub clone { my $self = shift; my $tagno = $self->{_tag}; my $is_control = $self->is_controlfield_tag($tagno); my $clone = bless { _tag => $tagno, _warnings => [], _is_control_field => $is_control, }, ref($self); if ( $is_control ) { $clone->{_data} = $self->{_data}; } else { $clone->{_ind1} = $self->{_ind1}; $clone->{_ind2} = $self->{_ind2}; $clone->{_subfields} = [@{$self->{_subfields}}]; } return $clone; } =head2 warnings() Returns the warnings that were created when the record was read. These are things like "Invalid indicators converted to blanks". The warnings are items that you might be interested in, or might not. It depends on how stringently you're checking data. If you're doing some grunt data analysis, you probably don't care. =cut sub warnings { my $self = shift; return @{$self->{_warnings}}; } # NOTE: _warn is an object method sub _warn { my $self = shift; push( @{$self->{_warnings}}, join( "", @_ ) ); } sub _gripe { $ERROR = join( "", @_ ); warn $ERROR; return; } sub _normalize_arrayref { my $ref = shift; if (ref($ref) eq 'ARRAY') { return $ref } elsif (defined $ref) { return [$ref] } return []; } 1; __END__ =head1 SEE ALSO See the "SEE ALSO" section for L. =head1 TODO See the "TODO" section for L. =cut =head1 LICENSE This code may be distributed under the same terms as Perl itself. Please note that these modules are not products of or supported by the employers of the various contributors to the code. =head1 AUTHOR Andy Lester, C<< >> =cut MARC-Record-2.0.7/lib/MARC/File/0000755000175100017510000000000013111154233013717 5ustar gmcgmcMARC-Record-2.0.7/lib/MARC/File/Encode.pm0000644000175100017510000000154413111151774015465 0ustar gmcgmcpackage MARC::File::Encode; =head1 NAME MARC::File::Encode - Encode wrapper for MARC::Record =head1 DESCRIPTION Encode.pm exports encode() by default, and MARC::File::USMARC already has a function encode() so we need this wrapper to keep things the way they are. I was half tempted to change MARC::File::USMARC::encode() to something else but there could very well be code in the wild that uses it directly and I don't want to break backwards compat. This probably comes with a performance hit of some kind. =cut use strict; use warnings; use base qw( Exporter ); use Encode; our @EXPORT_OK = qw( marc_to_utf8 ); =head2 marc_to_utf8() Simple wrapper around Encode::decode(). =cut sub marc_to_utf8 { # if there is invalid utf8 date then this will through an exception # let's just hope it's valid :-) return decode( 'UTF-8', $_[0], 1 ); } 1; MARC-Record-2.0.7/lib/MARC/File/USMARC.pm0000644000175100017510000002471113111151774015263 0ustar gmcgmcpackage MARC::File::USMARC; =head1 NAME MARC::File::USMARC - USMARC-specific file handling =cut use strict; use warnings; use integer; use vars qw( $ERROR ); use MARC::File::Encode qw( marc_to_utf8 ); use MARC::File; use vars qw( @ISA ); @ISA = qw( MARC::File ); use MARC::Record qw( LEADER_LEN ); use MARC::Field; use constant SUBFIELD_INDICATOR => "\x1F"; use constant END_OF_FIELD => "\x1E"; use constant END_OF_RECORD => "\x1D"; use constant DIRECTORY_ENTRY_LEN => 12; =head1 SYNOPSIS use MARC::File::USMARC; my $file = MARC::File::USMARC->in( $filename ); while ( my $marc = $file->next() ) { # Do something } $file->close(); undef $file; =head1 EXPORT None. =head1 METHODS =cut sub _next { my $self = shift; my $fh = $self->{fh}; my $reclen; return if eof($fh); local $/ = END_OF_RECORD; my $usmarc = <$fh>; # remove illegal garbage that sometimes occurs between records $usmarc =~ s/^[ \x00\x0a\x0d\x1a]+//; return $usmarc; } =head2 decode( $string [, \&filter_func ] ) Constructor for handling data from a USMARC file. This function takes care of all the tag directory parsing & mangling. Any warnings or coercions can be checked in the C function. The C<$filter_func> is an optional reference to a user-supplied function that determines on a tag-by-tag basis if you want the tag passed to it to be put into the MARC record. The function is passed the tag number and the raw tag data, and must return a boolean. The return of a true value tells MARC::File::USMARC::decode that the tag should get put into the resulting MARC record. For example, if you only want title and subject tags in your MARC record, try this: sub filter { my ($tagno,$tagdata) = @_; return ($tagno == 245) || ($tagno >= 600 && $tagno <= 699); } my $marc = MARC::File::USMARC->decode( $string, \&filter ); Why would you want to do such a thing? The big reason is that creating fields is processor-intensive, and if your program is doing read-only data analysis and needs to be as fast as possible, you can save time by not creating fields that you'll be ignoring anyway. Another possible use is if you're only interested in printing certain tags from the record, then you can filter them when you read from disc and not have to delete unwanted tags yourself. =cut sub decode { my $text; my $location = ''; ## decode can be called in a variety of ways ## $object->decode( $string ) ## MARC::File::USMARC->decode( $string ) ## MARC::File::USMARC::decode( $string ) ## this bit of code covers all three my $self = shift; if ( ref($self) =~ /^MARC::File/ ) { $location = 'in record '.$self->{recnum}; $text = shift; } else { $location = 'in record 1'; $text = $self=~/MARC::File/ ? shift : $self; } my $filter_func = shift; # ok this the empty shell we will fill my $marc = MARC::Record->new(); # Check for an all-numeric record length ($text =~ /^(\d{5})/) or return $marc->_warn( "Record length \"", substr( $text, 0, 5 ), "\" is not numeric $location" ); my $reclen = $1; my $realLength = bytes::length( $text ); $marc->_warn( "Invalid record length $location: Leader says $reclen " . "bytes but it's actually $realLength" ) unless $reclen == $realLength; (substr($text, -1, 1) eq END_OF_RECORD) or $marc->_warn( "Invalid record terminator $location" ); $marc->leader( substr( $text, 0, LEADER_LEN ) ); # bytes 12 - 16 of leader give offset to the body of the record my $data_start = 0 + bytes::substr( $text, 12, 5 ); # immediately after the leader comes the directory (no separator) my $dir = substr( $text, LEADER_LEN, $data_start - LEADER_LEN - 1 ); # -1 to allow for \x1e at end of directory # character after the directory must be \x1e (substr($text, $data_start-1, 1) eq END_OF_FIELD) or $marc->_warn( "No directory found $location" ); # all directory entries 12 bytes long, so length % 12 must be 0 (length($dir) % DIRECTORY_ENTRY_LEN == 0) or $marc->_warn( "Invalid directory length $location" ); # go through all the fields my $nfields = length($dir)/DIRECTORY_ENTRY_LEN; for ( my $n = 0; $n < $nfields; $n++ ) { my ( $tagno, $len, $offset ) = unpack( "A3 A4 A5", substr($dir, $n*DIRECTORY_ENTRY_LEN, DIRECTORY_ENTRY_LEN) ); # Check directory validity ($tagno =~ /^[0-9A-Za-z]{3}$/) or $marc->_warn( "Invalid tag in directory $location: \"$tagno\"" ); ($len =~ /^\d{4}$/) or $marc->_warn( "Invalid length in directory $location tag $tagno: \"$len\"" ); ($offset =~ /^\d{5}$/) or $marc->_warn( "Invalid offset in directory $location tag $tagno: \"$offset\"" ); ($offset + $len <= $reclen) or $marc->_warn( "Directory entry $location runs off the end of the record tag $tagno" ); my $tagdata = bytes::substr( $text, $data_start+$offset, $len ); # if utf8 the we encode the string as utf8 if ( $marc->encoding() eq 'UTF-8' ) { $tagdata = marc_to_utf8( $tagdata ); } $marc->_warn( "Invalid length in directory for tag $tagno $location" ) unless ( $len == bytes::length($tagdata) ); if ( substr($tagdata, -1, 1) eq END_OF_FIELD ) { # get rid of the end-of-tag character chop $tagdata; --$len; } else { $marc->_warn( "field does not end in end of field character in tag $tagno $location" ); } warn "Specs: ", join( "|", $tagno, $len, $offset, $tagdata ), "\n" if $MARC::Record::DEBUG; if ( $filter_func ) { next unless $filter_func->( $tagno, $tagdata ); } if ( MARC::Field->is_controlfield_tag($tagno) ) { $marc->append_fields( MARC::Field->new( $tagno, $tagdata ) ); } else { my @subfields = split( SUBFIELD_INDICATOR, $tagdata ); my $indicators = shift @subfields; my ($ind1, $ind2); if ( length( $indicators ) > 2 or length( $indicators ) == 0 ) { $marc->_warn( "Invalid indicators \"$indicators\" forced to blanks $location for tag $tagno\n" ); ($ind1,$ind2) = (" ", " "); } else { $ind1 = substr( $indicators,0, 1 ); $ind2 = substr( $indicators,1, 1 ); } # Split the subfield data into subfield name and data pairs my @subfield_data; for ( @subfields ) { if ( length > 0 ) { push( @subfield_data, substr($_,0,1),substr($_,1) ); } else { $marc->_warn( "Entirely empty subfield found in tag $tagno" ); } } if ( !@subfield_data ) { $marc->_warn( "no subfield data found $location for tag $tagno" ); next; } my $field = MARC::Field->new($tagno, $ind1, $ind2, @subfield_data ); if ( $field->warnings() ) { $marc->_warn( $field->warnings() ); } $marc->append_fields( $field ); } } # looping through all the fields return $marc; } =head2 update_leader() If any changes get made to the MARC record, the first 5 bytes of the leader (the length) will be invalid. This function updates the leader with the correct length of the record as it would be if written out to a file. =cut sub update_leader { my $self = shift; my (undef,undef,$reclen,$baseaddress) = $self->_build_tag_directory(); $self->_set_leader_lengths( $reclen, $baseaddress ); } =head2 _build_tag_directory() Function for internal use only: Builds the tag directory that gets put in front of the data in a MARC record. Returns two array references, and two lengths: The tag directory, and the data fields themselves, the length of all data (including the Leader that we expect will be added), and the size of the Leader and tag directory. =cut sub _build_tag_directory { my $marc = shift; $marc = shift if (ref($marc)||$marc) =~ /^MARC::File/; die "Wanted a MARC::Record but got a ", ref($marc) unless ref($marc) eq "MARC::Record"; my @fields; my @directory; my $dataend = 0; for my $field ( $marc->fields() ) { # Dump data into proper format my $str = $field->as_usmarc; push( @fields, $str ); # Create directory entry my $len = bytes::length( $str ); my $direntry = sprintf( "%03s%04d%05d", $field->tag, $len, $dataend ); push( @directory, $direntry ); $dataend += $len; } my $baseaddress = LEADER_LEN + # better be 24 ( @directory * DIRECTORY_ENTRY_LEN ) + # all the directory entries 1; # end-of-field marker my $total = $baseaddress + # stuff before first field $dataend + # Length of the fields 1; # End-of-record marker return (\@fields, \@directory, $total, $baseaddress); } =head2 encode() Returns a string of characters suitable for writing out to a USMARC file, including the leader, directory and all the fields. =cut sub encode { my $marc = shift; $marc = shift if (ref($marc)||$marc) =~ /^MARC::File/; my ($fields,$directory,$reclen,$baseaddress) = _build_tag_directory($marc); $marc->set_leader_lengths( $reclen, $baseaddress ); # Glomp it all together return join("",$marc->leader, @$directory, END_OF_FIELD, @$fields, END_OF_RECORD); } 1; __END__ =head1 RELATED MODULES L =head1 TODO Make some sort of autodispatch so that you don't have to explicitly specify the MARC::File::X subclass, sort of like how DBI knows to use DBD::Oracle or DBD::Mysql. Create a toggle-able option to check inside the field data for end of field characters. Presumably it would be good to have it turned on all the time, but it's nice to be able to opt out if you don't want to take the performance hit. =head1 LICENSE This code may be distributed under the same terms as Perl itself. Please note that these modules are not products of or supported by the employers of the various contributors to the code. =head1 AUTHOR Andy Lester, C<< >> =cut MARC-Record-2.0.7/lib/MARC/File/MicroLIF.pm0000644000175100017510000001676213111151774015704 0ustar gmcgmcpackage MARC::File::MicroLIF; =head1 NAME MARC::File::MicroLIF - MicroLIF-specific file handling =cut use strict; use warnings; use integer; use vars qw( $ERROR ); use MARC::File; use vars qw( @ISA ); @ISA = qw( MARC::File ); use MARC::Record qw( LEADER_LEN ); =head1 SYNOPSIS use MARC::File::MicroLIF; my $file = MARC::File::MicroLIF->in( $filename ); while ( my $marc = $file->next() ) { # Do something } $file->close(); undef $file; =head1 EXPORT None. =cut =for internal The buffer must be large enough to handle any valid record because we don't check for cases like a CR/LF pair or an end-of-record/CR/LF trio being only partially in the buffer. The max valid record is the max MARC record size (99999) plus one or two characters per tag (CR, LF, or CR/LF). It's hard to say what the max number of tags is, so here we use 6000. (6000 tags can be squeezed into a MARC record only if every tag has only one subfield containing a maximum of one character, or if data from multiple tags overlaps in the MARC record body. We're pretty safe.) =cut use constant BUFFER_MIN => (99999 + 6000 * 2); =head1 METHODS =head2 in() Opens a MicroLIF file for reading. =cut sub in { my $class = shift; my $self = $class->SUPER::in( @_ ); if ( $self ) { bless $self, $class; $self->{exhaustedfh} = 0; $self->{inputbuf} = ''; $self->{header} = undef; # get the MicroLIF header, but handle the case in # which it's missing. my $header = $self->_get_chunk( 1 ); if ( defined $header ) { if ( $header =~ /^LDR/ ) { # header missing, put this back $self->_unget_chunk( $header . "\n" ); # XXX should we warn of a missing header? } else { $self->{header} = $header; } } else { # can't read from the file undef $self; } } return $self; } # new # fill the buffer if we need to sub _fill_buffer { my $self = shift; my $ok = 1; if ( !$self->{exhaustedfh} && length( $self->{inputbuf} ) < BUFFER_MIN ) { # append the next chunk of bytes to the buffer my $read = read $self->{fh}, $self->{inputbuf}, BUFFER_MIN, length($self->{inputbuf}); if ( !defined $read ) { # error! $ok = undef; $MARC::File::ERROR = "error reading from file " . $self->{filename}; } elsif ( $read < 1 ) { $self->{exhaustedfh} = 1; } } return $ok; } =for internal Gets the next chunk of data. If C<$want_line> is true then you get the next chunk ending with any combination of \r and \n of any length. If it is false or not passed then you get the next chunk ending with \x60 followed by any combination of \r and \n of any length. All trailing \r and \n are stripped. =cut sub _get_chunk { my $self = shift; my $want_line = shift || 0; my $chunk = undef; if ( $self->_fill_buffer() && length($self->{inputbuf}) > 0 ) { # the buffer always has at least one full line in it, so we're # guaranteed that if there are no line endings then we're # on the last line. if ( $want_line ) { if ( $self->{inputbuf} =~ /^([^\x0d\x0a]*)([\x0d\x0a]+)/ ) { $chunk = $1; $self->{inputbuf} = substr( $self->{inputbuf}, length($1)+length($2) ); } } else { # couldn't figure out how to make this work as a regex my $pos = -1; while ( !$chunk ) { $pos = index( $self->{inputbuf}, '`', $pos+1 ); last if $pos < 0; if ( substr($self->{inputbuf}, $pos+1, 1) eq "\x0d" or substr($self->{inputbuf}, $pos+1, 1) eq "\x0a" ) { $chunk = substr( $self->{inputbuf}, 0, $pos+1 ); # include the '`' but not the newlines while ( substr($self->{inputbuf}, $pos+1, 1) eq "\x0d" or substr($self->{inputbuf}, $pos+1, 1) eq "\x0a" ) { ++$pos; } # $pos now pointing at last newline char $self->{inputbuf} = substr( $self->{inputbuf}, $pos+1 ); } } } if ( !$chunk ) { $chunk = $self->{inputbuf}; $self->{inputbuf} = ''; $self->{exhaustedfh} = 1; } } return $chunk; } # $chunk is put at the beginning of the buffer exactly as # passed in. No line endings are added. sub _unget_chunk { my $self = shift; my $chunk = shift; $self->{inputbuf} = $chunk . $self->{inputbuf}; return; } sub _next { my $self = shift; my $lifrec = $self->_get_chunk(); # for ease, make the newlines match this platform $lifrec =~ s/[\x0a\x0d]+/\n/g if defined $lifrec; return $lifrec; } =head2 header() If the MicroLIF file has a file header then the header is returned. If the file has no header or the file has not yet been opened then C is returned. =cut sub header { my $self = shift; return $self->{header}; } =head2 decode() Decodes a MicroLIF record and returns a USMARC record. Can be called in one of three different ways: $object->decode( $lif ) MARC::File::MicroLIF->decode( $lif ) MARC::File::MicroLIF::decode( $lif ) =cut sub decode { my $self = shift; my $location = ''; my $text = ''; ## decode can be called in a variety of ways ## this bit of code covers all three if ( ref($self) =~ /^MARC::File/ ) { $location = 'in record '.$self->{recnum}; $text = shift; } else { $location = 'in record 1'; $text = $self=~/MARC::File/ ? shift : $self; } my $marc = MARC::Record->new(); # for ease, make the newlines match this platform $text =~ s/[\x0a\x0d]+/\n/g if defined $text; my @lines = split( /\n/, $text ); for my $line ( @lines ) { ($line =~ s/^([0-9A-Za-z]{3})//) or $marc->_warn( "Invalid tag number: ".substr( $line, 0, 3 )." $location" ); my $tagno = $1; ($line =~ s/\^`?$//) or $marc->_warn( "Tag $tagno $location is missing a trailing caret." ); if ( $tagno eq "LDR" ) { $marc->leader( substr( $line, 0, LEADER_LEN ) ); } elsif ( $tagno =~ /^\d+$/ and $tagno < 10 ) { $marc->add_fields( $tagno, $line ); } else { $line =~ s/^(.)(.)//; my ($ind1,$ind2) = ($1,$2); my @subfields; my @subfield_data_pairs = split( /_(?=[a-z0-9])/, $line ); if ( scalar @subfield_data_pairs < 2 ) { $marc->_warn( "Tag $tagno $location has no subfields--discarded." ); } else { shift @subfield_data_pairs; # Leading _ makes an empty pair for my $pair ( @subfield_data_pairs ) { my ($subfield,$data) = (substr( $pair, 0, 1 ), substr( $pair, 1 )); push( @subfields, $subfield, $data ); } $marc->add_fields( $tagno, $ind1, $ind2, @subfields ); } } } # for return $marc; } 1; __END__ =head1 TODO =over 4 =back =head1 RELATED MODULES L =head1 LICENSE This code may be distributed under the same terms as Perl itself. Please note that these modules are not products of or supported by the employers of the various contributors to the code. =head1 AUTHOR Andy Lester, C<< >> =cut MARC-Record-2.0.7/lib/MARC/Batch.pm0000644000175100017510000001620013111151774014425 0ustar gmcgmcpackage MARC::Batch; =head1 NAME MARC::Batch - Perl module for handling files of MARC::Record objects =head1 SYNOPSIS MARC::Batch hides all the file handling of files of Cs. C still does the file I/O, but C handles the multiple-file aspects. use MARC::Batch; # If you have weird control fields... use MARC::Field; MARC::Field->allow_controlfield_tags('FMT', 'LDX'); my $batch = MARC::Batch->new( 'USMARC', @files ); while ( my $marc = $batch->next ) { print $marc->subfield(245,"a"), "\n"; } =head1 EXPORT None. Everything is a class method. =cut use strict; use integer; use Carp qw( croak ); =head1 METHODS =head2 new( $type, @files ) Create a C object that will process C<@files>. C<$type> must be either "USMARC" or "MicroLIF". If you want to specify "MARC::File::USMARC" or "MARC::File::MicroLIF", that's OK, too. C returns a new MARC::Batch object. C<@files> can be a list of filenames: my $batch = MARC::Batch->new( 'USMARC', 'file1.marc', 'file2.marc' ); Your C<@files> may also contain filehandles. So if you've got a large file that's gzipped you can open a pipe to F and pass it in: my $fh = IO::File->new( 'gunzip -c marc.dat.gz |' ); my $batch = MARC::Batch->new( 'USMARC', $fh ); And you can mix and match if you really want to: my $batch = MARC::Batch->new( 'USMARC', $fh, 'file1.marc' ); =cut sub new { my $class = shift; my $type = shift; my $marcclass = ($type =~ /^MARC::File/) ? $type : "MARC::File::$type"; eval "require $marcclass"; croak $@ if $@; my @files = @_; my $self = { filestack => \@files, filename => undef, marcclass => $marcclass, file => undef, warnings => [], 'warn' => 1, strict => 1, }; bless $self, $class; return $self; } # new() =head2 next() Read the next record from that batch, and return it as a MARC::Record object. If the current file is at EOF, close it and open the next one. C will return C when there is no more data to be read from any batch files. By default, C also will return C if an error is encountered while reading from the batch. If not checked for this can cause your iteration to terminate prematurely. To alter this behavior, see C. You can retrieve warning messages using the C method. Optionally you can pass in a filter function as a subroutine reference if you are only interested in particular fields from the record. This can boost performance. =cut sub next { my ( $self, $filter ) = @_; if ( $filter and ref($filter) ne 'CODE' ) { croak( "filter function in next() must be a subroutine reference" ); } if ( $self->{file} ) { # get the next record my $rec = $self->{file}->next( $filter ); # collect warnings from MARC::File::* object # we use the warnings() method here since MARC::Batch # hides access to MARC::File objects, and we don't # need to preserve the warnings buffer. my @warnings = $self->{file}->warnings(); if ( @warnings ) { $self->warnings( @warnings ); return if $self->{ strict }; } if ($rec) { # collect warnings from the MARC::Record object # IMPORTANT: here we don't use warnings() but dig # into the the object to get at the warnings without # erasing the buffer. This is so a user can call # warnings() on the MARC::Record object and get back # warnings for that specific record. my @warnings = @{ $rec->{_warnings} }; if (@warnings) { $self->warnings( @warnings ); return if $self->{ strict }; } # return the MARC::Record object return($rec); } } # Get the next file off the stack, if there is one $self->{filename} = shift @{$self->{filestack}} or return; # Instantiate a filename for it my $marcclass = $self->{marcclass}; $self->{file} = $marcclass->in( $self->{filename} ) or return; # call this method again now that we've got a file open return( $self->next( $filter ) ); } =head2 strict_off() If you would like C to continue after it has encountered what it believes to be bad MARC data then use this method to turn strict B. A call to C always returns true (1). C can be handy when you don't care about the quality of your MARC data, and just want to plow through it. For safety, C strict is B by default. =cut sub strict_off { my $self = shift; $self->{ strict } = 0; return(1); } =head2 strict_on() The opposite of C, and the default state. You shouldn't have to use this method unless you've previously used C, and want it back on again. When strict is B calls to next() will return undef when an error is encountered while reading MARC data. strict_on() always returns true (1). =cut sub strict_on { my $self = shift; $self->{ strict } = 1; return(1); } =head2 warnings() Returns a list of warnings that have accumulated while processing a particular batch file. As a side effect the warning buffer will be cleared. my @warnings = $batch->warnings(); This method is also used internally to set warnings, so you probably don't want to be passing in anything as this will set warnings on your batch object. C will return the empty list when there are no warnings. =cut sub warnings { my ($self,@new) = @_; if ( @new ) { push( @{ $self->{warnings} }, @new ); print STDERR join( "\n", @new ) . "\n" if $self->{'warn'}; } else { my @old = @{ $self->{warnings} }; $self->{warnings} = []; return(@old); } } =head2 warnings_off() Turns off the default behavior of printing warnings to STDERR. However, even with warnings off the messages can still be retrieved using the warnings() method if you wish to check for them. C always returns true (1). =cut sub warnings_off { my $self = shift; $self->{ 'warn' } = 0; return 1; } =head2 warnings_on() Turns on warnings so that diagnostic information is printed to STDERR. This is on by default so you shouldn't have to use it unless you've previously turned off warnings using warnings_off(). warnings_on() always returns true (1). =cut sub warnings_on { my $self = shift; $self->{ 'warn' } = 1; } =head2 filename() Returns the currently open filename or C if there is not currently a file open on this batch object. =cut sub filename { my $self = shift; return $self->{filename}; } 1; __END__ =head1 RELATED MODULES L, L =head1 TODO None yet. Send me your ideas and needs. =head1 LICENSE This code may be distributed under the same terms as Perl itself. Please note that these modules are not products of or supported by the employers of the various contributors to the code. =head1 AUTHOR Andy Lester, C<< >> =cut MARC-Record-2.0.7/lib/MARC/Record.pm0000644000175100017510000005177513111154042014631 0ustar gmcgmcpackage MARC::Record; =head1 NAME MARC::Record - Perl extension for handling MARC records =cut use strict; use warnings; use integer; use vars qw( $ERROR ); use MARC::Field; use Carp qw(croak carp); =head1 VERSION Version 2.0.7 =cut use vars qw( $VERSION ); $VERSION = '2.0.7'; use Exporter; use vars qw( @ISA @EXPORTS @EXPORT_OK ); @ISA = qw( Exporter ); @EXPORTS = qw(); @EXPORT_OK = qw( LEADER_LEN ); use vars qw( $DEBUG ); $DEBUG = 0; use constant LEADER_LEN => 24; =head1 DESCRIPTION Module for handling MARC records as objects. The file-handling stuff is in MARC::File::*. =head1 ERROR HANDLING Any errors generated are stored in C<$MARC::Record::ERROR>. Warnings are kept with the record and accessible in the C method. =head1 CONSTRUCTORS =head2 new() Base constructor for the class. It just returns a completely empty record. To get real data, you'll need to populate it with fields, or use one of the MARC::File::* modules to read from a file. =cut sub new { my $class = shift; my $self = { _leader => ' ' x 24, _fields => [], _warnings => [], }; return bless $self, $class; } # new() =head2 new_from_usmarc( $marcblob [, \&filter_func($tagno,$tagdata)] ) This is a wrapper around C for compatibility with older versions of MARC::Record. The C is optional. See L::decode for details. =cut sub new_from_usmarc { my $blob = shift; $blob = shift if (ref($blob) || ($blob eq "MARC::Record")); require MARC::File::USMARC; return MARC::File::USMARC::decode( $blob, @_ ); } =head1 COMMON FIELD RETRIEVAL METHODS Following are a number of convenience methods for commonly-retrieved data fields. Please note that they each return strings, not MARC::Field objects. They return empty strings if the appropriate field or subfield is not found. This is as opposed to the C/C methods which return C if something's not found. My assumption is that these methods are used for quick & dirty reports and you don't want to mess around with noting if something is undef. Also note that no punctuation cleanup is done. If the 245a is "Programming Perl / ", then that's what you'll get back, rather than "Programming Perl". =head2 title() Returns the title from the 245 tag. =cut sub title { my $self = shift; my $field = $self->field(245); return $field ? $field->as_string : ""; } =head2 title_proper() Returns the title proper from the 245 tag, subfields a, n and p. =cut sub title_proper { my $self = shift; my $field = $self->field(245); if ( $field ) { return $field->as_string('anp'); } else { return ""; } } =head2 author() Returns the author from the 100, 110 or 111 tag. =cut sub author { my $self = shift; my $field = $self->field('100|110|111'); return $field ? $field->as_string : ""; } =head2 edition() Returns the edition from the 250 tag, subfield a. =cut sub edition { my $self = shift; my $str = $self->subfield(250,'a'); return defined $str ? $str : ""; } =head2 publication_date() Returns the publication date from the 260 tag, subfield c. =cut sub publication_date { my $self = shift; my $str = $self->subfield(260,'c'); return defined $str ? $str : ""; } =head1 FIELD & SUBFIELD ACCESS METHODS =head2 fields() Returns a list of all the fields in the record. The list contains a MARC::Field object for each field in the record. =cut sub fields { my $self = shift; return @{$self->{_fields}}; } =head2 field( I ) Returns a list of tags that match the field specifier, or an empty list if nothing matched. In scalar context, returns the first matching tag, or undef if nothing matched. The field specifier can be a simple number (i.e. "245"), or use the "." notation of wildcarding (i.e. subject tags are "6.."). =cut my %field_regex; sub field { my $self = shift; my @specs = @_; my @list = (); for my $tag ( @specs ) { my $regex = $field_regex{ $tag }; # Compile & stash it if necessary if ( not defined $regex ) { $regex = qr/^$tag$/; $field_regex{ $tag } = $regex; } # not defined for my $maybe ( $self->fields ) { if ( $maybe->tag =~ $regex ) { return $maybe unless wantarray; push( @list, $maybe ); } # if } # for $maybe } # for $tag return unless wantarray; return @list; } =head2 subfield( $tag, $subfield ) Shortcut method for getting just a subfield for a tag. These are equivalent: my $title = $marc->field('245')->subfield("a"); my $title = $marc->subfield('245',"a"); If either the field or subfield can't be found, C is returned. =cut sub subfield { my $self = shift; my $tag = shift; my $subfield = shift; my $field = $self->field($tag) or return; return $field->subfield($subfield); } # subfield() =for internal =cut sub _all_parms_are_fields { for ( @_ ) { return 0 unless UNIVERSAL::isa($_, 'MARC::Field'); } return 1; } =head2 append_fields( @fields ) Appends the field specified by C<$field> to the end of the record. C<@fields> need to be MARC::Field objects. my $field = MARC::Field->new('590','','','a' => 'My local note.'); $record->append_fields($field); Returns the number of fields appended. =cut sub append_fields { my $self = shift; _all_parms_are_fields(@_) or croak('Arguments must be MARC::Field objects'); push(@{ $self->{_fields} }, @_); return scalar @_; } =head2 insert_fields_before( $before_field, @new_fields ) Inserts the field specified by C<$new_field> before the field C<$before_field>. Returns the number of fields inserted, or undef on failures. Both C<$before_field> and all C<@new_fields> need to be MARC::Field objects. If they are not an exception will be thrown. my $before_field = $record->field('260'); my $new_field = MARC::Field->new('250','','','a' => '2nd ed.'); $record->insert_fields_before($before_field,$new_field); =cut sub insert_fields_before { my $self = shift; _all_parms_are_fields(@_) or croak('All arguments must be MARC::Field objects'); my ($before,@new) = @_; ## find position of $before my $fields = $self->{_fields}; my $pos = 0; foreach my $f (@$fields) { last if ($f == $before); $pos++; } ## insert before $before if ($pos >= @$fields) { $self->_warn("Couldn't find field to insert before"); return; } splice(@$fields,$pos,0,@new); return scalar @new; } =head2 insert_fields_after( $after_field, @new_fields ) Identical to C, but fields are added after C<$after_field>. Remember, C<$after_field> and any new fields must be valid MARC::Field objects or else an exception will be thrown. =cut sub insert_fields_after { my $self = shift; _all_parms_are_fields(@_) or croak('All arguments must be MARC::Field objects'); my ($after,@new) = @_; ## find position of $after my $fields = $self->{_fields}; my $pos = 0; my $found = 0; foreach my $f (@$fields) { if ($f == $after) { $found = 1; last; } $pos++; } ## insert after $after unless ($found) { $self->_warn("Couldn't find field to insert after"); return; } splice(@$fields,$pos+1,0,@new); return scalar @new; } =head2 insert_fields_ordered( @new_fields ) Will insert fields in strictly numerical order. So a 008 will be filed after a 001 field. See C for an additional ordering. =cut sub insert_fields_ordered { my ( $self, @new ) = @_; _all_parms_are_fields(@new) or croak('All arguments must be MARC::Field objects'); ## go through each new field NEW_FIELD: foreach my $newField ( @new ) { ## find location before which it should be inserted EXISTING_FIELD: foreach my $field ( @{ $self->{_fields} } ) { if ( $field->tag() >= $newField->tag() ) { $self->insert_fields_before( $field, $newField ); next NEW_FIELD; } } ## if we fell through then this new field is higher than ## all the existing fields, so we append. $self->append_fields( $newField ); } return( scalar( @new ) ); } =head2 insert_grouped_field( $field ) Will insert the specified MARC::Field object into the record in grouped order and return true (1) on success, and false (undef) on failure. my $field = MARC::Field->new( '510', 'Indexed by Google.' ); $record->insert_grouped_field( $field ); For example, if a '650' field is inserted with C it will be inserted at the end of the 6XX group of tags. After discussion most people wanted the ability to add a new field to the end of the hundred group where it belonged. The reason is that according to the MARC format, fields within a record are supposed to be grouped by block (hundred groups). This means that fields may not necessarily be in tag order. =cut sub insert_grouped_field { my ($self,$new) = @_; _all_parms_are_fields($new) or croak('Argument must be MARC::Field object'); ## try to find the end of the field group and insert it there my $limit = int($new->tag() / 100); my $found = 0; foreach my $field ($self->fields()) { if ( int($field->tag() / 100) > $limit ) { $self->insert_fields_before($field,$new); $found = 1; last; } } ## if we couldn't find the end of the group, then we must not have ## any tags this high yet, so just append it if (!$found) { $self->append_fields($new); } return(1); } =head2 delete_fields( $field ) Deletes a given list of MARC::Field objects from the the record. # delete all note fields my @notes = $record->field('5..'); $record->delete_fields(@notes); delete_fields() will return the number of fields that were deleted. =cut sub delete_fields { my $self = shift; _all_parms_are_fields(@_) or croak('Arguments must be MARC::Field object'); my @fields = @{$self->{_fields}}; my $original_count = @fields; foreach my $deleter (@_) { @fields = grep { $_ != $deleter } @fields; } $self->{_fields} = \@fields; return $original_count - @fields; } =head2 delete_field() Same thing as delete_fields() but only expects a single MARC::Field to be passed in. Mainly here for backwards compatibility. =cut sub delete_field { return delete_fields(@_); } =head2 as_usmarc() This is a wrapper around C for compatibility with older versions of MARC::Record. =cut sub as_usmarc { my $self = shift; require MARC::File::USMARC; return MARC::File::USMARC::encode( $self ); } =head2 as_formatted() Returns a pretty string for printing in a MARC dump. =cut sub as_formatted { my $self = shift; my @lines = ( "LDR " . ($self->{_leader} || "") ); for my $field ( @{$self->{_fields}} ) { push( @lines, $field->as_formatted() ); } return join( "\n", @lines ); } # as_formatted =head2 leader() Returns the leader for the record. Sets the leader if I is defined. No error checking is done on the validity of the leader. =cut sub leader { my $self = shift; my $text = shift; if ( defined $text ) { (length($text) eq 24) or $self->_warn( "Leader must be 24 bytes long" ); $self->{_leader} = $text; } # set the leader return $self->{_leader}; } # leader() =head2 encoding() A method for getting/setting the encoding for a record. The encoding for a record is determined by position 09 in the leader, which is blank for MARC-8 encoding, and 'a' for UCS/Unicode. encoding() will return a string, either 'MARC-8' or 'UTF-8' appropriately. If you want to set the encoding for a MARC::Record object you can use the string values: $record->encoding( 'UTF-8' ); NOTE: MARC::Record objects created from scratch have an a default encoding of MARC-8, which has been the standard for years...but many online catlogs and record vendors are migrating to UTF-8. WARNING: you should be sure your record really does contain valid UTF-8 data when you manually set the encoding. =cut sub encoding { my ($self,$arg) = @_; # we basically report from and modify the leader directly my $leader = $self->leader(); # when setting if ( defined($arg) ) { if ( $arg =~ /UTF-?8/i ) { substr($leader,9,1) = 'a'; } elsif ( $arg =~ /MARC-?8/i ) { substr($leader,9,1) = ' '; } $self->leader($leader); } return substr($leader,9,1) eq 'a' ? 'UTF-8' : 'MARC-8'; } =head2 set_leader_lengths( $reclen, $baseaddr ) Internal function for updating the leader's length and base address. =cut sub set_leader_lengths { my $self = shift; my $reclen = shift; my $baseaddr = shift; if ($reclen > 99999) { carp( "Record length of $reclen is larger than the MARC spec allows (99999 bytes)." ); $reclen = 99999; } substr($self->{_leader},0,5) = sprintf("%05d",$reclen); substr($self->{_leader},12,5) = sprintf("%05d",$baseaddr); # MARC21 defaults: http://www.loc.gov/marc/bibliographic/ecbdldrd.html substr($self->{_leader},10,2) = '22'; substr($self->{_leader},20,4) = '4500'; } =head2 clone() The C method makes a copy of an existing MARC record and returns the new version. Note that you cannot just say: my $newmarc = $oldmarc; This just makes a copy of the reference, not a new object. You must use the C method like so: my $newmarc = $oldmarc->clone; You can also specify field specs to filter down only a certain subset of fields. For instance, if you only wanted the title and ISBN tags from a record, you could do this: my $small_marc = $marc->clone( 245, '020' ); The order of the fields is preserved as it was in the original record. =cut sub clone { my $self = shift; my @keeper_tags = @_; # create a new object of whatever type we happen to be my $class = ref( $self ); my $clone = $class->new(); $clone->{_leader} = $self->{_leader}; my $filtered = @keeper_tags ? [$self->field( @keeper_tags )] : undef; for my $field ( $self->fields() ) { if ( !$filtered || (grep {$field eq $_} @$filtered ) ) { $clone->append_fields( $field->clone ); } } # XXX FIX THIS $clone->update_leader(); return $clone; } =head2 warnings() Returns the warnings (as a list) that were created when the record was read. These are things like "Invalid indicators converted to blanks". my @warnings = $record->warnings(); The warnings are items that you might be interested in, or might not. It depends on how stringently you're checking data. If you're doing some grunt data analysis, you probably don't care. A side effect of calling warnings() is that the warning buffer will be cleared. =cut sub warnings { my $self = shift; my @warnings = @{$self->{_warnings}}; $self->{_warnings} = []; return @warnings; } =head2 add_fields() C is now deprecated, and users are encouraged to use C, C, and C since they do what you want probably. It is still here though, for backwards compatibility. C adds MARC::Field objects to the end of the list. Returns the number of fields added, or C if there was an error. There are three ways of calling C to add data to the record. =over 4 =item 1 Create a MARC::Field object and add it my $author = MARC::Field->new( 100, "1", " ", a => "Arnosky, Jim." ); $marc->add_fields( $author ); =item 2 Add the data fields directly, and let C take care of the objectifying. $marc->add_fields( 245, "1", "0", a => "Raccoons and ripe corn /", c => "Jim Arnosky.", ); =item 3 Same as #2 above, but pass multiple fields of data in anonymous lists $marc->add_fields( [ 250, " ", " ", a => "1st ed." ], [ 650, "1", " ", a => "Raccoons." ], ); =back =cut sub add_fields { my $self = shift; my $nfields = 0; my $fields = $self->{_fields}; while ( my $parm = shift ) { # User handed us a list of data (most common possibility) if ( ref($parm) eq "" ) { my $field = MARC::Field->new( $parm, @_ ) or return _gripe( $MARC::Field::ERROR ); push( @$fields, $field ); ++$nfields; last; # Bail out, we're done eating parms # User handed us an object. } elsif ( UNIVERSAL::isa($parm, 'MARC::Field') ) { push( @$fields, $parm ); ++$nfields; # User handed us an anonymous list of parms } elsif ( ref($parm) eq "ARRAY" ) { my $field = MARC::Field->new(@$parm) or return _gripe( $MARC::Field::ERROR ); push( @$fields, $field ); ++$nfields; } else { croak( "Unknown parm of type", ref($parm), " passed to add_fields()" ); } # if } # while return $nfields; } # NOTE: _warn is an object method sub _warn { my $self = shift; push( @{$self->{_warnings}}, join( "", @_ ) ); return( $self ); } # NOTE: _gripe is NOT an object method sub _gripe { $ERROR = join( "", @_ ); warn $ERROR; return; } 1; __END__ =head1 DESIGN NOTES A brief discussion of why MARC::Record is done the way it is: =over 4 =item * It's built for quick prototyping One of the areas Perl excels is in allowing the programmer to create easy solutions quickly. MARC::Record is designed along those same lines. You want a program to dump all the 6XX tags in a file? MARC::Record is your friend. =item * It's built for extensibility Currently, I'm using MARC::Record for analyzing bibliographic data, but who knows what might happen in the future? MARC::Record needs to be just as adept at authority data, too. =item * It's designed around accessor methods I use method calls everywhere, and I expect calling programs to do the same, rather than accessing internal data directly. If you access an object's hash fields on your own, future releases may break your code. =item * It's not built for speed One of the tradeoffs in using accessor methods is some overhead in the method calls. Is this slow? I don't know, I haven't measured. I would suggest that if you're a cycle junkie that you use Benchmark.pm to check to see where your bottlenecks are, and then decide if MARC::Record is for you. =back =head1 RELATED MODULES L, L, L, L, L =head1 SEE ALSO =over 4 =item * perl4lib (L) A mailing list devoted to the use of Perl in libraries. =item * Library Of Congress MARC pages (L) The definitive source for all things MARC. =item * I (L) Online version of the free booklet. An excellent overview of the MARC format. Essential. =item * Tag Of The Month (L) Follett Software Company's (L) monthly discussion of various MARC tags. =back =head1 TODO =over 4 =item * Incorporate MARC.pm in the distribution. Combine MARC.pm and MARC::* into one distribution. =item * Podify MARC.pm =item * Allow regexes across the entire tag Imagine something like this: my @sears_headings = $marc->tag_grep( qr/Sears/ ); (from Mike O'Regan) =item * Insert a field in an arbitrary place in the record =item * Modifying an existing field =back =head1 BUGS, WISHES AND CORRESPONDENCE Please feel free to email me at C<< >>. I'm glad to help as best I can, and I'm always interested in bugs, suggestions and patches. An excellent place to look for information, and get quick help, is from the perl4lib mailing list. See L for more information about this list, and other helpful MARC information. The MARC::Record development team uses the RT bug tracking system at L. If your email is about a bug or suggestion, please report it through the RT system. This is a huge help for the team, and you'll be notified of progress as things get fixed or updated. If you prefer not to use the website, you can send your bug to C<< >> =head1 IDEAS Ideas are things that have been considered, but nobody's actually asked for. =over 4 =item * Create multiple output formats. These could be ASCII or MarcMaker. =back =head1 LICENSE This code may be distributed under the same terms as Perl itself. Please note that these modules are not products of or supported by the employers of the various contributors to the code. =head1 AUTHORS =over 4 =item * Andy Lester =item * Mike O'Regan =item * Ed Summers =item * Mike Rylander =item * Galen Charlton =back =cut MARC-Record-2.0.7/bin/0000755000175100017510000000000013111154233012320 5ustar gmcgmcMARC-Record-2.0.7/bin/marcdump0000755000175100017510000001247213111151774014073 0ustar gmcgmc#!/usr/bin/perl -w # vi:et:sw=4 ts=4 =head1 NAME marcdump - MARC record dump utility =head1 SYNOPSIS B [options] file(s) =cut use strict; use integer; use Encode; use MARC::File; use MARC::File::USMARC; use MARC::Record; use Getopt::Long; ## flag STDOUT for UTF8 my $opt_print = 1; my $opt_hex = 0; my $opt_quiet = 0; my $opt_stats = 1; my @opt_field = (); my $opt_help = 0; my $opt_lif = 0; my $rc = GetOptions( "version" => sub { print "$0, using MARC::Record v$MARC::Record::VERSION\n"; exit 1; }, "print!" => \$opt_print, "hex!" => \$opt_hex, "lif!" => \$opt_lif, "quiet!" => \$opt_quiet, "stats!" => \$opt_stats, "field=s" => \@opt_field, "debug!" => \$MARC::Record::DEBUG, "help" => \$opt_help, ); my @files = @ARGV; if ( $opt_help || !@files || !$rc ) { print ; exit 1; } my $wants_leader = grep { /LDR/ } @opt_field; my $class = $opt_lif ? "MARC::File::MicroLIF" : "MARC::File::USMARC"; eval "require $class"; # Must be quoted to get path searching my %counts; my %errors; for my $filename ( @files ) { $counts{$filename} = 0; $errors{$filename} = 0; warn "$filename\n" unless $opt_quiet; my $file = $class->in( $filename ) or die $MARC::File::ERROR; while ( my $marc = $file->next() ) { ++$counts{$filename}; warn "$counts{$filename} records\n" if ( !$opt_quiet && ($counts{$filename} % 1000 == 0) ); if ( @opt_field ) { $marc = $marc->clone( @opt_field ); $marc->leader('') unless $wants_leader; } if ( $opt_print ) { if ( $opt_hex ) { print_hex( $marc ); } else { # stifle warnings here in case there's utf8 data being printed no warnings; print $marc->as_formatted, "\n\n"; } } if ( my @warnings = $marc->warnings() ) { ++$errors{$filename}; print join( "\n", @warnings, "" ); } } # while $file->close(); } # for if ( $opt_stats ) { print " Recs Errs Filename\n"; print "----- ----- --------\n"; for my $key ( sort keys %counts ) { printf( "%5d %5d %s\n", $counts{$key}, $errors{$key}, $key ); } # for } # if stats sub print_hex { my $marc = shift; my $raw = $marc->as_usmarc(); print "\n"; my $offset = 0; # dump the leader my $leader = bytes::substr( $raw, 0, MARC::Record::LEADER_LEN ); my $part1 = bytes::substr( $leader, 0, 12 ); my $part2 = bytes::substr( $leader, 12 ); _hex_line_output( $offset, _to_hex($part1), _to_ascii($part1), 48 ); _hex_line_output( $offset+12, _to_hex($part2), _to_ascii($part2), 48 ); $offset += MARC::Record::LEADER_LEN; # dump the directory. If we can't find end-of-field character that # follows the directory, everything following the leader (which we # have already dumped) will be dumped as part of the data section. my $dir_end = bytes::index( $raw, MARC::File::USMARC::END_OF_FIELD, MARC::Record::LEADER_LEN ); if ( $dir_end >= 0 ) { for ( my $n = $offset; $n < $dir_end; $n += MARC::File::USMARC::DIRECTORY_ENTRY_LEN ) { my $dir_entry = bytes::substr( $raw, $n, MARC::File::USMARC::DIRECTORY_ENTRY_LEN ); my $hex = _to_hex( $dir_entry ); my $ascii = bytes::substr( $dir_entry, 0, 3 ) . ' ' . bytes::substr( $dir_entry, 3, 4 ) . ' ' . bytes::substr( $dir_entry, 7, 5 ) ; _hex_line_output( $offset, $hex, $ascii, 48 ); $offset += MARC::File::USMARC::DIRECTORY_ENTRY_LEN; } # dump the end-of-field character that follows the directory _hex_line_output( $offset, _to_hex(MARC::File::USMARC::END_OF_FIELD), '.', 48 ); ++$offset; } # dump the data my $data_offset = 0; while ( $offset < bytes::length($raw) ) { my $chunk = bytes::substr( $raw, $offset, 16 ); _hex_line_output( $data_offset, _to_hex($chunk), _to_ascii($chunk), 48 ); $offset += 16; $data_offset += 16; } } sub _to_ascii { my $raw = shift; if ( defined $raw ) { $raw =~ s/[\x00-\x1f\x7f-\xff]/./g; } return $raw; } sub _to_hex { my $raw = shift; my $result = ''; if ( defined $raw ) { for ( my $n = 0; $n < bytes::length($raw); $n++ ) { $result .= sprintf( '%02x ', ord(bytes::substr($raw, $n, 1)) ); } } $result =~ s/ $//; return $result; } sub _hex_line_output { my $offset = shift; my $hex = shift; my $ascii = shift; my $width = shift; printf( "%05d: %-$width.${width}s %s\n", $offset, $hex, $ascii ); } __END__ Usage: marcdump [options] file(s) Options: --[no]print Print a MicroLIF-style dump of each record --[no]hex If --print active, make the output hexadecimal --lif Input files are MicroLIF, not USMARC --field=spec Specify a field spec to include. There may be many. Examples: --field=245 --field=1XX --[no]quiet Print status messages --[no]stats Print a statistical summary by file at the end --version Print version information --help Print this summary MARC-Record-2.0.7/MANIFEST0000644000175100017510000000241413111154233012702 0ustar gmcgmcbin/marcdump Changes lib/MARC/Batch.pm lib/MARC/Doc/Tutorial.pod lib/MARC/Field.pm lib/MARC/File.pm lib/MARC/File/Encode.pm lib/MARC/File/MicroLIF.pm lib/MARC/File/USMARC.pm lib/MARC/Record.pm Makefile.PL MANIFEST README t/00.load.t t/10.camel.t t/11.astring.t t/12.ldr.t t/20.clone.t t/50.batch.t t/60.insert.t t/60.update.t t/61.append.t t/61.replace.t t/62.before.t t/63.after.t t/64.create.t t/66.grouped.t t/66.ordered.t t/67.subfield.t t/68.subfields.t t/70.croak.t t/75.warnings.t t/80.alphatag.t t/81.decode.t t/82.baddir.t t/83.indicators.t t/85.fh.t t/alphatag.lif t/baddir.usmarc t/badind.usmarc t/badldr.usmarc t/batch-filter.t t/camel.usmarc t/cameleof.usmarc t/convenience.t t/decode-filter.t t/delete-field.t t/delete-subfield.t t/dosEOF.t t/extra_controlfields.t t/file-filter.t t/file-header.t t/filler.t t/filler.usmarc t/lineendings-0a.lif t/lineendings-0d.lif t/lineendings-0d0a.lif t/lineendings.t t/pod-coverage.t t/pod.t t/rename-field.t t/rt67094_field_sans_subfields.t t/sample1.lif t/sample1.usmarc t/sample100.lif t/sample1eof.usmarc t/sample20.lif t/title_proper.t t/title_proper.usmarc t/utf8.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) MARC-Record-2.0.7/README0000644000175100017510000000304213111151774012436 0ustar gmcgmcMARC::Record and its family =========================== SYNOPSIS The MARC::* series of modules create a simple object-oriented abstraction of MARC record handling. The files are: MARC::Doc::Tutorial A tutorial explaining how to use MARC::Record. MARC::Record The core class for representing a single MARC record. MARC::Field Another core class for representing a single field in a record. MARC::Batch The basic object for access to a batch of one or more MARC records. MARC::File Base class for the MARC file. MARC::File::USMARC MARC::File::MicroLIF Subclasses of MARC::File specific to the USMARC and MicroLIF formats MARC::Lint Extension to check MARC records for validity. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES MARC::Record now requires a perl version >= 5.8.2 for processing unicode correctly. COPYRIGHT AND LICENCE Copyright (C) 2001-2013 by contributors: 2001-2007 Andy Lester 2002-2007 Ed Summers 2003-2005 Eric Lease Morgan 2003 Morbus Iff 2004-2005 Bryan Baldus 2004 Mark Jordan 2007 Mike Rylander 2007 Dan Scott 2009 Bill Dueber 2010-2013 Galen Charlton 2010 Frédéric Demians 2010 Dan Wells 2010 Alex Arnaud 2010 Colin Campbell 2013 Robin Sheat This software is free software and may be distributed under the same terms as Perl itself . MARC-Record-2.0.7/Makefile.PL0000644000175100017510000000142313111151774013531 0ustar gmcgmc# vi:et:sw=4 ts=4 require v5.8.2; use strict; use ExtUtils::MakeMaker; &WriteMakefile( NAME => 'MARC::Record', DISTNAME => 'MARC-Record', VERSION_FROM => 'lib/MARC/Record.pm', ABSTRACT_FROM => 'lib/MARC/Record.pm', PMLIBDIRS => [ qw( lib/ ) ], AUTHOR => 'Galen Charlton ', LICENSE => 'perl', PREREQ_PM => { 'Test::More' => 0, 'File::Spec' => 0, 'File::Find' => 0, 'Carp' => 0, }, EXE_FILES => [ qw( bin/marcdump ) ], dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, depend => { Makefile => '$(VERSION_FROM)' }, clean => { FILES => 'MARC-Record-*' }, );