r2193 - in packages: . libmarc-perl libmarc-perl/branches libmarc-perl/branches/upstream libmarc-perl/branches/upstream/current libmarc-perl/branches/upstream/current/eg libmarc-perl/branches/upstream/current/t

gregor herrmann gregoa-guest at costa.debian.org
Sat Feb 25 20:44:29 UTC 2006


Author: gregoa-guest
Date: 2006-02-25 20:44:00 +0000 (Sat, 25 Feb 2006)
New Revision: 2193

Added:
   packages/libmarc-perl/
   packages/libmarc-perl/branches/
   packages/libmarc-perl/branches/upstream/
   packages/libmarc-perl/branches/upstream/current/
   packages/libmarc-perl/branches/upstream/current/Changes
   packages/libmarc-perl/branches/upstream/current/MANIFEST
   packages/libmarc-perl/branches/upstream/current/MARC.pm
   packages/libmarc-perl/branches/upstream/current/Makefile.PL
   packages/libmarc-perl/branches/upstream/current/README
   packages/libmarc-perl/branches/upstream/current/README.txt
   packages/libmarc-perl/branches/upstream/current/eg/
   packages/libmarc-perl/branches/upstream/current/eg/addlocal.pl
   packages/libmarc-perl/branches/upstream/current/eg/fixlocal.pl
   packages/libmarc-perl/branches/upstream/current/eg/microlif.001
   packages/libmarc-perl/branches/upstream/current/eg/specials.001
   packages/libmarc-perl/branches/upstream/current/eg/uclocal.pl
   packages/libmarc-perl/branches/upstream/current/t/
   packages/libmarc-perl/branches/upstream/current/t/MARCopt.pm
   packages/libmarc-perl/branches/upstream/current/t/badmarc.dat
   packages/libmarc-perl/branches/upstream/current/t/brkrtest.ref
   packages/libmarc-perl/branches/upstream/current/t/makrbrkr.mrc
   packages/libmarc-perl/branches/upstream/current/t/makrtest.bad
   packages/libmarc-perl/branches/upstream/current/t/makrtest.src
   packages/libmarc-perl/branches/upstream/current/t/marc.dat
   packages/libmarc-perl/branches/upstream/current/t/marc4.dat
   packages/libmarc-perl/branches/upstream/current/t/test1.t
   packages/libmarc-perl/branches/upstream/current/t/test2.t
   packages/libmarc-perl/branches/upstream/current/t/test3.t
   packages/libmarc-perl/branches/upstream/current/t/test4.t
   packages/libmarc-perl/branches/upstream/current/t/test5.t
   packages/libmarc-perl/tags/
Log:
[svn-inject] Installing original source of libmarc-perl

Added: packages/libmarc-perl/branches/upstream/current/Changes
===================================================================
--- packages/libmarc-perl/branches/upstream/current/Changes	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/Changes	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,276 @@
+0.3  Mon Aug 23 19:39:00 1999
+
+0.4  Sun Sep  5 13:49:00 1999
+
+0.5  Sun Sep  5 19:45:00 1999
+
+0.6  Mon Sep  6 18:17:00 1999
+	- consolidate into single file
+
+-------------------------------------------------------------
+Revision history for Perl extension MARC.
+
+0.01  Tue Sep  7 10:48:10 1999
+	- original version; created by h2xs 1.18
+	- linux command: h2xs -A -X -n MARC
+
+0.61  Tue Sep  7 12:56:23 CDT 1999
+	- convert version 0.6 into CPAN format (lots of little changes)
+
+0.62  Fri Sep 10 05:18:00 1999
+	- revised datastructure to hash of tags plus non-tag elements
+	  like 'array' which serve as structured views into data
+
+0.63  Sun Sep 12 20:38:00 1999
+	- permit incremental processing to reduce memory footprint
+
+0.65  Fri Sep 17 08:07:42 1999
+	- add openmarc,nextmarc,closemarc,deletemarc
+
+0.7   Sun Sep 21 07:15:00 1999
+	- major upgrade: revise new for incremental reads and tag maps
+	- add selectmarc,searchmarc, createrecord, _joinfield, addfield
+	- add error processing and use Carp
+	- add header/body/footer outputs
+	- revise documentation
+
+0.71  Wed Sep 22 15:50:31 1999
+	- compute @tags once in _marc2html, fix $outputall detection
+	- add Win32 test and install
+	- t/test1.t uses new output file spec, tests append & $var
+
+0.72  Fri Sep 24 07:42:00 1999
+	- add getvalue
+	- add doc example: xml_header, xml_body, xml_footer
+	- add doc example: createrecord, addfield
+
+0.80  Sun Oct  3 17:14:00 1999
+	- add isbd and unimarc
+
+0.81  Mon Oct  4 22:25:17 CDT 1999
+	- update CPAN doc files: Changes, README, Makefile.PL
+	- add isbd to t/test1.t
+
+0.82  Wed Oct  6 13:30:22 CDT 1999
+	- Win32 Makefile.PL improvements including automatic html install
+	- Added single quotes to hash keys in MARC.pm and t/test1.t to
+	  eliminate nuisance warnings from Perl 5.004.
+
+0.83  Mon Oct 11 22:22:00 EST 1999
+	- Updated MARC.pm line 108 to store scalar references instead of
+	  scalars. This will hopefully cut down on duplication of data in
+	  the MARC object.
+	- Also, updated the getvalue(), searchmarc() and addfield() methods to 
+	  reflect the change in the way subfield data is stored.
+	- Added line 220 to return '0 but true' instead of 0 when no records
+	  were read in. This will allow for statements like
+	  $x->openmarc("test.mrc") || die;
+
+0.84  Tue Oct 12 22:07:18 CDT 1999
+	- more Win32 Makefile.PL tweaks after TPJ technical review
+	- add binmode for marc file read/write
+	- unspecified 'increment' defaults to 0
+	- fix repeated subfield in field bug in addfield
+
+0.85  Wed Oct 13 21:19:00 EST 1999
+	- modified addfield to push scalar references instead of scalars when 
+	  adding subfield data to the $x->[record]{field}{subfield} data member
+	  on line 859.
+	- updated closemarc to return 1, to allow constructs like
+	  $x->closemarc() || die;
+
+0.9   Sun Oct 17 19:48:00 EST 1999
+	- modified deletemarc() to support deleting specified fields and
+	  subfields
+	- modified addfield() to support adding fields in tag order
+
+0.91  Tue Oct 19 18:01:43 CDT 1999
+	- add demo addlocal.pl, microlif.001, and directory eg
+	- closemarc() returns results of close()
+	- filter '\r' and '\cZ' from binary input stream
+	- fix "delete all records" bug
+
+0.911 Wed Oct 20 21:49:02 CDT 1999 <Birthisel>
+	- add "exists" tests to getvalue()
+	- use scalar $callno in addlocal.pl
+
+0.92  Sat Oct 23 00:00:00 CDT 1999 <Lane>
+	- initialize loop counter in getvalue() to avoid warnings
+	- add methods for manipulating "000" and "008" fields:
+		unpack_ldr,	bib_format,	unpack_008
+	- add internal subroutines supporting those methods:
+		_unpack_ldr,	_bib_format,	_unpack_008,
+	- add internal update subroutines:
+		_pack_ldr,	_pack_008
+	
+0.93  Wed Oct 27 21:30:17 CDT 1999 <Birthisel>
+	- deprecate length(), use marc_count() instead
+	- new: bless earlier so _readxxx can use methods
+	- add error checks to file open/close, use binmode
+	- add lineterm for _readmarcmaker and default to DOS
+	- always store header in $record->{'000'} tag position
+	- fix bugs in 'i12' subfield structure
+	- add usmarc_default, ustext_default, MARCMaker charset encode/decode
+	- use createrecord, addfield in _readmarcmaker
+	- fix fieldnotvalue in searchmarc
+	- extensive changes to getvalue to cover '000' tag and indicators
+	- use getvalue in unpack_008
+	- return undef instead of die in _unpack_008
+	- allow lineterm option in output, 'format' defaults to 'marc',
+	  lineterm to '\n' except MARCMaker (CRLF)
+	- add nolinebreak option for MARCBreaker output
+	- 'html_header' outputs "Content-type...", 'html_start' does "<body>"
+	- _writemarc also updates '000' size data in structure
+	- warnings off in addfield
+	- update copyright
+	- add test2.t and test3.t plus supporting files: makrbrkr.mrc,
+	  brkrtest.ref, makrtest.src
+	- add filestring and out_cmp test utilities, MARCopt.pm stub
+	- add MARCMaker/Breaker, getvalue, and searchmarc tests
+
+0.94  Thu Oct 28 20:23:57 CDT 1999 <Birthisel>
+	- added numerous "exists" tests for hash queries
+	- add 'title' parameter to html_start
+	- extra error checking: addfield
+	- new getupdate() method
+	- add tests for searchmarc, deletemarc, addfield, getupdate,
+	  html_xxx formats
+	- fix test3.t to use MARCopt everywhere
+
+0.95  Tue Nov 02 20:49:09 CST 1999 <Birthisel>
+	- clean up the Win32 "make clean" implementation in Makefile.PL
+	- add tests for selectmarc
+	- add 'title' option for URLs output
+	- terminate addfield if $subfield_id eq "\036" from getupdate()
+	- pod updates: SYNOPSIS, Option Template, various typos
+	- add updaterecord()
+	- template extensions for deletemarc(), searchmarc(), getvalue()
+	- add eg/fixlocal.pl demo and eq/specials.001
+
+0.95d  Wed Nov 03 17:00:01 EST 1999 <Lane>
+	- Removed FF_ prefix from @LDR_FIELDS. Left package globals for
+          fixed fields and leaders as globals: this should facilitate
+	  anybody who wants to subclass for MFHL, community, records.
+	- Added pack_008 and pack_ldr. Added get_hash_008 and
+	  get_hash_ldr for future tied interface. Fixed bugs. 
+	  (FF_ prefixes in hash keys.)
+	- Added and updated docs for the new functions.
+	- Added comment on how to renumber tests.
+	- Added tests of pack_008 and pack_ldr. Fixed some test bugs
+	  with FF_ prefixes and non-existent functions.
+
+0.96   Wed Nov  3 23:04:31 CST 1999 <Birthisel>
+	- fix typos in pod2man and pod2html output
+	- fix test3.t like test1.t
+
+0.97   Fri Nov  5 17:44:15 CST 1999 <Birthisel>
+	- replace '%$' construct (4 places) which designates pseudo-hash
+	  in 5.005 and fails in 5.004. Detected by CPAN-Testers
+	- Add tests for deletemarc() subfield to t/test2.t
+
+0.98   Fri Nov 12 21:13:39 CST 1999 <Birthisel>
+	- fix addfield reorder bug (new tag > existing)
+	- improved eg/addlocal.pl and added eg/uclocal.pl
+	- moved binmode from _readmarc* to openmarc() and new() to get around
+	  unwanted seek on binmode in Win32 5.00402.
+
+0.99   Sun Nov 14 21:59:00 EST 1999 <Summers>
+        - created MARC::XML subclass to handle MARC<->XML conversions
+        - moved _marc2xml() from MARC.pm into MARC::XML
+
+0.991  Sun Nov 21 18:49:00 EST 1999 <Summers>
+        - removed MARC::XML specific pod from MARC.pm and added to MARC::XML
+
+1.00   Mon Nov 22 22:22:32 CST 1999 <Birthisel>
+	- add warnings for unsupported output formats
+	- return undef for output failure, test in place of XML
+
+1.01   Sun Dec 05 23:14:15 CST 1999 <Birthisel>
+	- add invalid size checks to _readmarc()
+	- add header check to _readmarcmaker()
+	- delete length() method and CORE::length() overrides
+	- add $TEST; replace carp with mycarp
+
+1.02u  Mon Dec 20 06:52:00 EST 1999 <Lane>
+	- added *map* series; supports a data-index view of marc.
+	- added deletefirst and updatefirst to support ties
+	- added getmatch and insertpos to support update or insert
+	   of subfields.
+	- added getfields/updatefields for fine-grained access to
+	   the {array} structures. Allows "in-place" update of fields.
+	- changed add_fields to use add_map. Lets subclasses have a
+	   policy of how they want their indices to look.
+	- changed _readmarc and _readmarcmaker to use add_map. Good
+	   for testing.
+	- Added simple tests for *first and *map* series as test4.t
+	   More complex and complete tests are in MARC::Tie.
+	- Added docs for *map*, getmatch,*fields*,getmatch and insertpos.
+
+1.03   Mon Jan 17 15:21:54 CST 2000 <Birthisel>
+	- Use fill char "|" for "none" in eg/addlocal.pl
+	- integrate "102u" changes into CPAN format
+	- fix bug in addfield where add_map not called if ($tag<10)
+
+1.04   Mon Jan 24 22:31:26 CST 2000 <Birthisel>
+	- oops, had to fix the Win32 5.00402 binmode again (c.f 0.98)
+	- added quotes to 'rebuild_map' used as hash key (5.004 warnings)
+	- add docs for "keys" in hash returned by 'unpack_ldr'
+	- add xml format error messages
+
+1.05   Sat Jan 29 22:59:03 EST 2000 <Lane>
+	- Removed unnecessary quotes in various potentially tainted variables.
+	- Removed bad references to FF_* in docs.
+	- Updatefields() no longer assumes that fields with the same tag are 
+	  contiguous (e.g. cjk).
+	- Getfields() no longer assumes that fields with the same tag are 
+	  contiguous (again, cjk).
+	- Docs updated to reflect the relaxed assumption.
+	- Extensive quoting of keys for a more warning-free experience.
+	
+	Sun Jan 30 14:34:02 EST 2000 <Lane>
+	- Created add_005s(), _make_005().
+	- Inserted add_005s into output so now we are correctly datestamped.
+	- Docs added for 005 functionality.
+	
+	Mon Jan 31 12:55:52 EST 2000 <Lane>
+	- Fixed $args->{'record'} complaint if $args does not exist.
+	- Now we return "19960221075055.7" when in $TEST mode for 005.
+	- Fixed and updated test2.t and test files makrbrkr.mrc and
+	  makrtest.src. (now have all canonical 005's; makrtest had a
+	  17 digit time, not 16 in the first record).
+
+1.06   Sun Feb 27 22:00:00 EST 2000 <Lane>
+	- Added getfirstvalue to avoid dependency on index for Ties.
+	- Added from_string and as_string; mainly for Tie
+	  but also has promise for searchmarc. Added option to rebuild map. 
+	- Created MARC::Rec and started moving functions to it.
+
+	Thu Mar  9 22:00:00 EST 2000 <Lane>
+	- Finished the bulk of ::Rec-ising.
+	- Normalised {records}-{record} handling and %params creation 
+	  (_records and _params).
+	- Updated searchmarc and deletemarc to more idiomatic Perl; fixed bugs.
+	  (Deletemarc was not updating {$tag}{$field}{subfield} information
+	  correctly; it does now since it uses rebuild_map).
+	- Fixed one potential problem in _urls (looked at indicators when it
+	  should have only been looking at subfields).
+
+	Sat Mar 11 22:00:00 EST 2000 <Lane>
+	- Checked that a subclass of MARC(:Btrieve) works even in the presence
+	  of MARC::Rec dependencies.
+	- Tested Tie::MARC and Tie::MARC::Btrieve against 1.06
+	- Fixed bugs. All tests pass.
+	- Updated Docs to reflect pervasive MARC::Rec presence and (few)
+	  additional functions.
+
+	Sun Mar 12 14:39:27 EST 2000 <Lane>
+	- Configured shipping script for MARC.
+	- Fixed numbering in test5.t. All tests pass.
+	- Added option to read from a string for MARC::Rec. (nextmarc())
+
+1.07   Sun Apr 23 16:41:46 CDT 2000A <Birthisel>
+	- convert all usage to $MARC::TEST, $MARC::DEBUG. Clean up other
+	  "use vars" variables only needed in one package. Sync $VERSION.
+	- Perl 5.6.0 warns on "join (//,", use "join (''," instead.
+	- fixes to $naptime and $testfile in t/test5.t
+	- openmarc did not set 'handle' and 'format' for MARC::Rec

Added: packages/libmarc-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libmarc-perl/branches/upstream/current/MANIFEST	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/MANIFEST	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,24 @@
+Changes
+MANIFEST
+MARC.pm
+Makefile.PL
+README
+README.txt
+t/test1.t
+t/test2.t
+t/test3.t
+t/test4.t
+t/test5.t
+t/badmarc.dat
+t/marc.dat
+t/marc4.dat
+t/MARCopt.pm
+t/makrbrkr.mrc
+t/makrtest.src
+t/makrtest.bad
+t/brkrtest.ref
+eg/uclocal.pl
+eg/addlocal.pl
+eg/fixlocal.pl
+eg/microlif.001
+eg/specials.001

Added: packages/libmarc-perl/branches/upstream/current/MARC.pm
===================================================================
--- packages/libmarc-perl/branches/upstream/current/MARC.pm	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/MARC.pm	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,4066 @@
+package MARC;
+
+use Carp;
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG $TEST);
+
+$VERSION = '1.07';
+$MARC::DEBUG = 0;
+$MARC::TEST = 0;
+
+require Exporter;
+require 5.004;
+
+ at ISA = qw(Exporter);
+ at EXPORT= qw();
+ at EXPORT_OK= qw();
+
+#### Not using these yet
+
+#### %EXPORT_TAGS = (USTEXT	=> [qw( marc2ustext )]);
+#### Exporter::export_ok_tags('USTEXT');
+#### $EXPORT_TAGS{ALL} = \@EXPORT_OK;
+
+
+# Preloaded methods go here.
+
+sub mycarp { # rec
+    Carp::carp (@_) unless $MARC::TEST;
+}
+
+####################################################################
+# This is the constructor method that creates the MARC object. It  #
+# will call the appropriate read using the file and format         #
+# parameters that are passed.                                      #
+####################################################################
+sub new { # rec
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my $file = shift;
+    my $marc = []; 
+    my $totalrecord;
+    $marc->[0]{'increment'}=-1; #store the default increment in the object
+    my $proto_rec;
+#    print STDERR "foo\n";
+    { 
+	# We are going to look for related classes in Perl's
+	# symbol table. This is a little tricky.
+	# Shoot me.
+	
+	no strict 'refs';
+	# Next, we set up a symbolic reference.
+	my $g = $ {$class.'::Rec::VERSION'}; # space for emacs.
+	# That was a sample of Perl reflection. Yup, what Smalltalk
+	# does with Class and MetaClass, Perl does with strings.
+	# Not much structure, but also not much fuss.
+
+        my $rec_class = $class."::Rec" if $g;
+	# Now we will use the related Rec class if it exists.
+        $rec_class ||= "MARC::Rec";
+    
+	$proto_rec = $rec_class->new();
+    }
+
+    $marc->[0]{'proto_rec'}=$proto_rec; # Used for future manipulations.
+    bless ($marc, $class);
+	# bless early so _readxxx can use methods
+        #if file isn't defined then just return the empty MARC object
+    if ($file) {
+        unless (-e $file) {mycarp "File $file doesn't exist"; return}
+	    #if the file doesn't exist return an error
+        my $format = shift || "usmarc";
+	    # $format defaults to USMARC if undefined
+	open(*file, $file) or mycarp "Open Error: $file, $!";
+	binmode *file;
+	$marc->[0]{'handle'}=\*file;
+	$proto_rec->{'handle'} = $marc->[0]{'handle'};
+	$proto_rec->{'format'} = lc $format;
+        if ($format =~ /usmarc$/io) {
+	    $marc->[0]{'format'}='usmarc';
+	    $totalrecord = _readmarc($marc);
+	    close *file or mycarp "Close Error: $file, $!";
+        }
+        elsif ($format =~ /unimarc$/io) {
+	    $marc->[0]{'format'}='unimarc';
+	    $totalrecord = _readmarc($marc);
+	    close *file or mycarp "Close Error: $file, $!";
+        }
+        elsif ($format =~ /marcmaker$/io) {
+	    $marc->[0]{'lineterm'}="\015\012";	# MS-DOS default for MARCMaker
+	    $totalrecord = _readmarcmaker($marc);
+	    close *file or mycarp "Close Error: $file, $!";
+        }
+        elsif ($format =~ /xml/oi) {
+	    mycarp "XML formats are now handled by MARC::XML";
+	    return;
+        }
+        else {
+	    mycarp "I don't recognize format $format";
+	    return;
+        }
+    }
+    print "read in $totalrecord records\n" if $MARC::DEBUG;
+    return $marc;
+}
+####################################################################
+
+# clone returns a new MARC object with copies of the data.
+# Admin information remains linked to original.
+
+####################################################################
+
+sub clone {
+    my $marc = shift;
+    my $class = shift || ref $marc;
+    my $ans = $marc->new;
+    bless $ans, $class;
+    $ans->[0] = $marc->[0];
+    foreach my $i (1..$#$marc) {
+	my $rec = $marc->[$i];
+
+	my $newrec = $rec->clone();
+	bless $newrec, $class."::Rec";
+	push @$ans, $newrec;
+    }
+    return $ans;
+}
+
+###################################################################
+# _readmarc() reads in a MARC file into the $marc object           #
+###################################################################
+sub _readmarc { # also rec
+    my $marc = shift;
+    my $handle = $marc->[0]{'handle'};
+    my $proto_rec = $marc->[0]{'proto_rec'};
+    my $increment = $marc->[0]{'increment'}; #pick out increment from the object
+    my $recordcount = 0;
+
+    while ($increment==-1 || $recordcount<$increment) {
+	my ($rec,$status)=$proto_rec->_readmarc();
+	last unless $status;
+	if ($status == -1) {
+	    mycarp "Invalid record, size does not match leader";
+	    return unless $recordcount;	# undef if first
+	    return -$recordcount;	        # if some are valid		
+	}
+	if ($status == -2) {
+	    mycarp "Invalid record, leader size not numeric";
+	    return unless $recordcount;	# undef if first
+	    return -$recordcount;	        # if some are valid		
+	}
+	push @$marc, $rec;
+	$recordcount++;
+    } #end processing this record
+    return $recordcount;
+} 
+
+###################################################################
+# readmarcmaker() reads a marcmaker file into the MARC object     #
+###################################################################
+sub _readmarcmaker { # rec
+    my $marc = shift;
+    my $handle = $marc->[0]{'handle'};
+    my $proto_rec = $marc->[0]{'proto_rec'};
+    my $increment = $marc->[0]{'increment'}; #pick out increment from the object
+    unless (exists $marc->[0]{'makerchar'}) {
+        $marc->[0]{'makerchar'} = usmarc_default();	# hash ref
+	$proto_rec->{'makerchar'} = $marc->[0]{'makerchar'};
+    }
+    my $recordcount = 0;
+
+    while ($increment==-1 or $recordcount<$increment) {
+	my ($rec,$status) = $proto_rec->_readmarcmaker();
+	last unless $status;
+	if ($status == -1)  {
+	    mycarp 'Invalid record, prefix "=LDR  " not found';
+	    return unless $recordcount;	# undef if first
+	    return -$recordcount;	# if some are valid		
+	}
+	push @$marc, $rec;
+	$recordcount++;
+    } #end reading this record
+    return $recordcount;
+}
+
+sub _maker2char { # rec
+    return MARC::Rec::_maker2char(@_);
+}
+
+sub usmarc_default { # rec
+    return MARC::Rec::usmarc_default(@_);
+}
+
+####################################################################
+# marc_count() returns the number of records in a                  #
+# particular MARC object                                           #
+####################################################################
+sub marc_count {
+    my $marc=shift;
+    return $#$marc;
+}
+
+####################################################################
+# openmarc() is a method for reading in a MARC file. It takes      #
+# several parameters: file (name of the marc file) ; format, ie.   #
+# usmarc ; and increment which defines how many records to read in #
+####################################################################
+sub openmarc {
+    my $marc=shift;
+    my $params=shift;
+    my $file=$params->{'file'};
+    if (not(-e $file)) {mycarp "File \"$file\" doesn't exist"; return} 
+    $marc->[0]{'format'}=$params->{'format'}; #store format in object
+    my $totalrecord;
+    $marc->[0]{'increment'}=$params->{'increment'} || 0;
+        #store increment in the object, default is 0
+    unless ($marc->[0]{'format'}) {$marc->[0]{'format'}="usmarc"}; #default to usmarc
+    open(*file, $file) or mycarp "Open Error: $file, $!";
+    binmode *file;
+    $marc->[0]{'handle'}=\*file; #store filehandle in object
+    my $proto_rec = $marc->[0]{'proto_rec'};
+    $proto_rec->{'handle'} = $marc->[0]{'handle'};
+    $proto_rec->{'format'} = lc $marc->[0]{'format'};
+    if ($marc->[0]{'format'} =~ /usmarc/oi) {
+	$totalrecord = _readmarc($marc);
+    }
+    elsif ($marc->[0]{'format'} =~ /marcmaker/oi) {
+        if (exists $params->{'charset'}) {
+	    $marc->[0]{makerchar} = $params->{'charset'};	# hash ref
+	}
+	else {
+            unless (exists $marc->[0]{'makerchar'}) {
+	        $marc->[0]{makerchar} = usmarc_default();	# hash ref
+	    }
+        }
+        $marc->[0]{'lineterm'} = $params->{'lineterm'} || "\015\012";
+	$totalrecord = _readmarcmaker($marc);
+    }
+    else {
+	close *file;
+        if ($params->{'format'} =~ /xml/oi) {
+	    mycarp "XML formats are now handled by MARC::XML";
+        }
+	else {
+	    mycarp "Unrecognized format $marc->[0]{'format'}";
+        }
+	return;
+    }
+    print "read in $totalrecord records\n" if $MARC::DEBUG;
+    if ($totalrecord==0) {$totalrecord="0 but true"}
+    return $totalrecord;    
+}
+
+####################################################################
+# closemarc() will close a file-handle that was opened with        #
+# openmarc()                                                       #
+####################################################################
+sub closemarc {
+    my $marc = shift;
+    $marc->[0]{'increment'}=0;
+    if (not($marc->[0]{'handle'})) {
+	mycarp "There isn't a MARC file to close"; 
+	return;
+    }
+    my $ok = close $marc->[0]{'handle'};
+    $marc->[0]{'handle'}=undef;
+    return $ok;
+}
+
+####################################################################
+# nextmarc() will read in more records from a file that has      #
+# already been opened with openmarc(). the increment can be        #
+# adjusted if necessary by passing a new value as a parameter. the # 
+# new records will be APPENDED to the MARC object                  #
+####################################################################
+sub nextmarc {
+    my $marc=shift;
+    my $increment=shift;
+    my $totalrecord;
+    if (not($marc->[0]{'handle'})) {
+	mycarp "There isn't a MARC file open"; 
+	return;
+    }
+    if ($increment) {$marc->[0]{'increment'}=$increment}
+    if ($marc->[0]{'format'} =~ /usmarc/oi) {
+	$totalrecord = _readmarc($marc);
+    }
+    elsif ($marc->[0]{'format'} =~ /marcmaker/oi) {
+	$totalrecord = _readmarcmaker($marc);
+    }
+    else {return}   
+    return $totalrecord;
+}
+
+####################################################################
+
+# add_map() takes a recnum and a ref to a field in ($tag,
+# $i1,$i2,a=>"bar",...) or ($tag, $field) formats and will append to
+# the various indices that we have hanging off that record.  It is
+# intended for use in creating records de novo and as a component for
+# rebuild_map(). It carefully does not copy subfield values or entire
+# fields, maintaining some reference relationships.  What this means
+# for indices created with add_map that you can directly edit
+# subfield values in $marc->[recnum]{array} and the index will adjust
+# automatically. Vice-versa, if you edit subfield values in
+# $marc->{recnum}{tag}{subfield_code} the fields in
+# $marc->[recnum]{array} will adjust. If you change structural
+# information in the array with such an index, you must rebuild the
+# part of the index related to the current tag (and possibly the old
+# tag if you change the tag).
+
+####################################################################
+
+sub add_map { # rec
+    my $marc=shift;
+    my $recnum = shift;
+    my $rafield = shift;
+    $marc->[$recnum]->add_map($rafield);
+}
+
+####################################################################
+
+# rebuild_map() takes a recnum and a tag and will synchronize the
+# index with all elements in the [recnum]{array} with that tag.
+
+####################################################################
+sub rebuild_map { # rec
+    my $marc=shift;
+    my $recnum = shift;
+    my $tag = shift;
+    return undef if $tag eq '000'; #currently ldr is different...
+    $marc->[$recnum]->rebuild_map($tag);
+}
+
+####################################################################
+
+# rebuild_map_all() takes a recnum and will synchronize the
+# index with all elements in the [recnum]{array}
+
+####################################################################
+sub rebuild_map_all { # rec
+    my $marc=shift;
+    my $recnum = shift;
+    $marc->[$recnum]->rebuild_map_all();
+}
+
+####################################################################
+# deletemarc() will delete entire records, specific fields, as     #
+# well as specific subfields depending on what parameters are      #
+# passed to it                                                     #
+####################################################################
+sub deletemarc {
+    my $marc=shift;
+    my $template=shift;
+
+    my $params = _params($template, at _);
+
+    my @delrecords= _records($marc,$params);
+    my %delrecords= map {$_=>1} @delrecords;
+       #if records parameter not passed set to all records in MARC object
+    my $field=$params->{field};
+    my $subfield=$params->{subfield};
+
+    my $deletecount=0;
+    my @keepers = grep {!$delrecords{$_}} (0..$#$marc);
+
+    #delete entire records
+    if (not($field) and not($subfield)) {
+	my $class = ref $marc;
+	my @newmarc = @$marc[@keepers]; # array slice, look it up.
+	@$marc=@newmarc;
+	bless $marc,$class;
+	return @delrecords;
+    }
+
+    #delete fields and/or subfields. deletefirst takes care of the details.
+    # This may be slow. If so write a loop using deletesubfield, etc.
+
+    foreach my $i (1..$#$marc) {
+	next unless $delrecords{$i};
+	my $rec=$marc->[$i];
+	my @newfields =();
+	while (1) {
+	    my $has_subfield = $rec->deletefirst($template);
+	    last unless $has_subfield;
+	    $deletecount++;
+	}
+	$rec->rebuild_map($field);
+    }
+    return $deletecount;
+}
+
+####################################################################
+# selectmarc() performs the opposite function of deletemarc(). It  #
+# will select specified elements of a MARC object and return them  #
+# as a MARC object. So if you wanted to select records 1-10 and 15 #
+# of a MARC object you could say $x=$x->selectmarc(["1-10","15"]); #
+####################################################################
+sub selectmarc {
+    my $marc=shift;
+    my $selarray=shift;
+
+    my @keepers=(0); # so we have admin information.
+    foreach my $selelement (@$selarray) {
+	if ($selelement=~/(\d+)-(\d+)/) {
+	    push @keepers,($1..$2);
+	} else {
+	    push @keepers, $selelement;
+	}
+    }
+    if (not($selarray)) {@{$selarray}= (1..$#$marc)} 
+    my $class = ref $marc;
+    my @newmarc = @$marc[@keepers]; # array slice, look it up.
+    @$marc=@newmarc;
+    bless $marc,$class;
+    return scalar(@keepers) -1; # minus off the $marc->[0] 
+}
+
+####################################################################
+# searchmarc() is method for searching a MARC object for specific  #
+# values. It will return an array which contains the record        #
+# numbers that matched.                                            #
+####################################################################
+sub searchmarc {
+    my $marc=shift;
+    my $template=shift;
+    return unless (ref($template) eq "HASH");
+    my $params = _params($template, at _);
+
+    my $field=$params->{field} || return;
+    my $subfield=$params->{subfield};
+    my $regex=$params->{regex};
+    my $notregex=$params->{notregex};
+    my @results;
+    my $searchtype;
+
+       #determine the type of search 
+    if ($field and not($subfield) and not($regex) and not($notregex)) {
+	$searchtype="fieldpresence"}
+    elsif ($field and $subfield and not($regex) and not($notregex)) {
+	$searchtype="subfieldpresence"}
+    elsif ($field and not($subfield) and $regex) {
+	$searchtype="fieldvalue"}
+    elsif ($field and $subfield and $regex) {
+	$searchtype="subfieldvalue"}
+    elsif ($field and not($subfield) and $notregex) {
+	$searchtype="fieldnotvalue"}
+    elsif ($field and $subfield and $notregex) {
+	$searchtype="subfieldnotvalue"}
+
+       #do the search by cycling through each record
+    for (my $i=1; $i<=$#$marc; $i++) {
+
+	my $flag=0;
+	if ($searchtype eq "fieldpresence") {
+	    next unless exists $marc->[$i]{$field};
+	    push(@results,$i);
+	}
+	elsif ($searchtype eq "subfieldpresence") {
+	    next unless exists $marc->[$i]{$field};
+	    next unless exists $marc->[$i]{$field}{$subfield};
+	    push(@results,$i);
+	}
+	elsif ($searchtype eq "fieldvalue") {
+	    next unless exists $marc->[$i]{$field};
+	    next unless exists $marc->[$i]{$field}{field};
+	    my $x=$marc->[$i]{$field}{field};
+	    foreach my $y (@$x) {
+		my $z=_joinfield($y,$field);
+		if (eval qq("$z" =~ $regex)) {$flag=1}
+	    }
+	    if ($flag) {push (@results,$i)}
+	}
+	elsif ($searchtype eq "subfieldvalue") {
+	    next unless exists $marc->[$i]{$field};
+	    next unless exists $marc->[$i]{$field}{$subfield};
+	    my $x=$marc->[$i]{$field}{$subfield};
+	    foreach my $y (@$x) {
+		if (eval qq("$$y" =~ $regex)) {$flag=1}
+	    }
+	    if ($flag) {push (@results,$i)}
+	}
+	elsif ($searchtype eq "fieldnotvalue" ) {
+	    next unless exists $marc->[$i]{$field};
+	    next unless exists $marc->[$i]{$field}{field};
+	    my $x=$marc->[$i]{$field}{field};
+	    if (not($x)) {push(@results,$i); next}
+	    foreach my $y (@$x) {
+		my $z=_joinfield($y,$field);
+		if (eval qq("$z" =~ $notregex)) {$flag=1}
+	    }
+	    if (not($flag)) {push (@results,$i)}
+	}
+	elsif ($searchtype eq "subfieldnotvalue") {
+	    next unless exists $marc->[$i]{$field};
+	    next unless exists $marc->[$i]{$field}{$subfield};
+	    my $x=$marc->[$i]{$field}{$subfield};
+	    if (not($x)) {push (@results,$i); next}
+	    foreach my $y (@$x) {
+		if (eval qq("$$y" =~ $notregex)) {$flag=1}
+	    }
+	    if (not($flag)) {push (@results,$i)}
+	}
+    }
+    return @results;
+}
+
+####################################################################
+
+# getfirstvalue() will return the first value of a field or subfield
+# or indicator or i12 in a particular record found in the MARC
+# object. It does not depend on the index being up to date.
+
+####################################################################
+sub getfirstvalue { # rec
+    my $marc= shift;
+    my $template=shift;
+    return unless (ref($template) eq "HASH");
+    my $record = $template->{record};
+    if (not($record)) {mycarp "You must specify a record"; return}
+    if ($record > $#{$marc}) {mycarp "Invalid record specified"; return}
+    my $marcrec = $marc->[$record];
+    return $marcrec->getfirstvalue($template);
+
+}
+
+####################################################################
+# getvalue() will return the value of a field or subfield in a     #
+# particular record found in the MARC object                       #
+####################################################################
+sub getvalue { # rec
+    my $marc = shift;
+    my $template=shift;
+    return unless (ref($template) eq "HASH");
+    my $params = _params($template, at _);
+    my $record = $params->{record};
+    if (not($record)) {mycarp "You must specify a record"; return}
+    if ($record > $#{$marc}) {mycarp "Invalid record specified"; return}
+    
+    return $marc->[$record]->getvalue($params);
+}
+
+####################################################################
+#Returns LDR at $record.                                           #
+####################################################################
+sub ldr { # rec
+    my ($self,$record)=@_;
+    return $self->[$record]->ldr();
+}
+
+
+####################################################################
+#Takes a record number and returns a hash of fields.               #
+#Needed to determine the format (BOOK, VIS, etc) of                #
+#the record.                                                       #
+#Folk also like to know what Ctrl, Desc etc are.                   #
+####################################################################
+sub unpack_ldr { # rec
+    my ($self,$record) = @_;
+    return $self->[$record]->unpack_ldr();
+}
+
+    
+sub _unpack_ldr { # rec
+    my ($self,$ldr)=@_;
+    return $self->[0]{proto_rec}->unpack_ldr($ldr);
+}
+
+
+####################################################################
+#Takes a record number.                                            #
+#Returns the unpacked ldr as a ref to hash from the ref in $self.  #
+#Does not overwrite hash from ldr.                                 #
+####################################################################
+sub get_hash_ldr { # rec
+    my ($self,$record)=@_;
+    return $self->[$record]->get_hash_ldr();
+}
+
+####################################################################
+# Takes a record number and updates the corresponding ldr if there
+# is a hashed form. Returns undef unless there is a hash. Else
+# returns $ldr.
+####################################################################
+sub pack_ldr { # rec
+    my ($self,$record)=@_;
+    return $self->[$record]->pack_ldr();
+}
+
+####################################################################
+#Takes a ref to hash version of the LDR and returns a string       #
+# version                                                          #
+####################################################################
+sub _pack_ldr { # rec
+    my ($self,$rhldr) = @_;
+    return $self->[0]{proto_rec}->_pack_ldr($rhldr);
+}
+
+####################################################################
+#Takes a string record number.                                     #
+#Returns a the format necessary to pack/unpack 008 fields correctly#
+####################################################################
+sub bib_format { # rec
+    my ($self,$record)=@_;
+    return $self->[$record]->bib_format();
+}
+
+sub _bib_format { # rec
+    my ($self,$ldr)=@_;
+    return $self->[0]{proto_rec}->_bib_format($ldr);
+}
+
+####################################################################
+#Takes a record number.                                            #
+#Returns the unpacked 008 as a ref to hash. Installs ref in $self. #
+####################################################################
+sub unpack_008 { # rec
+    my ($self,$record) = @_;
+    return $self->[$record]->unpack_008();
+}
+
+sub _unpack_008 { # rec
+    my ($self,$ff_string,$bib_format) = @_;
+    return $self->[0]{proto_rec}->_unpack_008($ff_string,$bib_format);
+}
+
+####################################################################
+#Takes a record number.                                            #
+#Returns the unpacked 008 as a ref to hash from the ref in $self.  #
+#Does not overwrite hash from 008 field.                           #
+####################################################################
+sub get_hash_008 { # rec
+    my ($self,$record)=@_;
+    return $self->[$record]->get_hash_008();
+}
+
+####################################################################
+#Takes a record number. Flushes hashes to 008 and ldr.             #
+#Updates the 008 field from an installed fixed field hash.    
+#Returns undef unless there is a hash, else returns the 008 field  #
+####################################################################
+sub pack_008 { # rec
+    my ($self,$record) = @_;
+    return $self->[$record]->pack_008();
+}
+
+####################################################################
+#Takes LDR and ref to hash of unpacked 008                         #
+#Returns string version of 008 *without* newlines.                 #
+####################################################################
+sub _pack_008 { # rec
+    my ($self,$ldr,$rhff) = @_;
+    return $self->[0]{proto_rec}->_pack_008($ldr,$rhff);
+}
+
+####################################################################
+# _joinfield() is an internal subroutine for creating a string out #
+# of an array of subfields. It takes an optional delimiter         #
+# parameter which will print out subfields if defined              #
+####################################################################
+sub _joinfield { # rec
+    return MARC::Rec->_joinfield(@_);
+}
+
+####################################################################
+
+# _make_005 is a function: it returns the time formatted for the 005
+# field.
+
+####################################################################
+sub _make_005 {
+    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
+    # 1. Official specs for 005 are at 
+    #     lcweb.loc.gov/marc/bibliographic/ecbdcntr.html
+    # They refer to X3.30 ansi; a copy of that would be of interest.
+    # 2. Checked out some examples for existing practice.
+    $year += 1900;
+    $mon++; #$mon is counted from 1 when talking to humans.
+    return  "19960221075055.7" if $MARC::TEST;
+    return sprintf("%0.4d%0.2d%0.2d%0.2d%0.2d%0.2d.0",$year,$mon,$mday,$hour,$min,$sec);
+}
+
+####################################################################
+
+# add_005s takes a template and adds current 005s to the elements of
+# $marc mentioned in $template->{records}
+
+####################################################################
+sub add_005s {
+    my $marc=shift;
+    my $args = shift;
+    my @records;
+    @records= (1..$#$marc);
+    if ($args &&  $args->{'records'} ) {
+	@records =@{$args->{'records'}};
+    }
+
+    my $time = MARC::_make_005() ;
+    foreach my $i (@records) {
+	$marc->[$i]->add_005($time);
+    }
+}
+    
+####################################################################
+# output() will call the appropriate output method using the marc  #
+# object and desired format parameters.                            # 
+####################################################################
+sub output {
+    my $marc=shift;
+    my $args=shift;
+    my $output = "";
+    my $newline = $args->{'lineterm'} || "\n";
+
+     $marc->add_005s($args) if ($args->{'file'} or $args->{'add_005s'});
+
+    unless (exists $args->{'format'}) {
+	    # everything to string
+        $args->{'format'} = "marc";
+        $args->{'lineterm'} = $newline;
+    }
+    if ($args->{'format'} =~ /marc$/oi) {
+	$output = _writemarc($marc,$args);
+    }
+    elsif ($args->{'format'} =~ /marcmaker$/oi) {
+	$output = _marcmaker($marc,$args);
+    }
+    elsif ($args->{'format'} =~ /ascii$/oi) {
+	$output = _marc2ascii($marc,$args);
+    }
+    elsif ($args->{'format'} =~ /html$/oi) {
+        $output .= "<html><body>";
+	$output .= _marc2html($marc,$args);
+        $output .="$newline</body></html>$newline";
+    }
+    elsif ($args->{'format'} =~ /html_header$/oi) {
+	$output = "Content-type: text/html\015\012\015\012";
+    }
+    elsif ($args->{'format'} =~ /html_start$/oi) {
+	if ($args->{'title'}) {
+            $output = "<html><head><title>$args->{'title'}</title></head>";
+	    $output .= "$newline<body>";
+	}
+	else {
+	    $output = "<html><body>";
+	}
+    }
+    elsif ($args->{'format'} =~ /html_body$/oi) {
+        $output =_marc2html($marc,$args);
+    }
+    elsif ($args->{'format'} =~ /html_footer$/oi) {
+	$output = "$newline</body></html>$newline";
+    }
+    elsif ($args->{'format'} =~ /urls$/oi) {
+	my $title = $args->{'title'} || "Untitled URLs";
+        $output .= "<html><head><title>$title</title></head>$newline<body>$newline";
+	$output .= _urls($marc,$args);
+        $output .="</body></html>";
+    }
+    elsif ($args->{'format'} =~ /isbd$/oi) {
+	$output = _isbd($marc,$args);
+    }
+    elsif ($args->{'format'} =~ /xml/oi) {
+	mycarp "XML formats are now handled by MARC::XML" if ($^W);
+	return;
+    }
+    if ($args->{'file'}) {
+	if ($args->{'file'} !~ /^>/) {
+	    mycarp "Don't forget to use > or >> with output file name";
+	    return;
+	}
+	open (OUT, "$args->{file}") || mycarp "Couldn't open file: $!";
+	#above quote is bad if {file} is tainted. Is probably unecessary.dgl.
+        binmode OUT;
+	print OUT $output;
+	close OUT || mycarp "Couldn't close file: $!";
+	return 1;
+    }
+      #if no filename was specified return the output so it can be grabbed
+    else {
+	return $output;
+    }
+}
+
+####################################################################
+# _records unpacks it hashref arg or defaults to the entire list
+####################################################################
+sub _records {
+    my ($marc,$args)=@_;
+    my $trecs =[];
+    my @records = ();
+    $trecs= [$args->{record}] if exists($args->{record});
+    $trecs= $args->{records} if $args->{records};
+
+    @records = @$trecs     if      @$trecs;
+    @records = (1..$#$marc) unless @$trecs;
+
+     return @records;
+}
+
+####################################################################
+
+# params takes a hashref and does a one level deep copy of it.
+# It uses the rest of the args to override elements of the hashref.
+# Returns a hashref so that caller does'nt have to worry about
+# crypto-context.
+
+####################################################################
+
+sub _params {
+    return MARC::Rec::_params(@_);
+}
+
+####################################################################
+# _writemarc() takes a MARC object as its input and returns the    #
+# the USMARC equivalent of the object as a string                  #
+####################################################################
+sub _writemarc { #rec
+    my $marc=shift;
+    my $args=shift;
+    #Read in each individual MARC record in the file
+    my @records = _records($marc,$args);
+
+    my $marcrecord="";
+    foreach my $i (@records) {
+	my $record = $marc->[$i];
+	$marcrecord .= $record->_writemarc($args);
+    }
+    return $marcrecord;
+}
+
+
+####################################################################
+# _marc2ascii() takes a MARC object as its input and returns the   #
+# ASCII equivalent of the object (field names, indicators, field   #
+# values and line-breaks)                                          #
+####################################################################
+sub _marc2ascii { # rec
+    my $marc=shift;
+    my $args=shift;
+    my @records = _records($marc,$args);
+    $args->{'lineterm'} ||= "\n";
+    my $output = "";
+    for my $i (@records) { #cycle through each record
+	my $record=$marc->[$i];
+	$output .= $record->_marc2ascii($args);
+    }
+    return $output;
+}
+
+####################################################################
+# _marcmaker() takes a MARC object as its input and converts it    #
+# into MARCMaker format, which is returned as a string             #
+####################################################################
+sub _marcmaker { # rec
+    my @output = ();
+    my $marc=shift;
+    my $args=shift;
+    $args->{'proto_rec'} = $marc->[0]{'proto_rec'};
+    my @records = _records($marc,$args);
+
+    local $^W = 0;	# no warnings
+    my $breaker = "";
+    for my $i (@records) { #cycle through each record
+	my $record=$marc->[$i];
+	$breaker .= $record->_marcmaker($args);
+    }
+    return $breaker;
+}
+
+sub _char2maker { # rec
+    return MARC::Rec::_char2maker(@_);
+}
+
+sub ustext_default { # rec
+    return MARC::Rec::ustext_default(@_);
+}
+
+####################################################################
+# _marc2html takes a MARC object as its input and converts it into #
+# HTML. It is possible to specify which field you want to output   #
+# as well as field labels to be used instead of the MARC codes.    #
+# The HTML is returned as a string                                 #
+####################################################################
+sub _marc2html {
+    my $marc = shift;
+    my $args = shift;
+    my $newline = $args->{'lineterm'} || "\n";
+
+    my @records = _records($marc,$args);
+    my $output = "";
+    foreach my $i (@records) {
+	my $marcrec=$marc->[$i];
+	$output.= $marcrec->_marc2html($args);
+    }
+    return $output;
+}
+
+
+####################################################################
+# _urls() takes a MARC object as its input, and then extracts the  #
+# control# (MARC 001) and URLs (MARC 856) and outputs them as      #
+# hypertext links in an HTML page. This could then be used with a  #
+# link checker to determine what URLs are broken.                  #
+####################################################################
+sub _urls { # rec
+    my $marc = shift;
+    my $args = shift;
+
+    my $output = "";
+    my @records = _records($marc,$args);
+
+    local $^W = 0;	# no warnings
+    foreach my $i (@records) {
+	my $marcrec=$marc->[$i];
+	$output .= $marcrec->_urls($args);
+    }
+    return $output;
+}
+
+####################################################################
+# isbd() attempts to create a quasi ISBD output format             #
+####################################################################
+sub _isbd { # rec
+    my $marc=shift;
+    my $args=shift;
+    my $newline = $args->{'lineterm'} || "\n";
+    my @records = _records($marc,$args);
+    my $output ="";
+    for my $i (@records) { #cycle through each record
+	my $record=$marc->[$i];
+	$output .= $record->_isbd($args);
+    }
+    return $output;
+}
+
+####################################################################
+# createrecord() appends a new record to the MARC object           #
+# and initializes the '000' field                                  #
+####################################################################
+sub createrecord { # rec
+    my $marc=shift;
+    local $^W = 0;	# no warnings
+    my $params=shift;
+    my $leader=$params->{'leader'} || "00000nam  2200000 a 4500";
+       #default leader see MARC documentation http://lcweb.loc.gov/marc
+    my $number=$#$marc + 1;
+    my $marcrec = $marc->[0]{'proto_rec'}->createrecord($leader);
+    push @$marc, $marcrec;
+    return $number;
+}
+
+####################################################################
+# addfield() appends/inserts a new field into an existing record   #
+####################################################################
+
+sub addfield {
+    my $marc=shift;
+    my $params=shift;
+    local $^W = 0;	# no warnings
+    my $record=$params->{'record'};
+    unless ($record) {mycarp "You must specify a record"; return}
+    if ($record > $#{$marc}) {mycarp "Invalid record specified"; return}
+    my $field = $params->{'field'};
+    unless ($field) {mycarp "You must specify a field"; return}
+    unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return}
+
+    my $i1=$params->{'i1'};
+    $i1 = ' ' unless (defined $i1);
+    my $i2=$params->{'i2'};
+    $i2 = ' ' unless (defined $i2);
+    my @value=$params->{'value'} || @_;
+    if (ref($params->{'value'}) eq "ARRAY") { @value = @{$params->{'value'}}; }
+    unless (defined $value[0]) {mycarp "No value specified"; return}
+
+    if ($field >= 10) {
+        if ($value[0] eq 'i1') {
+	    shift @value;
+	    $i1 = shift @value;
+        }
+        unless (1 == length($i1)) {
+	    mycarp "invalid \'i1\' specified";
+	    return;
+	}
+        if ($value[0] eq 'i2') {
+	    shift @value;
+	    $i2 = shift @value;
+        }
+        unless (1 == length($i2)) {
+	    mycarp "invalid \'i2\' specified";
+	    return;
+	}
+    }
+
+    my $ordered=$params->{'ordered'} || "y";
+    my $insertorder = $#{$marc->[$record]{array}} + 1;
+       #if necessary figure out the insert order to preserve tag order
+    if ($ordered=~/y/i) {
+	for (my $i=0; $i<=$#{$marc->[$record]{array}}; $i++) {
+	    if ($marc->[$record]{array}[$i][0] > $field) {
+		$insertorder=$i;
+		last;
+	    }
+	    if ($insertorder==0) {$insertorder=1}
+	}
+    }
+    my @field;
+    if ($field<10) {
+	push (@field, $field, $value[0]);
+	if ($ordered=~/y/i) {
+	    splice @{$marc->[$record]{array}},$insertorder,0,\@field; 
+	}
+	else {
+	    push (@{$marc->[$record]{array}},\@field);
+	}
+    }
+    else {
+	push (@field, $field, $i1, $i2);
+	my ($sub_id, $subfield);
+	while ($sub_id = shift @value) {
+	    last if ($sub_id eq "\036");
+	    $subfield = shift @value;
+	    push (@field, $sub_id, $subfield);
+	}
+	if ($ordered=~/y/i) {
+	    splice @{$marc->[$record]{array}},$insertorder,0,\@field;
+	}
+	else {
+	    push (@{$marc->[$record]{array}},\@field);
+	}
+    }
+    $marc->add_map($record,\@field);
+}
+
+####################################################################
+
+# getfields() takes a template and returns an array of fieldrefs from
+# $marc->[$recnum]{'array'} including all with the appropriate tag
+# and having the property that they are a contiguous group. (So may
+# include fields with other tags.)
+
+####################################################################
+sub getfields { # rec
+    my $marc=shift;
+    my $params=shift;
+    my $record=$params->{'record'};
+    unless ($record) {mycarp "You must specify a record"; return}
+    if ($record > $#{$marc}) {mycarp "Invalid record specified"; return}
+    return $marc->[$record]->getfields($params);
+
+}
+
+####################################################################
+# getupdate() returns an array of key,value pairs formatted to     #
+# pass to addfield(). For repeated tags, a "\036" element is used  #
+# to delimit data for separate addfield() commands                 #
+####################################################################
+sub getupdate {
+    my @output;
+    my $marc=shift;
+    my $params=shift;
+    my $record=$params->{'record'};
+    unless ($record) {mycarp "You must specify a record"; return}
+    if ($record > $#{$marc}) {mycarp "Invalid record specified"; return}
+    my $field = $params->{'field'};
+    unless ($field) {mycarp "You must specify a field"; return}
+    unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return}
+
+    foreach my $fields (@{$marc->[$record]{array}}) { #cycle each field 
+	next unless ($field eq $fields->[0]);
+	if ($field<10) {
+	    push @output,$fields->[1];
+	}
+	else {
+	    push @output,'i1',$fields->[1],'i2',$fields->[2];
+	    my @subfields = @{$fields}[3..$#{$fields}];		
+	    while (@subfields) { #cycle through subfields incl. refs
+		my $subfield = shift @subfields;
+		last unless defined $subfield;
+		if (ref($subfield) eq "ARRAY") {
+		    foreach my $subsub (@{$subfield}) {
+		        push @output, $subsub;
+		    }
+		}
+		else {
+		    push @output, $subfield;
+		}
+	    } #finish cycling through subfields
+	} #finish tag test < 10
+	push @output,"\036";		
+    }
+    return @output;
+}
+#################################################################### 
+
+# deletefirst() takes a template and a boolean $do_rebuild_map to
+# rebuild the map. It deletes the field data for a first match, using
+# the template and leaves the rest alone. If the template has a
+# subfield element it deletes based on the subfield information in the
+# template. If the last subfield of a field is deleted, deletefirst()
+# also deletes the field.  It complains about attempts to delete
+# indicators.  If there is no match, it does nothing. Deletefirst also
+# rebuilds the map if $do_rebuild_map. Deletefirst returns the number
+# of matches deleted (that would be 0 or 1), or undef if it feels
+# grumpy (i.e. carps).
+
+####################################################################
+
+sub deletefirst { # rec
+    my $marc = shift || return;
+    my $template = shift;
+    my $recnum = $template->{'record'};
+    if (!$recnum) {mycarp "Need a record to confine my destructive tendencies"; return undef}
+    return $marc->[$recnum]->deletefirst($template);
+}
+
+#################################################################### 
+
+# field_is_empty takes a ref to an array formatted like
+# an element of $marc->[$recnum]{array}. It returns 1 if there are
+# no "significant" elements of the array (e.g. nothing but indicators
+# if $tag>10), else 0. Override this if you want to delete fields
+# that have "insignificant" subfields inside deletefirst.
+
+####################################################################
+sub field_is_empty { # rec
+    my ($marc,$rfield) = @_;
+    return $marc->[0]{proto_rec}->field_is_empty($rfield);
+}
+
+#################################################################### 
+
+# field_updatehook takes a ref to an array formatted like
+# $marc->[$recnum]{'array'}. It is there so that
+# subclasses can override it to do something before calling
+# addfield(), e.g.  store field-specific information in the affected
+# field or log information in an external file/database. One notes that
+# since this is a method, it can ignore its arguments and log global
+# information about $marc, e.g. order information in $marc->[$rnum]{'array'}
+
+####################################################################
+
+sub field_updatehook { # rec
+    my ($marc,$rfield)=@_;
+    $marc->[0]{'proto_rec'}->field_updatehook($rfield);
+}
+
+#################################################################### 
+
+# updatefirst() takes a template, a request to rebuild the index, and
+# an array from $marc->[recnum]{array}. It replaces/creates the field
+# data for a first match, using the template, and leaves the rest
+# alone. If the template has a subfield element, (this includes
+# indicators) it ignores all other information in the array and only
+# updates/creates based on the subfield information in the array. If
+# the template has no subfield information then indicators are left
+# untouched unless a new field needs to be created, in which case they
+# are left blank.
+
+####################################################################
+
+sub updatefirst { # rec
+    my $marc = shift || return;
+    my $template = shift;
+    return unless (ref($template) eq "HASH");
+    return unless (@_);
+    return if (defined $template->{'value'});
+
+    my $recnum = $template->{'record'};
+    if (!$recnum) {mycarp "Need a record to confine my changing needs."; return undef}
+    return $marc->[$recnum]->updatefirst($template, at _);
+}
+
+####################################################################
+
+# updatefields() takes a template which specifies recnum, a
+# $do_rebuild_map and a field (needs the field in case $rafields->[0]
+# is empty). It also takes a ref to an array of fieldrefs formatted
+# like the output of getfields(), and replaces/creates the field
+# data. It assumes that it should remove the fields with the first tag
+# in the fieldrefs. It calls rebuild_map() if $do_rebuild_map.
+
+####################################################################
+sub updatefields { # rec
+    my $marc = shift || return;
+    my $template = shift;
+
+    my $rafieldrefs = shift;
+    my $recnum = $template->{'record'};
+    return $marc->[$recnum]->updatefields($template,$rafieldrefs);
+}
+
+####################################################################
+
+# getmatch() takes a subfield code (can be an indicator) and a fieldref
+# Returns 0 or a ref to the value to be updated.
+
+####################################################################
+sub getmatch { # rec
+    my $marc = shift || return;
+    return $marc->[0]{proto_rec}->getmatch(@_);
+}
+
+####################################################################
+
+# deletesubfield() takes a subfield code (can not be an indicator) and a
+# fieldref. Deletes the subfield code and its value in the fieldref at
+# the first match on subfield code.  Assumes there is an exact
+# subfield match in $fieldref.
+
+####################################################################
+sub deletesubfield { # rec
+    my $marc = shift || return;
+    return $marc->[0]{proto_rec}->deletesubfield(@_);
+}
+
+####################################################################
+
+# insertpos() takes a subfield code (can not be an indicator), a
+# value, and a fieldref. Updates the fieldref with the first
+# place that the fieldref can match. Assumes there is no exact
+# subfield match in $fieldref.
+
+####################################################################
+sub insertpos { # rec
+    my $marc = shift || return;
+    return $marc->[0]{proto_rec}->insertpos(@_);
+}
+    
+
+####################################################################
+# updaterecord() takes an array of key/value pairs, formatted like #
+# the output of getupdate(), and replaces/creates the field data.  #
+# For repeated tags, a "\036" element is used to delimit data into #
+# separate addfield() commands.                                    #
+####################################################################
+sub updaterecord {
+    my $marc = shift || return;
+    my $template = shift;
+    return unless (ref($template) eq "HASH");
+    return unless (@_);
+    return if (defined $template->{'value'});
+    my $count = 0;
+    my @records = ();
+    unless ($marc->deletemarc($template)) {mycarp "not deleted\n"; return;}
+    foreach my $y1 (@_) {
+        unless ($y1 eq "\036") {
+    	    push @records, $y1;
+	    next;
+        }
+        unless ($marc->addfield($template, @records)) {
+	    mycarp "not added\n";
+	    return;
+	}
+        @records = ();
+	$count++;
+    }
+    return $count;
+}
+
+####################################################################
+# _offset is an internal subroutine used by writemarc to offset    #
+# number ie. making "34" into "00034".                             #
+#################################################################### 
+sub _offset{
+    return MARC::Rec::_offset(@_);
+}
+
+####################################################################
+
+# MARC::Rec is responsible for the methods and representation of
+# a single MARC record. Its protocol is very close to that of MARC:
+# in fact, most MARC methods have been moved here without the record
+# number and re-implemented in standard form by delegation.
+
+####################################################################
+
+package MARC::Rec;
+use Carp;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS
+	    @LDR_FIELDS $LDR_TEMPLATE %FF_FIELDS %FF_TEMPLATE
+	    );
+
+$VERSION = $MARC::VERSION;
+
+ at ISA = qw(Exporter);
+ at EXPORT= qw();
+ at EXPORT_OK= qw();
+
+#### Not using these yet
+
+#### %EXPORT_TAGS = (USTEXT	=> [qw( marc2ustext )]);
+#### Exporter::export_ok_tags('USTEXT');
+#### $EXPORT_TAGS{ALL} = \@EXPORT_OK;
+
+# gotta know where to find leader information....
+
+ at LDR_FIELDS = qw(rec_len RecStat Type BLvl Ctrl Undefldr base_addr
+		 ELvl Desc ln_rec len_len_field len_start_char len_impl Undef2ldr);
+
+$LDR_TEMPLATE = "a5aaaaa3a5aaaaaaa";
+
+#...And the 008 field has a special place in Librarians' hearts.
+%FF_FIELDS = (
+	      BOOKS =>
+	      [qw(Entered DtSt Date1 Date2 Ctry Ills Audn Form Cont
+		  GPub Conf Fest Indx Undef1 Fict Biog Lang MRec Srce)],
+	      COMPUTER_FILES => 
+	      [qw(Entered DtSt Date1 Date2 Ctry Undef1 Audn Undef2 
+		  File Undef3 GPub Undef4 Lang MRec Srce)],
+	      MAPS =>
+	      [qw(Entered DtSt Date1 Date2 Ctry Relf Proj Prme CrTp
+		  Undef1 GPub Undef2 Indx Undef3 SpFm Lang MRec Srce)],
+	      MUSIC =>        
+	      [qw(Entered DtSt Date1 Date2 Ctry Comp FMus Undef1 Audn
+		  Form AccM LTxt Undef2 Lang MRec Srce)],
+	      SERIALS =>	
+	      [qw(Entered DtSt Date1 Date2 Ctry Freq Regl ISSN SrTp
+		  Orig Form EntW Cont GPub Conf Undef1 Alph S_L Lang MRec Srce)],
+	      VIS =>
+	      [qw(Entered DtSt Date1 Date2 Ctry Time Undef1 
+		  Audn AccM GPub Undef2 TMat Tech Lang MRec Srce)],
+	      MIX =>
+	      [qw(Entered DtSt Date1 Date2 
+		  Ctry Undef1 Form Undef2 Lang MRec Srce)]
+	      );
+
+%FF_TEMPLATE = (
+		BOOKS          =>   "a6a1a4a4a3a4a1a1a4a1a1a1a1a1a1a1a3a1a1",
+		COMPUTER_FILES =>   "a6a1a4a4a3a4a1a3a1a1a1a6a3a1a1",
+		MAPS           =>   "a6a1a4a4a3a4a2a1a1a2a1a2a1a1a2a3a1a1",
+		MUSIC          =>   "a6a1a4a4a3a2a1a1a1a1a6a2a3a3a1a1",
+		SERIALS        =>   "a6a1a4a4a3a1a1a1a1a1a1a1a3a1a1a3a1a1a3a1a1",
+		VIS            =>   "a6a1a4a4a3a3a1a1a5a1a4a1a1a3a1a1",
+		MIX            =>   "a6a1a4a4a3a5a1a11a3a1a1"
+		);
+
+# Preloaded methods go here.
+####################################################################
+# _offset is an internal subroutine used by writemarc to offset    #
+# number ie. making "34" into "00034".                             #
+#################################################################### 
+sub _offset{
+    my $value=shift;
+    my $digits=shift;
+    print "DEBUG: _offset value = $value, digits = $digits\n" if $MARC::DEBUG;
+    my $x=length($value);
+    $x=$digits-$x;
+    $x="0"x$x."$value";
+}
+
+sub mycarp { # rec
+    Carp::carp (@_) unless $MARC::TEST;
+}
+
+####################################################################
+
+# This is the constructor method that creates the MARC::Rec object. It
+# sets up references and gets out. Any file it knows about will be an
+# already opened filehandle: do error checking and binmode on the file
+# outside MARC::Rec.
+
+####################################################################
+sub new { # rec
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my $filehandle = shift;
+    my $marcrec = {}; 
+    bless ($marcrec, $class);
+    my $format = shift || "usmarc";
+
+    $marcrec->{'handle'} ||= \*filehandle;
+    $marcrec->{'format'}=$format;
+    $marcrec->{'lineterm'}="\015\012" if $format eq 'marcmaker';
+    # MS-DOS default for MARCMaker
+    return $marcrec;
+}
+
+####################################################################
+
+# Copy_struct returns a copy of the marcrec ($proto) without
+# {array} and map information. The copy shares references to
+# {handle} by design.
+
+####################################################################
+sub copy_struct {
+    my $proto = shift;
+    my $class = ref($proto);
+    my $newrec;
+    for (keys %$proto) {
+	$newrec->{$_} = $proto->{$_} if /^(handle|format|proto_rec)$/;
+    }
+    return bless $newrec,$class;
+}
+
+####################################################################
+
+# clone returns a new MARC::Rec object with copies of the data.
+# Admin information remains linked to original.
+
+####################################################################
+sub clone {
+    my $marcrec=shift;
+    my $ldr = $marcrec->ldr();
+    my $ans = $marcrec->createrecord($ldr);
+    for (@{$marcrec->{array}}) {
+	next if $_->[0] eq '000';
+	my @field = @$_;
+	my $rfield = \@field;
+	push @{$ans->{array}}, $rfield;
+	$ans->add_map($rfield);
+    }
+    return $ans;
+}
+
+#################################################################### 
+
+# field_is_empty takes a ref to an array formatted like
+# an element of $marc->[$recnum]{array}. It returns 1 if there are
+# no "significant" elements of the array (e.g. nothing but indicators
+# if $tag>10), else 0. Override this if you want to delete fields
+# that have "insignificant" subfields inside deletefirst.
+
+####################################################################
+sub field_is_empty { # rec
+    my ($marcrec,$rfield) = @_;
+
+    my $tag = $rfield->[0];
+    my @field = @$rfield;
+    return 1 if ($tag > 10 and !defined($field[3]));
+    return 1 if ($tag < 10 and !defined($field[1]) );
+    return 0;
+}
+
+####################################################################
+
+# field_updatehook echos the version in MARC without the recordnum.
+
+####################################################################
+sub field_updatehook { # rec
+# nothing. Subclass may want to handle this.
+}
+
+
+####################################################################
+
+# getfields() takes a template and returns an array of fieldrefs from
+# $marc->[$recnum]{'array'} including all with the appropriate tag
+# and having the property that they are a contiguous group. (So may
+# include fields with other tags.)
+
+####################################################################
+sub getfields { # rec
+
+    my $marcrec=shift;
+    my $params=shift;
+
+    my $field = $params->{'field'};
+    unless ($field) {mycarp "You must specify a field"; return}
+    unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return}
+
+    my @ans=();
+    my $first = undef;
+    my $last = $first; 
+    my $pos = 0;
+    for (@{$marcrec->{'array'}}) {
+	$first = $pos if ($_->[0] eq $field && !defined($first)) ;
+	$last = $pos if $_->[0] eq $field;
+	$pos++;
+    }
+    return () unless defined($first);
+    return @{$marcrec->{'array'}}[$first..$last]; # array slice. Look it up.
+}
+
+#################################################################### 
+
+# deletefirst() takes a template and a boolean $do_rebuild_map to
+# rebuild the map. It deletes the field data for a first match, using
+# the template and leaves the rest alone. If the template has a
+# subfield element it deletes based on the subfield information in the
+# template. If the last subfield of a field is deleted, deletefirst()
+# also deletes the field.  It complains about attempts to delete
+# indicators.  If there is no match, it does nothing. Deletefirst also
+# rebuilds the map if $do_rebuild_map. Deletefirst returns the number
+# of matches deleted (that would be 0 or 1), or undef if it feels
+# grumpy (i.e. carps).
+
+####################################################################
+
+sub deletefirst { # rec
+    my $marcrec = shift || return;
+    my $template = shift;
+    return unless (ref($template) eq "HASH");
+    return if (defined $template->{'value'});
+
+    my $field = $template->{'field'};
+
+    my $subfield = $template->{'subfield'};
+    my $do_rebuild_map = $template->{'rebuild_map'};
+    if (defined($subfield) and $subfield =~/^i[12]$/) {mycarp "Cannot delete indicators"; return undef}
+#I know that $marc->{$field}{field} is this information
+#But I don't want to depend on the map being up-to-date allways.
+
+    my @fieldrefs = $marcrec->getfields($template); #helps with cjk.
+
+    return 0 unless scalar(@fieldrefs);
+    
+    if ($field and not($subfield)) {
+	shift @fieldrefs;
+	$marcrec->updatefields($template,\@fieldrefs);
+	$marcrec->rebuild_map($field) if $do_rebuild_map;
+	return 1;
+    }
+
+
+    #Linear search for the field where deletion happens and the position 
+    #in that field.
+    my $rvictim=0;
+    my $fieldnum = 0;
+    foreach my $fieldref (@fieldrefs) {
+	if ($marcrec->getmatch($subfield,$fieldref)){
+	    $rvictim=$fieldref;
+	    last;
+	}
+	$fieldnum++;
+    }
+    if (!$rvictim) {
+	$marcrec->rebuild_map($field) if $do_rebuild_map;
+	return 0;
+    }
+
+    #Now we know that we have a field and subfield with a match.
+    #Find the first one and kill it. Kill the enclosing field 
+    #if it is the last one.
+    $marcrec->deletesubfield($subfield,$rvictim);
+    $marcrec->field_updatehook($rvictim);
+    if ($marcrec->field_is_empty($rvictim)) {
+	splice @fieldrefs,$fieldnum,1;
+	$marcrec->updatefields($template,\@fieldrefs);
+    }
+    #here we don't need to directly touch $marc->{array}
+    # since we are not changing its structure.
+    $marcrec->rebuild_map($field) if $do_rebuild_map;
+    return 1;
+}
+
+sub _params {
+    my $template =shift;
+    return {} unless ref $template eq 'HASH';
+    my %params = %$template;
+    %params = (%params, at _);
+    return \%params;
+}
+
+####################################################################
+# _writemarc() takes a MARC object as its input and returns the    #
+# the USMARC equivalent of the object as a string                  #
+####################################################################
+sub _writemarc { # rec
+    my $marcrec=shift;
+    my $args=shift;
+    my (@record, $fieldbase, $fielddata, $fieldlength, $fieldposition, 
+	$marcrecord, $recordlength);
+    
+    my $record = $marcrec;
+    #Reset variables
+    my $position=0; my $directory=""; my $fieldstream=""; 
+    my $leader=$record->{'000'}[1];
+    foreach my $field (@{$record->{'array'}}) {
+	my $tag = $field->[0];
+	if ($tag eq '000') {next}; #don't output the directory!
+	my $fielddata="";
+	if ($tag < 10) {
+	    $fielddata=$field->[1]; 
+	}
+	else {
+	    $fielddata.=$field->[1].$field->[2]; #add on indicators
+	    my @subfields=@{$field}[3..$#{$field}];
+	    while (@subfields) {
+		$fielddata.="\037".shift(@subfields); #shift off subfield delimiter
+		$fielddata.=shift(@subfields); #shift off subfield value
+	    }
+	}
+	$fielddata.="\036";
+	$fieldlength=_offset(length($fielddata),4);
+	$fieldposition=_offset($position,5);
+	$directory.=$tag.$fieldlength.$fieldposition;
+	$position+=$fieldlength;
+	$fieldstream.=$fielddata;
+    }
+    $directory.="\036";
+    $fieldstream.="\035";
+    $fieldbase=24+length($directory);
+    $fieldbase=_offset($fieldbase,5);
+    $recordlength=24+length($directory)+length($fieldstream);
+    $recordlength=_offset($recordlength,5);
+    $leader=~s/^.{5}(.{7}).{5}(.{7})/$recordlength$1$fieldbase$2/;
+
+    $marcrecord ="$leader$directory$fieldstream";
+
+    $record->{'000'}[1] = $leader;	# save recomputed version
+    return $marcrecord;
+}
+    
+####################################################################
+# _marc2ascii() takes a MARC object as its input and returns the   #
+# ASCII equivalent of the object (field names, indicators, field   #
+# values and line-breaks)                                          #
+####################################################################
+sub _marc2ascii {
+
+    my $marcrec=shift;
+    my $args=shift;
+    my $newline = $args->{'lineterm'} || "\n";
+    my $output = "";
+    my $record=$marcrec;
+    foreach my $fields (@{$record->{'array'}}) { #cycle each field 
+	my $tag=$fields->[0];
+	print "ASCII: tag = $tag\n" if $MARC::DEBUG;
+	if ($tag<10) {
+	    $output.="$fields->[0]  $fields->[1]";
+	}
+	else {
+	    $output.="$tag  $fields->[1]$fields->[2]  ";
+	    my @subfields = @{$fields}[3..$#{$fields}];		
+	    while (@subfields) { #cycle through subfields
+		$output .= "\$".shift(@subfields).shift(@subfields);
+	    } #finish cycling through subfields
+	} #finish tag test < 10
+	$output .= $newline; #put a newline at the end of the field
+    }
+    $output.=$newline; #put an extra newline to separate records
+    return $output;
+}
+
+####################################################################
+# _marcmaker() takes a MARC object as its input and converts it    #
+# into MARCMaker format, which is returned as a string             #
+####################################################################
+sub _marcmaker { # rec
+    my @output = ();
+    my $marcrec=shift;
+    my $args=shift;
+    my $proto_rec=$args->{'proto_rec'};
+    unless (exists $args->{'charset'}) {
+        unless (exists $proto_rec->{'brkrchar'}) {
+	    $proto_rec->{'brkrchar'} = ustext_default();	# hash ref
+	}
+	$args->{'charset'} = $proto_rec->{'brkrchar'};
+	$proto_rec->{'charset'}  = $proto_rec->{'brkrchar'};
+    }
+    local $^W = 0;	# no warnings
+
+    my $record=$marcrec;
+    foreach my $fields (@{$record->{'array'}}) { #cycle each field 
+	my $tag=$fields->[0];
+	print "OUT: tag = $tag\n" if $MARC::DEBUG;
+	if ($tag eq '000') {
+	    my $value=$fields->[1];
+	    $value=~s/ /\\/go;
+	    push @output, "=LDR  $value";
+	}
+	elsif ($tag<10) {
+	    my $value = _char2maker($fields->[1], $args->{'charset'});
+	    $value=~s/ /\\/go;
+	    push @output, "=$tag  $value";
+	}
+	else {
+	    my $indicator1=$fields->[1];
+	    $indicator1=~s/ /\\/;
+	    my $indicator2=$fields->[2];
+	    $indicator2=~s/ /\\/;
+	    my $output="=$tag  $indicator1$indicator2";
+	    my @subfields = @{$fields}[3..$#{$fields}];		
+	    while (@subfields) { #cycle through subfields
+		my $subfield_id = shift(@subfields);
+		my $subfield = _char2maker( shift(@subfields),
+					    $args->{'charset'} );
+		$output .= "\$$subfield_id$subfield";
+	    } #finish cycling through subfields
+	    push @output, $output;
+	} #finish tag test < 10
+    }
+    push @output,""; #put an extra blank line to separate records
+    
+    my $newline = $args->{'lineterm'} || "\015\012";
+    if ($args->{'nolinebreak'}) {
+	my $breaker1 = join ($newline, @output) . $newline;
+	return $breaker1;
+    }
+# linebreak on by default
+    my @output2 = ();
+    foreach my $outline (@output) {
+	if (length($outline) < 66) {
+	    push @output2, $outline;
+	    next;
+	}
+	else {
+	    my @words = split (/\s{1,1}/, $outline);
+	    my $outline2 = shift @words;
+	    foreach my $word (@words) {
+		if (length($outline2) + length($word) < 66) {
+		    $outline2 .= " $word";
+		}
+		else {
+		    push @output2, $outline2;
+		    $outline2 = " $word";
+		}
+	    }
+	    push @output2, $outline2;
+	}
+    }
+    my $breaker = join ($newline, @output2);
+    return $breaker;
+}
+
+sub _char2maker {
+    my @marc_string = split (//, shift);
+    my $charmap = shift;
+    my $maker_string = join ('', map { ${$charmap}{$_} } @marc_string);
+    while ($maker_string =~ s/(&)([^ ]{1,7}?)(;)/{$2}/o) {}
+    return $maker_string;
+}
+
+sub ustext_default {
+    my @hexchar = (0x00..0x1a,0x1c,0x7f..0x8c,0x8f..0xa0,0xaf,0xbb,
+		   0xbe,0xbf,0xc7..0xdf,0xfc,0xfd,0xff);
+    my %outchar = map {chr($_), sprintf ("{%2.2X}",int $_)} @hexchar;
+
+    my @ascchar = map {chr($_)} (0x20..0x23,0x25..0x7a,0x7c,0x7e);
+    foreach my $asc (@ascchar) { $outchar{$asc} = $asc; }
+
+    $outchar{chr(0x1b)} = '{esc}';	# escape
+    $outchar{chr(0x24)} = '{dollar}';	# dollar sign
+    $outchar{chr(0x5c)} = '{bsol}';	# back slash (reverse solidus)
+    $outchar{chr(0x7b)} = '{lcub}';	# opening curly brace
+    $outchar{chr(0x7d)} = '{rcub}';	# closing curly brace
+    $outchar{chr(0x8d)} = '{joiner}';	# zero width joiner
+    $outchar{chr(0x8e)} = '{nonjoin}';	# zero width non-joiner
+    $outchar{chr(0xa1)} = '{Lstrok}';	# latin capital letter l with stroke
+    $outchar{chr(0xa2)} = '{Ostrok}';	# latin capital letter o with stroke
+    $outchar{chr(0xa3)} = '{Dstrok}';	# latin capital letter d with stroke
+    $outchar{chr(0xa4)} = '{THORN}';	# latin capital letter thorn (icelandic)
+    $outchar{chr(0xa5)} = '{AElig}';	# latin capital letter AE
+    $outchar{chr(0xa6)} = '{OElig}';	# latin capital letter OE
+    $outchar{chr(0xa7)} = '{softsign}';	# modifier letter soft sign
+    $outchar{chr(0xa8)} = '{middot}';	# middle dot
+    $outchar{chr(0xa9)} = '{flat}';	# musical flat sign
+    $outchar{chr(0xaa)} = '{reg}';	# registered sign
+    $outchar{chr(0xab)} = '{plusmn}';	# plus-minus sign
+    $outchar{chr(0xac)} = '{Ohorn}';	# latin capital letter o with horn
+    $outchar{chr(0xad)} = '{Uhorn}';	# latin capital letter u with horn
+    $outchar{chr(0xae)} = '{mlrhring}';	# modifier letter right half ring (alif)
+    $outchar{chr(0xb0)} = '{mllhring}';	# modifier letter left half ring (ayn)
+    $outchar{chr(0xb1)} = '{lstrok}';	# latin small letter l with stroke
+    $outchar{chr(0xb2)} = '{ostrok}';	# latin small letter o with stroke
+    $outchar{chr(0xb3)} = '{dstrok}';	# latin small letter d with stroke
+    $outchar{chr(0xb4)} = '{thorn}';	# latin small letter thorn (icelandic)
+    $outchar{chr(0xb5)} = '{aelig}';	# latin small letter ae
+    $outchar{chr(0xb6)} = '{oelig}';	# latin small letter oe
+    $outchar{chr(0xb7)} = '{hardsign}';	# modifier letter hard sign
+    $outchar{chr(0xb8)} = '{inodot}';	# latin small letter dotless i
+    $outchar{chr(0xb9)} = '{pound}';	# pound sign
+    $outchar{chr(0xba)} = '{eth}';	# latin small letter eth
+    $outchar{chr(0xbc)} = '{ohorn}';	# latin small letter o with horn
+    $outchar{chr(0xbd)} = '{uhorn}';	# latin small letter u with horn
+    $outchar{chr(0xc0)} = '{deg}';	# degree sign
+    $outchar{chr(0xc1)} = '{scriptl}';	# latin small letter script l
+    $outchar{chr(0xc2)} = '{phono}';	# sound recording copyright
+    $outchar{chr(0xc3)} = '{copy}';	# copyright sign
+    $outchar{chr(0xc4)} = '{sharp}';	# sharp
+    $outchar{chr(0xc5)} = '{iquest}';	# inverted question mark
+    $outchar{chr(0xc6)} = '{iexcl}';	# inverted exclamation mark
+    $outchar{chr(0xe0)} = '{hooka}';	# combining hook above
+    $outchar{chr(0xe1)} = '{grave}';	# combining grave
+    $outchar{chr(0xe2)} = '{acute}';	# combining acute
+    $outchar{chr(0xe3)} = '{circ}';	# combining circumflex
+    $outchar{chr(0xe4)} = '{tilde}';	# combining tilde
+    $outchar{chr(0xe5)} = '{macr}';	# combining macron
+    $outchar{chr(0xe6)} = '{breve}';	# combining breve
+    $outchar{chr(0xe7)} = '{dot}';	# combining dot above
+    $outchar{chr(0xe8)} = '{uml}';	# combining diaeresis (umlaut)
+    $outchar{chr(0xe9)} = '{caron}';	# combining hacek
+    $outchar{chr(0xea)} = '{ring}';	# combining ring above
+    $outchar{chr(0xeb)} = '{llig}';	# combining ligature left half
+    $outchar{chr(0xec)} = '{rlig}';	# combining ligature right half
+    $outchar{chr(0xed)} = '{rcommaa}';	# combining comma above right
+    $outchar{chr(0xee)} = '{dblac}';	# combining double acute
+    $outchar{chr(0xef)} = '{candra}';	# combining candrabindu
+    $outchar{chr(0xf0)} = '{cedil}';	# combining cedilla
+    $outchar{chr(0xf1)} = '{ogon}';	# combining ogonek
+    $outchar{chr(0xf2)} = '{dotb}';	# combining dot below
+    $outchar{chr(0xf3)} = '{dbldotb}';	# combining double dot below
+    $outchar{chr(0xf4)} = '{ringb}';	# combining ring below
+    $outchar{chr(0xf5)} = '{dblunder}';	# combining double underscore
+    $outchar{chr(0xf6)} = '{under}';	# combining underscore
+    $outchar{chr(0xf7)} = '{commab}';	# combining comma below
+    $outchar{chr(0xf8)} = '{rcedil}';	# combining right cedilla
+    $outchar{chr(0xf9)} = '{breveb}';	# combining breve below
+    $outchar{chr(0xfa)} = '{ldbltil}';	# combining double tilde left half
+    $outchar{chr(0xfb)} = '{rdbltil}';	# combining double tilde right half
+    $outchar{chr(0xfe)} = '{commaa}';	# combining comma above
+    if ($MARC::DEBUG) {
+        foreach my $num (sort keys %outchar) {
+            printf "%x = %s\n", ord($num), $outchar{$num};
+        }
+    }
+    return \%outchar;
+}
+
+####################################################################
+# _marc2html takes a MARC object as its input and converts it into #
+# HTML. It is possible to specify which field you want to output   #
+# as well as field labels to be used instead of the MARC codes.    #
+# The HTML is returned as a string                                 #
+####################################################################
+sub _marc2html { # rec
+    my $marcrec = shift;
+    my $args = shift;
+    my $newline = $args->{'lineterm'} || "\n";
+    my $output = "";
+    my $outputall = 1;
+
+    my @tags =();
+    @tags = grep /^[0-9]/, sort(keys(%{$args}));
+
+    $outputall = 0 if (scalar(@tags));
+    if (defined $args->{'fields'}) {
+        if ($args->{'fields'} =~ /all$/oi) {$outputall=1} ## still needed ?????
+    }
+
+
+    my %tags =();
+
+    %tags = map {$_=>1} @tags;
+    %tags = map {$_->[0]=>1} @{$marcrec->{'array'}} if $outputall;
+      #if 'all' fields are specified then set $outputall flag to yes
+    local $^W = 0;	# no warnings
+
+    my $j=$marcrec;
+    $output.= $newline."<p>";
+    
+    foreach my $rfield (@{$j->{'array'}}) {
+	$output.= $rfield->[0]." ".$j->_joinfield($rfield,$rfield->[0])."<br>".$newline
+	    if $tags{$rfield->[0]};
+    }
+    $output.="</p>";
+    return $output;
+}
+
+
+####################################################################
+# _urls() takes a MARC object as its input, and then extracts the  #
+# control# (MARC 001) and URLs (MARC 856) and outputs them as      #
+# hypertext links in an HTML page. This could then be used with a  #
+# link checker to determine what URLs are broken.                  #
+####################################################################
+sub _urls {
+    my $marcrec = shift;
+    my $args = shift;
+    my $newline = $args->{'lineterm'} || "\n";
+    my $output = "";
+    
+    my $controlnum=undef;
+    foreach my $rfield (@{$marcrec->{'array'}}) {
+	if ($rfield->[0] eq "001") {
+	    $controlnum= $rfield->[1];
+	}
+	elsif ($rfield->[0] eq "856") {
+	    for (my $k=3; $k< $#$rfield; $k++) {
+		if ($rfield->[$k] eq "u") {
+		    $output.=qq{<a href="$rfield->[$k+1]">$controlnum :}.
+			qq{$rfield->[$k+1]</a><br>$newline};
+		}
+	    }
+	}
+    }
+    return $output;
+}
+
+####################################################################
+# isbd() attempts to create a quasi ISBD output format             #
+####################################################################
+sub _isbd { # rec
+    my $marcrec=shift;
+    my $args=shift;
+
+    my $output = "";
+    my $newline = $args->{'lineterm'} || "\n";
+
+    my @reporting_fields = grep {$_->[0] =~/020|245|250|260|300|440|490|5../}
+                               @{$marcrec->{'array'}}; # optimization.
+    my %tagfields = (); # This will allow random access to fields based on tags
+    foreach my $rfield (@reporting_fields) {
+	push @{$tagfields{$rfield->[0]}},$rfield;
+    }
+    $output .= $marcrec->_joinfield($tagfields{245}[0],"245");
+    for (qw/250 260 300/) {
+	$output .= " -- ". $marcrec->_joinfield($tagfields{$_}[0],$_) if $tagfields{$_};
+    }
+    if ($tagfields{'440'}) {
+	$output .= " -- ";
+	foreach my $rfield (@{$tagfields{'440'}}) {
+	    $output .= "(".$marcrec->_joinfield($rfield,"440").") ";
+	}
+    }
+    if ($tagfields{'490'}) {
+	$output .= " -- " unless $tagfields{'440'};
+	foreach my $rfield (@{$tagfields{'490'}}) {
+	    $output .= "(".$marcrec->_joinfield($rfield,"490").") ";
+	}
+    }
+    my @f500s = grep {$_->[0] =~/5../} @reporting_fields;
+    foreach my $rfield (@f500s) {
+	$output .= $newline.$marcrec->_joinfield($rfield,$rfield->[0]);
+    }
+    if ($tagfields{'020'}) {
+	$output .= $newline.$marcrec->_joinfield($tagfields{'020'}[0]);
+    }
+    $output .= $newline.$newline;		
+    return $output;
+}
+
+####################################################################
+
+# createrecord takes a string leader and returns a new record with
+# leader information at the appropriate place.
+
+####################################################################
+sub createrecord { # rec
+    my $marcrec = shift;
+    local $^W = 0;	# no warnings
+    my $leader=shift || "00000nam  2200000 a 4500";
+    my $newrec = $marcrec->copy_struct();
+       #default leader see MARC documentation http://lcweb.loc.gov/marc
+    my @ldrfield = ('000',$leader);
+    $newrec->field_updatehook(\@ldrfield);
+    push (@{$newrec->{'000'}}, at ldrfield); #create map
+    push(@{$newrec->{'array'}},$newrec->{'000'});
+    return $newrec;
+}
+
+####################################################################
+# nextrec() will read in a record from a filehandle
+# already been opened with openmarc(). the increment can be        #
+# adjusted if necessary by passing a new value as a parameter. the # 
+# new records will be APPENDED to the MARC object                  #
+####################################################################
+sub nextrec {
+    my $marcrec=shift;
+    if (not($marcrec->{'handle'})) {
+	mycarp "There isn't a MARC file open"; 
+	return;
+    }
+    if ($marcrec->{'format'} =~ /usmarc/oi) {
+	return  _readmarc($marcrec);
+    }
+    elsif ($marcrec->{'format'} =~ /marcmaker/oi) {
+	return _readmarcmaker($marcrec);
+    }
+    else {return (undef,-3)}   
+}
+
+####################################################################
+
+# Add_map is the rec equivalent of MARC::add_map (as usual, without
+# the record number).
+
+####################################################################
+sub add_map { # rec
+    my $marcrec=shift;
+    my $rafield = shift;
+    my $tag = $rafield->[0];
+    return undef if $tag eq '000'; #currently handle ldr yourself...
+    my @tmp = @$rafield;
+    my $field_len = $#tmp;
+    my $record = $marcrec;
+    if ($tag > 10 ) {
+	my $i1 = $rafield->[1];
+	my $i2 = $rafield->[2];
+	my $i12 = $i1.$i2;
+
+	for(my $i=3;$i<$field_len;$i+=2) {
+	    my $subf_code = $rafield->[$i];
+	    push(@{$record->{$tag}{$subf_code}}, \$rafield->[$i+1]);
+	}
+	push(@{$record->{$tag}{'i1'}{$i1}},$rafield);
+	push(@{$record->{$tag}{'i2'}{$i2}},$rafield);
+	push(@{$record->{$tag}{'i12'}{$i12}},$rafield);
+    }
+    push(@{$record->{$tag}{field}},$rafield);
+}
+
+####################################################################
+
+# rebuild_map() is the ::Rec version of MARC::rebuild_map().
+
+####################################################################
+sub rebuild_map { # rec
+    my $marcrec=shift;
+    my $tag = shift;
+    return undef if $tag eq '000'; #currently ldr is different...
+    my @tagrefs = grep {$_->[0] eq $tag} @{$marcrec->{'array'}};
+    delete $marcrec->{$tag};
+    for (@tagrefs) {$marcrec->add_map($_)};
+}
+
+####################################################################
+
+# rebuild_map_all() is the ::Rec version of MARC::rebuild_map_all()
+
+####################################################################
+sub rebuild_map_all { # rec
+    my $marcrec=shift;
+    my %tags=();
+    map {$tags{$_->[0]}++} @{$marcrec->{'array'}};
+    foreach my $tag (keys %tags) {$marcrec->rebuild_map($tag)};
+}
+
+
+
+####################################################################
+
+# Reads the next record out of the handle. Returns a pair (new
+# record,status). Status is 1 in the generic case. Status is -1 if
+# lengths do not match -2 if leader size is not numeric, undef if at
+# the last record. New record is undef if there is an error or at the
+# last record.
+
+####################################################################
+sub _readmarc { # rec
+    my $marcrec = shift;
+    my $handle = $marcrec->{'handle'};
+    my $string = shift;
+    local $/ = "\035";	# cf. TPJ #14
+    local $^W = 0;	# no warnings
+    my $line;
+    $line = $string if $string;
+    $line = <$handle> if $handle and !defined($string);
+    my $recordlength = substr($line,0,5);
+    my $octets = length ($line);
+    $line=~s/[\n\r\cZ]//og;
+    return (undef,undef) unless $line;
+    if ($recordlength =~ /\d{5}/o) {
+	print "recordlength = $recordlength, length = $octets\n"
+		if $MARC::DEBUG;
+	return  (undef,-1) unless $recordlength == $octets;
+    } else {
+	return  (undef,-2);
+    }
+    my @d = ();
+    $line=~/^(.{24})([^\036]*)\036(.*)/o;
+    my $leader=$1; my $dir=$2; my $data=$3;
+    my $record = $marcrec->createrecord($leader);
+
+    @d=$dir=~/(.{12})/go;
+	for my $d(@d) {
+	    my @field=();
+	    my $tag=substr($d,0,3);
+	    chop(my $field=substr($data,substr($d,7,5),substr($d,3,4)));
+	    if ($tag<10) {
+		@field=($tag,$field);
+	    }
+	    else {
+		my ($indi1, $indi2, $field_data) = unpack ("a1a1a*", $field);
+		
+		push (@field, $tag, $indi1, $indi2);
+		
+		my @subfields = split(/\037/,$field_data);
+		foreach (@subfields) {
+		    my $delim = substr($_,0,1);
+		    next unless $delim;
+		    my $subfield_data = substr($_,1);
+		    push(@field, $delim, $subfield_data);
+		    
+		} #end parsing subfields
+	    } #end testing tag number
+	    push(@{$record->{'array'}},\@field);
+	    $record-> add_map(\@field);
+	} #end processing this field
+    return ($record,1);
+}
+
+###################################################################
+# readmarcmaker() reads a marcmaker file into the MARC object     #
+###################################################################
+sub _readmarcmaker { # rec
+    my $marcrec = shift;
+    my $handle = $marcrec->{'handle'};
+    my $string = shift;
+    my $record;
+
+    unless (exists $marcrec->{'makerchar'}) {
+        $marcrec->{'makerchar'} = usmarc_default();	# hash ref
+    }
+    my $charset = $marcrec->{makerchar};
+    my $lineterm = $marcrec->{'lineterm'} || "\015\012";
+	# MS-DOS file default for MARCMaker
+
+      #Set the file input separator to "\r\n\r\n", which is the same as 
+      #a blank line. A single blank line separates individual MARC records
+      #in the MARCMakr format.
+    local $/ = "$lineterm$lineterm";	# cf. TPJ #14
+    local $^W = 0;	# no warnings
+    $record = $string if $string;
+    $record = <$handle> if $handle and !defined($string);
+
+    return (undef,undef) unless $record;
+    #Split each record on the "\n=" into the @fields array
+    my @lines=split "$lineterm=",$record;
+    my $leader = shift @lines;
+    unless ($leader =~ /^=LDR  /o) {
+	return (undef, -1);
+    }
+    
+    $leader=~s/^=LDR  //o;	#Remove "=LDR  "
+    $leader=~s/[\n\r]//og;
+    $leader=~s/\\/ /go;	# substitute " " for \
+    my $rec = $marcrec->createrecord($leader);
+    foreach my $line (@lines) {
+	#Remove newlines from @fields ; and also substitute " " for \
+	$line=~s/[\n\r]//og;
+	$line=~s/\\/ /go;
+	#get the tag name
+	my $tag = substr($line,0,3);
+	my @field=(); #this will be added to $marcrec and the map updated.
+	#if the tag is less than 010 (has no indicators or subfields)
+	#then push the data into @$field
+	if ($tag < 10) {
+	    my $value = _maker2char (substr($line,5), $charset);
+	    @field=($tag,$value);
+	}
+	else {
+	    #elseif the tag is greater than 010 (has indicators and 
+	    #subfields then add the data to the $marc object
+	    my $field_data=substr($line,7);
+	    my $i1=substr($line,5,1);
+	    my $i2=substr($line,6,1);
+	    @field = ($tag,$i1,$i2);
+	    
+	    my @subfields=split /\$/, $field_data; #get the subfields
+	    foreach my $subfield (@subfields) {
+		my $delim=substr($subfield,0,1); #extract subfield delimiter
+		next unless $delim;
+		my $subfield_data= MARC::_maker2char (substr($subfield,1),
+						      $charset);
+		#extract subfield value
+		push (@field, $delim, $subfield_data);
+	    } #end parsing subfields
+	} #end tag>10
+	print "DEBUG: tag = $tag\n" if $MARC::DEBUG;
+	push @{$rec->{'array'}},\@field;
+	$rec -> add_map(\@field);
+    } #end reading this line
+    return ($rec,1);
+} #end reading this record
+
+sub _maker2char { # rec
+    my $marc_string = shift;
+    my $charmap = shift;
+    while ($marc_string =~ /{(\w{1,8}?)}/o) {
+	if (exists ${$charmap}{$1}) {
+	    $marc_string = join ('', $`, ${$charmap}{$1}, $');
+	}
+	else {
+	    $marc_string = join ('', $`, '&', $1, ';', $');
+	}
+    }
+       # closing curly brace - part 2, permits {lcub}text{rcub} in input
+    $marc_string =~ s/\&rcub;/\x7d/go;
+    return $marc_string;
+}
+
+sub usmarc_default { # rec
+    my @hexchar = (0x00..0x1a,0x1c,0x7f..0x8c,0x8f..0xa0,0xaf,0xbb,
+		   0xbe,0xbf,0xc7..0xdf,0xfc,0xfd,0xff);
+    my %inchar = map {sprintf ("%2.2X",int $_), chr($_)} @hexchar;
+
+    $inchar{esc} = chr(0x1b);		# escape
+    $inchar{dollar} = chr(0x24);	# dollar sign
+    $inchar{curren} = chr(0x24);	# dollar sign - alternate
+    $inchar{24} = chr(0x24);		# dollar sign - alternate
+    $inchar{bsol} = chr(0x5c);		# back slash (reverse solidus)
+    $inchar{lcub} = chr(0x7b);		# opening curly brace
+    $inchar{rcub} = "&rcub;";		# closing curly brace - part 1
+    $inchar{joiner} = chr(0x8d);	# zero width joiner
+    $inchar{nonjoin} = chr(0x8e);	# zero width non-joiner
+    $inchar{Lstrok} = chr(0xa1);	# latin capital letter l with stroke
+    $inchar{Ostrok} = chr(0xa2);	# latin capital letter o with stroke
+    $inchar{Dstrok} = chr(0xa3);	# latin capital letter d with stroke
+    $inchar{THORN} = chr(0xa4);		# latin capital letter thorn (icelandic)
+    $inchar{AElig} = chr(0xa5);		# latin capital letter AE
+    $inchar{OElig} = chr(0xa6);		# latin capital letter OE
+    $inchar{softsign} = chr(0xa7);	# modifier letter soft sign
+    $inchar{middot} = chr(0xa8);	# middle dot
+    $inchar{flat} = chr(0xa9);		# musical flat sign
+    $inchar{reg} = chr(0xaa);		# registered sign
+    $inchar{plusmn} = chr(0xab);	# plus-minus sign
+    $inchar{Ohorn} = chr(0xac);		# latin capital letter o with horn
+    $inchar{Uhorn} = chr(0xad);		# latin capital letter u with horn
+    $inchar{mlrhring} = chr(0xae);	# modifier letter right half ring (alif)
+    $inchar{mllhring} = chr(0xb0);	# modifier letter left half ring (ayn)
+    $inchar{lstrok} = chr(0xb1);	# latin small letter l with stroke
+    $inchar{ostrok} = chr(0xb2);	# latin small letter o with stroke
+    $inchar{dstrok} = chr(0xb3);	# latin small letter d with stroke
+    $inchar{thorn} = chr(0xb4);		# latin small letter thorn (icelandic)
+    $inchar{aelig} = chr(0xb5);		# latin small letter ae
+    $inchar{oelig} = chr(0xb6);		# latin small letter oe
+    $inchar{hardsign} = chr(0xb7);	# modifier letter hard sign
+    $inchar{inodot} = chr(0xb8);	# latin small letter dotless i
+    $inchar{pound} = chr(0xb9);		# pound sign
+    $inchar{eth} = chr(0xba);		# latin small letter eth
+    $inchar{ohorn} = chr(0xbc);		# latin small letter o with horn
+    $inchar{uhorn} = chr(0xbd);		# latin small letter u with horn
+    $inchar{deg} = chr(0xc0);		# degree sign
+    $inchar{scriptl} = chr(0xc1);	# latin small letter script l
+    $inchar{phono} = chr(0xc2);		# sound recording copyright
+    $inchar{copy} = chr(0xc3);		# copyright sign
+    $inchar{sharp} = chr(0xc4);		# sharp
+    $inchar{iquest} = chr(0xc5);	# inverted question mark
+    $inchar{iexcl} = chr(0xc6);		# inverted exclamation mark
+    $inchar{hooka} = chr(0xe0);		# combining hook above
+    $inchar{grave} = chr(0xe1);		# combining grave
+    $inchar{acute} = chr(0xe2);		# combining acute
+    $inchar{circ} = chr(0xe3);		# combining circumflex
+    $inchar{tilde} = chr(0xe4);		# combining tilde
+    $inchar{macr} = chr(0xe5);		# combining macron
+    $inchar{breve} = chr(0xe6);		# combining breve
+    $inchar{dot} = chr(0xe7);		# combining dot above
+    $inchar{diaer} = chr(0xe8);		# combining diaeresis
+    $inchar{uml} = chr(0xe8);		# combining umlaut
+    $inchar{caron} = chr(0xe9);		# combining hacek
+    $inchar{ring} = chr(0xea);		# combining ring above
+    $inchar{llig} = chr(0xeb);		# combining ligature left half
+    $inchar{rlig} = chr(0xec);		# combining ligature right half
+    $inchar{rcommaa} = chr(0xed);	# combining comma above right
+    $inchar{dblac} = chr(0xee);		# combining double acute
+    $inchar{candra} = chr(0xef);	# combining candrabindu
+    $inchar{cedil} = chr(0xf0);		# combining cedilla
+    $inchar{ogon} = chr(0xf1);		# combining ogonek
+    $inchar{dotb} = chr(0xf2);		# combining dot below
+    $inchar{dbldotb} = chr(0xf3);	# combining double dot below
+    $inchar{ringb} = chr(0xf4);		# combining ring below
+    $inchar{dblunder} = chr(0xf5);	# combining double underscore
+    $inchar{under} = chr(0xf6);		# combining underscore
+    $inchar{commab} = chr(0xf7);	# combining comma below
+    $inchar{rcedil} = chr(0xf8);	# combining right cedilla
+    $inchar{breveb} = chr(0xf9);	# combining breve below
+    $inchar{ldbltil} = chr(0xfa);	# combining double tilde left half
+    $inchar{rdbltil} = chr(0xfb);	# combining double tilde right half
+    $inchar{commaa} = chr(0xfe);	# combining comma above
+    if ($MARC::DEBUG) {
+        foreach my $str (sort keys %inchar) {
+            printf "%s = %x\n", $str, ord($inchar{$str});
+        }
+    }
+    return \%inchar;
+}
+
+#################################################################### 
+
+# updatefirst() takes a template, a request to rebuild the index, and
+# an array from $marc->[recnum]{array}. It replaces/creates the field
+# data for a first match, using the template, and leaves the rest
+# alone. If the template has a subfield element, (this includes
+# indicators) it ignores all other information in the array and only
+# updates/creates based on the subfield information in the array. If
+# the template has no subfield information then indicators are left
+# untouched unless a new field needs to be created, in which case they
+# are left blank.
+
+####################################################################
+
+sub updatefirst { # rec
+    my $marcrec = shift || return;
+    my $template = shift;
+    return unless (ref($template) eq "HASH");
+    return unless (@_);
+    return if (defined $template->{'value'});
+
+
+    my @ufield = @_;
+    my $field = $template->{'field'};
+    my $subfield = $template->{'subfield'};
+    my $do_rebuild_map = $template->{'rebuild_map'};
+
+    $ufield[0]= $field;
+    my $ufield_lt_10_value = $ufield[1];
+    my $ftemplate = {field=>$field};
+    if (!$field) {mycarp "Need a field to configure my changing needs."; return undef}
+
+    my @fieldrefs = $marcrec->getfields($template);
+
+# An invariant is that at most one element of @fieldrefs is affected.
+    if ($field and not($subfield)) {
+	#save the indicators! Yes! Yes!
+	my ($i1,$i2) = (" "," ");
+	if (defined($fieldrefs[0])) {
+	    $i1 = $fieldrefs[0][1];
+	    $i2 = $fieldrefs[0][2];
+	}
+	$ufield[1]=$i1; 
+	$ufield[2]=$i2;
+	if ($field <10) {@ufield = ($field,$ufield_lt_10_value)}
+	my $rafieldrefs = \@fieldrefs;
+	$marcrec->field_updatehook(\@ufield);
+	$rafieldrefs->[0] = \@ufield;
+	if (!scalar(@fieldrefs)) {
+	    $marcrec->updatefields($template,$rafieldrefs);		
+	    return;
+	}
+	$fieldrefs[0]=\@ufield;
+#There is no issue with $fieldrefs being taken over by the splice in updatefields.
+# in current testing. Perl may change its behavior later...
+	$marcrec->updatefields($template,\@fieldrefs);
+	return;
+    } #end field.
+# The case of adding first subfields is hard.  (Not too bad with
+# indicators since every non-control field has them.)
+# OK, we have  field, and subfield. 
+	if ($field and $subfield) {
+	    if ($field <10) {croak "Cannot update subfields of control fields"; return undef}
+
+	    my $rvictim=0;
+	    my $fieldnum = 0;
+	    my $rval = 0;
+	    foreach my $fieldref (@fieldrefs) {
+		$rval = $marcrec->getmatch($subfield,$fieldref);
+		if ($rval){
+		    $rvictim=$fieldref;
+		    last;
+		}
+		$fieldnum++;
+	    }
+# At this stage we have the number of the field $fieldnum, 
+# whether there is a match, $rvictim,
+# and what to update if there is, $rval.
+
+	    if (!$rvictim and $subfield =~/^i[12]$/) {
+		mycarp "Field $field does not exist. Can only add indicator $subfield to existing fields.";
+		return undef;
+	    }
+	    #Now we need to find first match in @ufield.
+	    my $usub = undef;
+	    $usub=$ufield[1] if $subfield eq 'i1';
+	    $usub=$ufield[2] if $subfield eq 'i2';
+
+	    for(my  $i=3;$i<@ufield;$i = $i+2) {
+		my $sub = $ufield[$i]; 
+		if ($sub eq $subfield) {
+		    $usub = $ufield[$i+1];
+		    last;
+		}
+	    }
+	    mycarp(
+		 "Did not find $subfield in spec (".
+		 join " ", at ufield . ")" 
+		 ) if !defined($usub);
+
+	    if (!scalar(@fieldrefs)) {
+		my @newfield = ($field, ' ',' ', $subfield =>$usub);
+		my $rafields;
+		$marcrec->field_updatehook(\@newfield);
+		$rafields->[0] = \@newfield;
+		return $marcrec->updatefields($template,$rafields);
+	    }
+	    #The general insert case.
+	    if (!$rvictim and scalar(@fieldrefs)) {
+		$rvictim = $fieldrefs[0];
+		$marcrec->insertpos($subfield,$usub,$rvictim);
+		$marcrec->field_updatehook($rvictim);
+		$marcrec->rebuild_map($field) if $do_rebuild_map;
+		return 1; # $rvictim is now defined, so can't depend on future
+		          # control logic. 
+	    }
+	    #The general replace case.
+	    if ($rvictim) {
+		$$rval = $usub;
+		$marcrec->field_updatehook($rvictim);
+
+		# The following line is unecessary for this class:
+		# everything updates due to hard-coded ref
+		# relationships in the index.  Left so that subclasses
+		# can do their thing with less over-ruling.
+
+		$marcrec->rebuild_map($field) if $do_rebuild_map; 
+		return 1;
+		}
+	} #end $field and $subfield
+}
+
+####################################################################
+
+# updatefields() takes a template which specifies a
+# $do_rebuild_map and a field (needs the field in case $rafields->[0]
+# is empty). It also takes a ref to an array of fieldrefs formatted
+# like the output of getfields(), and replaces/creates the field
+# data. It assumes that it should remove the fields with the first tag
+# in the fieldrefs. It calls rebuild_map() if $do_rebuild_map.
+
+####################################################################
+sub updatefields { # rec
+    my $marcrec = shift || return;
+    my $template = shift;
+
+    my $do_rebuild_map = $template->{'rebuild_map'};
+    my $tag = $template->{'field'};
+    my $rafieldrefs = shift;
+    my @fieldrefs = @$rafieldrefs;
+
+
+    my $pos = 0;
+    my $first=undef;
+    my $last = $first; # Should be "Let the first be last". Misbegotten Perl syntax.
+    my $firstpast = undef;
+    my $len = 0;
+    my @mfields = @{$marcrec->{'array'}};
+    my $insertpos = undef;
+    for (@mfields) {
+	$first = $pos if ($_->[0] eq $tag and !defined($first)) ;
+	$last = $pos if $_->[0] eq $tag;
+	$firstpast  = $pos if ($_->[0] >= $tag and   !defined($firstpast)) ;
+	$pos++;
+    }
+    $len = $last - $first +1 if defined($first);
+    $insertpos = scalar(@mfields) if !defined($firstpast);
+    $insertpos = $first if (defined($first));
+    $insertpos = $firstpast unless $insertpos;
+    splice @{$marcrec->{'array'}},$insertpos,$len, at fieldrefs;
+    $marcrec->rebuild_map($tag) if $do_rebuild_map;
+}
+
+####################################################################
+# output() will call the appropriate output method using the marc  #
+# object and desired format parameters.                            # 
+####################################################################
+sub output {
+    my $marcrec=shift;
+    my $args=shift;
+    my $output = "";
+    my $newline = $args->{'lineterm'} || "\n";
+
+    $marcrec->add_005($args) if ($args->{'file'} or $args->{'add_005s'});
+
+    unless (exists $args->{'format'}) {
+	    # everything to string
+        $args->{'format'} = "usmarc";
+        $args->{'lineterm'} = $newline;
+    }
+    if ($args->{'format'} =~ /marc$/oi) {
+	$output = _writemarc($marcrec,$args);
+    }
+    elsif ($args->{'format'} =~ /marcmaker$/oi) {
+	$output = _marcmaker($marcrec,$args);
+    }
+    elsif ($args->{'format'} =~ /ascii$/oi) {
+	$output = _marc2ascii($marcrec,$args);
+    }
+    elsif ($args->{'format'} =~ /html$/oi) {
+	$output .= _marc2html($marcrec,$args);
+    }
+    elsif ($args->{'format'} =~ /html_header$/oi) {
+	$output = "Content-type: text/html\015\012\015\012";
+    }
+    elsif ($args->{'format'} =~ /html_start$/oi) {
+	if ($args->{'title'}) {
+            $output = "<html><head><title>$args->{'title'}</title></head>";
+	    $output .= "$newline<body>";
+	}
+	else {
+	    $output = "<html><body>";
+	}
+    }
+    elsif ($args->{'format'} =~ /html_body$/oi) {
+        $output =_marc2html($marcrec,$args);
+    }
+    elsif ($args->{'format'} =~ /html_footer$/oi) {
+	$output = "$newline</body></html>$newline";
+    }
+    elsif ($args->{'format'} =~ /urls$/oi) {
+	$output .= _urls($marcrec,$args);
+    }
+    elsif ($args->{'format'} =~ /isbd$/oi) {
+	$output = _isbd($marcrec,$args);
+    }
+    elsif ($args->{'format'} =~ /xml/oi) {
+	mycarp "XML formats are now handled by MARC::XML" if ($^W);
+	return;
+    }
+    if ($args->{'file'}) {
+	if ($args->{'file'} !~ /^>/) {
+	    mycarp "Don't forget to use > or >> with output file name";
+	    return;
+	}
+	open (OUT, $args->{file}) || mycarp "Couldn't open file: $!";
+	#above quote is bad if {file} is tainted. Is probably unecessary.dgl.
+        binmode OUT;
+	print OUT $output;
+	close OUT || mycarp "Couldn't close file: $!";
+	return 1;
+    }
+      #if no filename was specified return the output so it can be grabbed
+    else {
+	return $output;
+    }
+}
+
+####################################################################
+
+# add_005s takes a template and adds current 005s to the elements of
+# $marc mentioned in $template->{records}
+
+####################################################################
+sub add_005 {
+    my $marcrec=shift;
+    my $time = shift;
+    my @m005 = ('005', $time );
+    $marcrec->updatefirst({field=>'005'}, at m005);
+}
+
+##############################################################
+sub _joinfield { # rec
+    my $marcrec=shift;
+    my ($rfield,$field,$delim)=@_;
+    my $result;
+    return $rfield->[1] if $field<10;
+
+    if ($delim) {
+	foreach (my $i=3; $i<$#$rfield; $i+=2) {
+	    $result.=$delim.$rfield->[$i].$rfield->[$i+1];
+	}
+	return $result;
+    }
+
+    for (my $i=4; $i<=$#$rfield; $i=$i+2) {
+	$result.=$rfield->[$i];
+	$result.=" " unless $result=~/ $/;
+    }
+    return $result;
+}
+
+####################################################################
+
+# getmatch() takes a subfield code (can be an indicator) and a fieldref
+# Returns 0 or a ref to the value to be updated.
+
+####################################################################
+sub getmatch { # rec
+    my $marcrec = shift || return;
+    my $subf = shift;
+    my $rfield = shift;
+    my $tag = $rfield->[0];
+    if ($tag < 10) {mycarp "can't find subfields or indicators for control fields"; return undef}
+    return \$rfield->[1] if $subf eq 'i1';
+    return \$rfield->[2] if $subf eq 'i2';
+
+    for (my $i=3;$i<@$rfield;$i+=2) {
+	return \$rfield->[$i+1] if $rfield->[$i] eq $subf;
+    }
+    return 0;
+}
+
+####################################################################
+
+# deletesubfield() takes a subfield code (can not be an indicator) and a
+# fieldref. Deletes the subfield code and its value in the fieldref at
+# the first match on subfield code.  Assumes there is an exact
+# subfield match in $fieldref.
+
+####################################################################
+sub deletesubfield { # rec
+    my $marcrec = shift || return;
+    my $subf = shift;
+    my $rfield = shift;
+    my $tag = $rfield->[0];
+    if ($tag < 10) {mycarp "Can't use subfields or indicators for control fields"; return undef}
+
+    if ($subf =~/i[12]/) {mycarp "Can't delete an indicator."; return undef}
+    my $i=3;
+    for ($i=3;$i<@$rfield;$i+=2) {
+	last if $rfield->[$i] eq $subf;
+    }
+    splice @$rfield,$i,2; 
+    
+}
+
+####################################################################
+
+# insertpos() takes a subfield code (can not be an indicator), a
+# value, and a fieldref. Updates the fieldref with the first
+# place that the fieldref can match. Assumes there is no exact
+# subfield match in $fieldref.
+
+####################################################################
+sub insertpos { # rec
+    my $marcrec = shift || return;
+    my $subf = shift;
+    my $value = shift;
+    my $rfield = shift;
+    my $tag = $rfield->[0];
+    if ($tag < 10) {mycarp "Can't use subfields or indicators for control fields"; return undef}
+
+    if ($subf =~/i[12]/) {mycarp "Can't insert past an indicator."; return undef}
+    my $i=3;
+    for ($i=3;$i<@$rfield;$i+=2) {
+	last if $rfield->[$i] gt $subf;
+    }
+    splice @$rfield,$i,0,$subf,$value;
+}
+
+####################################################################
+
+# getfirstvalue() will return the first value of a field or subfield
+# or indicator or i12 in a particular record found in the MARC
+# object. It does not depend on the index being up to date.
+
+####################################################################
+sub getfirstvalue { # rec
+    my $marcrec= shift;
+    my $template=shift;
+    return unless (ref($template) eq "HASH");
+    my $field  = $template->{'field'};
+    my $delim  = $template->{'delimiter'};
+    my $subfield;
+    $subfield = $template->{'subfield'} if $template->{'subfield'};
+    
+    if (not($field)) {mycarp "You must specify a field"; return}
+    unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return}
+    my @fieldrefs = grep {$_->[0] eq $field} @{$marcrec->{'array'}};
+    return unless @fieldrefs;
+    if ($field and not $subfield) {
+	return $marcrec->_joinfield($fieldrefs[0],$field,$delim);
+    } elsif ($field and $subfield) {
+	if ($field <10) {mycarp "There are no subfields or indicators for control fields";return}
+	return $fieldrefs[0][1].$fieldrefs[0][2] if $subfield eq 'i12';
+	my $rsubf = undef;
+	foreach my $fieldref (@fieldrefs) {
+	    $rsubf =$marcrec->getmatch($subfield,$fieldref);
+	    return $$rsubf if $rsubf;
+	}
+	return undef unless $rsubf;
+    }
+}
+####################################################################
+# getvalue() will return the value of a field or subfield in a     #
+# particular record found in the MARC object                       #
+####################################################################
+sub getvalue { # rec
+    my $marcrec = shift;
+    my $template=shift;
+    return unless (ref($template) eq "HASH");
+    my $params = _params($template, at _);
+
+    my $field = $params->{field};
+    if (not($field)) {mycarp "You must specify a field"; return}
+    unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return}
+    my $subfield = $params->{subfield};
+    my $delim = $params->{delimiter};
+    my @values;
+    if ($field and not($subfield)) {
+	return unless exists $marcrec->{$field};
+	if ($field eq '000') { return $marcrec->{'000'}[1] };
+	foreach my $rfield (@{$marcrec->{$field}{field}}) {
+	    push @values, 
+	    $marcrec->_joinfield($rfield,$field,$delim);
+	}
+	return @values;
+    }
+    elsif ($field and $subfield) {
+	return unless exists $marcrec->{$field};
+	return unless exists $marcrec->{$field}{$subfield};
+	if ($subfield eq "i1" || $subfield eq "i2" || $subfield eq "i12") {
+	    my @shortone = @{$marcrec->{$field}{field}};
+	    foreach my $rfield (@shortone) {
+		if ($subfield eq 'i1') {
+	            push @values, $rfield->[1];
+		}
+		elsif ($subfield eq 'i2') {
+	            push @values, $rfield->[2];
+		}
+		else {
+	            push @values, $rfield->[1].$rfield->[2];
+		}
+	    }
+	    return @values;
+	}
+	foreach my $rval (@{$marcrec->{$field}{$subfield}}) {
+	    push @values, $$rval;
+	}
+	return @values;
+    }
+}
+
+####################################################################
+#Returns LDR at $record.                                           #
+####################################################################
+sub ldr { # rec
+    my $marcrec = shift;
+    return $marcrec->{array}[0][1];
+}
+
+
+####################################################################
+#Takes a record number and returns a hash of fields.               #
+#Needed to determine the format (BOOK, VIS, etc) of                #
+#the record.                                                       #
+#Folk also like to know what Ctrl, Desc etc are.                   #
+####################################################################
+sub unpack_ldr { # rec
+    my $marcrec = shift;
+
+    my $ldr = $marcrec->ldr();
+    my $rhldr = $marcrec->_unpack_ldr($ldr);
+    $marcrec->{unp_ldr}=$rhldr;
+    return $rhldr;
+}
+
+    
+sub _unpack_ldr { # rec
+    my ($marcrec,$ldr) = @_;
+
+    my %ans=();
+
+    my @fields=unpack($LDR_TEMPLATE,$ldr);
+    for (@LDR_FIELDS) {
+	$ans{$_}=shift @fields;
+    }
+    return \%ans;
+}
+
+
+####################################################################
+#Takes a record number.                                            #
+#Returns the unpacked ldr as a ref to hash from the ref in $self.  #
+#Does not overwrite hash from ldr.                                 #
+####################################################################
+sub get_hash_ldr { # rec
+    my $marcrec = shift;
+    return undef unless exists($marcrec->{unp_ldr});
+    return $marcrec->{unp_ldr};
+}
+
+####################################################################
+# Takes a record number and updates the corresponding ldr if there
+# is a hashed form. Returns undef unless there is a hash. Else
+# returns $ldr.
+####################################################################
+sub pack_ldr { # rec
+    my $marcrec = shift;
+    return undef unless exists($marcrec->{unp_ldr});
+    my $rhldr = $marcrec->{unp_ldr};
+    my $ldr = $marcrec -> _pack_ldr($rhldr);
+    $marcrec->{array}[0][1] = $ldr;
+    return $ldr;
+}
+
+####################################################################
+#Takes a ref to hash version of the LDR and returns a string       #
+# version                                                          #
+####################################################################
+sub _pack_ldr { # rec
+
+    my ($marcrec,$rhldr) = @_;
+    my @fields=();
+
+    for (@LDR_FIELDS) {
+	push @fields,$rhldr->{$_};
+    }
+    my $ans = pack($LDR_TEMPLATE, at fields);
+    return $ans;
+}
+
+####################################################################
+#Takes a string record number.                                     #
+#Returns a the format necessary to pack/unpack 008 fields correctly#
+####################################################################
+sub bib_format { # rec
+    my ($marcrec)=@_;
+    $marcrec->pack_ldr();
+    my $ldr = $marcrec->ldr();
+    return $marcrec->_bib_format($ldr);
+}
+
+sub _bib_format { # rec
+    my ($marcrec,$ldr)=@_;
+    my $rldr=$marcrec->_unpack_ldr($ldr);
+    my ($type,$bib_lvl) = ($rldr->{'Type'},$rldr->{'BLvl'});
+    return "UNKNOWN (Type $type Bib_Lvl $bib_lvl)" unless ($type=~/[abcdefgijkmprot]/ &&
+							   (($bib_lvl eq "") or 
+							    $bib_lvl=~/[abcdms]/)
+							   );
+
+    return "BOOKS" if (
+		       (
+			($type eq "a") && !($bib_lvl =~/[bs]/)
+			)
+		       or $type eq "t" or $type eq "b"
+		       ); #$type b is obsolete, 'tho.
+    return "SERIALS" if (
+			 ($type eq "a") && 
+			 ($bib_lvl =~/[bs]/)
+			 );
+    return "COMPUTER_FILES" if ($type =~/m/);
+    return "MAPS" if ($type =~/[ef]/);
+    return "MUSIC" if ($type =~/[cdij]/);
+    return "VIS" if ($type =~/[gkro]/);
+    return "MIX" if ($type =~/p/);
+    return "UNKNOWN (Type $type Bib_Lvl $bib_lvl) ??"; # Shouldn't happen
+}
+
+####################################################################
+#Takes a record number.                                            #
+#Returns the unpacked 008 as a ref to hash. Installs ref in $self. #
+####################################################################
+sub unpack_008 { # rec
+    my ($marcrec) = @_;
+    my ($ff_string) = $marcrec->getfirstvalue({field=>'008'});
+    my $bib_format = $marcrec->bib_format();
+    my $rh008= $marcrec->_unpack_008($ff_string,$bib_format);
+    $marcrec->{unp_008}=$rh008;
+    return $rh008;
+}
+
+sub _unpack_008 { # rec
+    my ($marcrec,$ff_string,$bib_format) = @_;
+    my %ans=();
+
+    my $ff_templ=$FF_TEMPLATE{$bib_format};
+    my $raff_fields=$FF_FIELDS{$bib_format};
+    if ($bib_format =~/UNKNOWN/) {
+        mycarp "Format is $bib_format";
+	return;
+    }
+    my @fields=unpack($ff_templ,$ff_string);
+    for (@{$raff_fields}) {
+      $ans{$_}=shift @fields;
+    }
+    return \%ans;
+}
+
+####################################################################
+#Takes a record number.                                            #
+#Returns the unpacked 008 as a ref to hash from the ref in $self.  #
+#Does not overwrite hash from 008 field.                           #
+####################################################################
+sub get_hash_008 { # rec
+    my ($marcrec)=@_;
+    return undef unless exists($marcrec->{unp_008});
+    return $marcrec->{unp_008};
+}
+
+####################################################################
+#Takes a record number. Flushes hashes to 008 and ldr.             #
+#Updates the 008 field from an installed fixed field hash.    
+#Returns undef unless there is a hash, else returns the 008 field  #
+####################################################################
+sub pack_008 { # rec
+    my ($marcrec) = @_;
+    $marcrec->pack_ldr();
+    my $ldr = $marcrec->ldr();
+    my $rhff = $marcrec->get_hash_008();
+    return undef unless $rhff;
+    my $ff_string = $marcrec->_pack_008($ldr,$rhff);
+    $marcrec->updatefirst({field=>'008'},$ff_string);
+    return $ff_string;
+}
+
+####################################################################
+#Takes LDR and ref to hash of unpacked 008                         #
+#Returns string version of 008 *without* newlines.                 #
+####################################################################
+sub _pack_008 { # rec
+    my ($marcrec,$ldr,$rhff) = @_;
+    my $bib_format = $marcrec->_bib_format($ldr);
+    my $ans  = "";
+    my @fields = ();
+    for (@{$FF_FIELDS{$bib_format}}) {
+	push @fields, $rhff->{$_};
+    }
+    $ans = pack($FF_TEMPLATE{$bib_format}, at fields);
+    return $ans;
+}
+
+####################################################################
+
+# as_string returns a newline-\c^ separated version of the record.
+# Subclasses may need to override this. If so, to make Tie happy,
+# they should override from_string. 000 is ldr.
+
+####################################################################
+
+sub as_string {
+    my $marcrec=shift;
+    my $SEP = "\cJ"; #unix newline
+    my $ans = "";
+    for (@{$marcrec->{'array'}}) {
+	my $tag = $_->[0];
+	if ($tag < 10) {
+	    $ans .= "$tag $_->[1]$SEP";
+	    next;
+	}
+	$ans .= "$tag $_->[1]$_->[2] ";
+	foreach (my $i=3; $i<$#$_; $i+=2) {
+	    $ans .="\c_$_->[$i]$_->[$i+1]";
+	}
+	$ans .=$SEP;
+    }
+    return $ans;
+}
+
+####################################################################
+
+# from_string takes a newline-\c^ separated version of the record
+# and replaces the {array} information from that information.
+# Subclasses may need to override this. If so, to make Tie happy,
+# they should override as_string. 000 is ldr.
+
+####################################################################
+sub from_string {
+    my $marcrec=shift;
+    my $string = shift;
+    my $do_rebuild_map = shift;
+    my $SEP = "\cJ"; #unix newline
+    my @lines = split /$SEP/,$string;
+    @{$marcrec->{'array'}}=();
+    for (@lines) {
+	next if /^\s*$/;
+	my $tag = substr($_,0,3);
+	if ($tag < 10) {
+	    my $contents = substr($_,4);
+	    push @{$marcrec->{'array'}}, [$tag, $contents];
+	    next;
+	}
+	my ($i1,$i2,$sub_string) = (substr($_,4,1),substr($_,5,1),substr($_,7));
+	my @field = ($tag,$i1,$i2);
+	my @subfields = split /\c_(.)/,$sub_string;
+	shift @subfields if $subfields[0] eq ''; # feature of split.
+	push @field, at subfields;
+	push @{$marcrec->{'array'}}, [@field];
+    }
+    $marcrec->rebuild_map_all() if $do_rebuild_map;
+}
+
+1;  # so the require or use succeeds
+
+__END__
+
+
+####################################################################
+#                  D O C U M E N T A T I O N                       #
+####################################################################
+
+=pod
+
+=head1 NAME
+
+MARC.pm - Perl extension to manipulate MAchine Readable Cataloging records.
+
+=head1 SYNOPSIS
+
+  use MARC;
+
+	# constructors
+  $x=MARC->new();
+  $x=MARC->new("filename","fileformat");
+  $x->openmarc({file=>"makrbrkr.mrc",'format'=>"marcmaker",
+		increment=>"5", lineterm=>"\n",
+		charset=>\%char_hash});
+  $record_num=$x->createrecord({leader=>"00000nmm  2200000 a 4500"});
+
+	# input/output operations
+  $y=$x->nextmarc(10);			# increment
+  $x->closemarc();
+  print $x->marc_count();
+  $x->deletemarc({record=>'2',field=>'110'});
+  $y=$x->selectmarc(['4','21-50','60']);
+
+	# character translation
+  my %inc = %{$x->usmarc_default()};	# MARCMaker input charset
+  my %outc = %{$x->ustext_default()};	# MARCBreaker output charset
+
+	# data queries
+  @records = $x->searchmarc({field=>"245"});
+  @records = $x->searchmarc({field=>"260",subfield=>"c",
+			     regex=>"/19../"});
+  @records = $x->searchmarc({field=>"245",notregex=>"/huckleberry/i"});
+  @results = $x->getvalue({record=>'12',field=>'856',subfield=>'u'});
+
+	# header and control field operations
+  $rldr = $x->unpack_ldr($record);
+  print "Desc is $rldr->{Desc}";
+  next if ($x->bib_format($record) eq 'SERIALS');
+  $rff = $x->unpack_008($record);
+  last if ($rff->{'Date1'}=~/00/ or $rff->{'Date2'}=~/00/);
+
+	# data modifications
+  $x->addfield({record=>"2", field=>"245",
+		i1=>"1", i2=>"4", ordered=>'y', value=>
+		[a=>"The adventures of Huckleberry Finn /",
+                 c=>"Mark Twain ; illustrated by E.W. Kemble."]});
+
+  my $update245 = {field=>'245',record=>2,ordered=>'y'};
+  my @u245 = $x->getupdate($update245);
+  $x->deletemarc($update245);
+  $x->addfield($update245, @u245_modified);
+ 
+	# outputs
+  $y = $x->output({'format'=>"marcmaker", charset=>\%outc});
+  $x->output({file=>">>my_text.txt",'format'=>"ascii",record=>2});
+  $x->output({file=>">my_marcmaker.mkr",'format'=>"marcmaker",
+	      nolinebreak=>'y',lineterm=>'\n'});
+  $x->output({file=>">titles.html",'format'=>"html", 245=>"Title: "});    
+
+        # manipulation of individual marc records.
+  @recs = $x[1..$#$x];
+  grep {$_->unpack_ldr() && 0} @recs;
+  @LCs = grep {$_->unp_ldr{Desc} eq 'a' &&
+	       $_->getvalue({field=>'040'}) =~/DLC\c_.DLC/} @recs;
+  foreach my $rec (@LCs) {
+	  print $rec->output({format=>'usmarc'});
+  }
+  
+        # manipulation as strings.
+  foreach my $rec (@LCs) {
+	  my $stringvar = $rec->as_string();
+	  $stringvar=~s[^(
+			  100\s # main entries of this stripe..
+			  ..\s # (don't care about indicators)
+			  \c_.\s*
+			  )(\S) # take the first letter..
+			] [
+			${1}uc($2) # and upcase it. All authors have 
+				   # upcase first letters in my library.
+			]xm; # x means 'ignore whitespace and allow
+			     # embedded comments'. 
+	 $rec->from_string($stringvar);
+	 my ($i2,$article) = $stringvar =~/245 .(.) \c_.(.{0,9})/;	
+	 $article = substr($article,0,$i2) if $i2=~/\d/;
+	 print "article $article is not common" unless $COMMON_ARTS{$article};
+  }
+	 
+  
+
+=head1 DESCRIPTION
+
+MARC.pm is a Perl 5 module for reading in, manipulating, and outputting bibliographic records in the I<USMARC> format. You will need to have Perl 5.004 or greater for MARC.pm to work properly. Since it is a Perl module you use MARC.pm from one of your own Perl scripts. To see what sorts of conversions are possible you can try out a web interface to MARC.pm which will allow you to upload MARC files and retrieve the results (for details see the section below entitled "Web Interface"). 
+
+However, to get the full functionality you will probably want to install MARC.pm on your server or PC. MARC.pm can handle both single and batches of MARC  records. The limit on the number of records in a batch is determined by the memory capacity of the machine you are running. If memory is an issue for you MARC.pm will allow you to read in records from a batch gradually. MARC.pm also includes a variety of tools for searching, removing, and even creating records from scratch.
+
+=head2 Types of Conversions:
+
+=over 4
+
+=item *
+
+MARC -> ASCII : separates the MARC fields out into separate lines
+
+=item *
+
+MARC <-> MARCMaker : The MARCMaker format is a format that was developed by the
+I<Library of Congress> for use with their DOS based I<MARCMaker> and
+I<MARCBreaker> utilities. This format is particularly useful for making 
+global changes (ie. with a text editor's search and replace) and then converting back to MARC (MARC.pm will read properly formatted MARCMaker records). For more information about the MARCMaker format see http://lcweb.loc.gov/marc/marcsoft.html
+
+=item *
+
+MARC -> HTML : The MARC to HTML conversion creates an HTML file
+from the fields and field labels that you supply. You could possibly use
+this to create HTML bibliographies from a batch of MARC records. 
+
+=item *
+
+MARC E<lt>-E<gt> XML : XML support is handled by MARC::XML which is a subclass of MARC.pm and is 
+also available for download from the CPAN.
+
+=item *
+
+MARC -> URLS : This conversion will extract URLs from a batch of MARC records. The URLs are found in the 856 field, subfield u. The HTML page that is generated can then be used with link-checking software to determine which URLs need to be repaired. Hopefully library system vendors will soon support this activity soon and make this conversion unecessary!
+
+=back
+
+=head2 Downloading and Installing
+
+=over 4
+
+=item Download
+
+The module is provided in standard CPAN distribution format. It will
+extract into a directory MARC-version with any necessary subdirectories.
+Change into the MARC top directory. Download the latest version from 
+http://www.cpan.org/modules/by-module/MARC/
+
+=item Unix
+
+    perl Makefile.PL
+    make
+    make test
+    make install
+
+=item Win9x/WinNT/Win2000
+
+    perl Makefile.PL
+    perl test.pl
+    perl install.pl
+
+=item Test
+
+Once you have installed, you can check if Perl can find it. Change to some
+other directory and execute from the command line:
+
+    perl -e "use MARC"
+
+If you do not get any response that means everything is OK! If you get an
+error like I<Can't locate method "use" via package MARC>.
+then Perl is not able to find MARC.pm--double check that the file copied
+it into the right place during the install.
+
+=back
+
+=head2 Todo
+
+=over 4
+
+=item *
+
+Support for other MARC formats (UKMARC, FINMARC, etc).
+
+=item *
+
+Create a map and instructions for using and extending the MARC.pm data
+structure.
+
+=item *
+
+Develop better error catching mechanisms.
+
+=item *
+
+Support for MARC E<lt>-E<gt> Unicode character conversions.
+
+=item *
+
+MARC E<lt>-E<gt> EAD (Encoded Archival Description) conversion?
+
+=item *
+
+MARC E<lt>-E<gt> DC/RDF (Dublin Core Metadata encoded in the Resource Description Framework)?
+
+=back
+
+=head2 Web Interface
+
+A web interface to MARC.pm is available at
+http://libstaff.lib.odu.edu/cgi-bin/marc.cgi where you can upload records and
+observe the results. If you'd like to check out the cgi script take a look at
+http://libstaff.lib.odu.edu/depts/systems/iii/scripts/MARCpm/marc-cgi.txt However, to get the full functionality you will want to install MARC.pm on your server or PC.
+
+=head2 Option Templates
+
+A MARC record is a complex structure. Hence, most of the methods have a number
+of options. Since a series of operations frequently uses many the same options
+for each method, you can create a single variable that forms a "template" for
+the desired options. The variable points to a hash - and the hash keys have
+been selected so the same hash works for all of the related methods.
+
+    my $loc852 = {record=>1, field=>'852', ordered=>'y'};
+    my ($found) = $x->searchmarc($loc852);
+    if (defined $found) {
+        my @m852 = $x->getupdate($loc852);
+        $x->deletemarc($loc852);
+            # change @m852 as desired
+        $x->updaterecord($loc852, @m852fix);
+    }
+    else {
+        $x->addfield($loc852, @m852new);
+    }
+
+The following methods are specifically designed to work together using
+I<Option Templates>. The B<required> options are shown as B<bold>. Any
+C<(default)> options are shown in parentheses. Although B<deletemarc()>
+permits an array for the I<record> option, a single I<record> should be
+used in a Template. The I<subfield> option must not be used in a
+Template that uses both B<deletemarc> and one of the methods that
+acts on a complete I<field> like B<addfield()>. The I<value> option
+must not be used with B<updaterecord()>.
+ 
+
+=over 4
+
+deletemarc() - field (all), record (all), subfield [supplemental]
+
+searchmarc() - B<field>, regex, notregex, subfield [supplemental]
+
+getvalue() - B<record>, B<field>, subfield, delimiter [supplemental]
+
+getupdate() - B<record>, B<field>
+
+addfield() - B<record>, B<field>, i1 (' '), i2 (' '), value, ordered ('y')
+
+updaterecord() - B<record>, B<field>, i1 (' '), i2 (' '), ordered ('y')
+
+=back
+
+The methods that accept a I<subfield> option also accept specifying it as a
+supplemental parameter. Supplemental parameters append/overwrite the hash
+values specified in the template.
+
+    $x->deletemarc($loc852, 'subfield','k');
+
+    my $f260 = {field=>"260",regex=>"/19../"};
+    my @records=$x->searchmarc($f260,'subfield','c');
+    foreach $found (@records) {
+        $value = $x->getvalue($f260,'record',"$found",'field',"245");
+        print "TITLE: $value\n";
+    }
+
+=head1 METHODS
+
+
+Here is a list of the methods in MARC.pm that are available to you for reading in, manipulating and outputting MARC data.
+
+=head2 new()
+
+Creates a new MARC object. 
+
+    $x = MARC->new();
+
+You can also use the optional I<file> and I<format> parameters to create and populate the object with data from a file. If a file is specified it will read in the entire file. If you wish to read in only portions of the file see openmarc(), nextmarc(), and closemarc() below. The I<format> defaults to C<'usmarc'> if not specified. It is only used when a I<file> is given.
+
+    $x = MARC->new("mymarc.dat","usmarc");
+    $x = MARC->new("mymarcmaker.mkr","marcmaker");
+
+Creates a new MARC::Rec object.
+
+    $rec=MARC::Rec->new();
+    $rec=MARC::Rec->new($filehandle,"usmarc");
+
+MARC::Rec objects are typically created by reading from a filehandle using nextrec()
+and a proto MARC::Rec object or by directly stuffing the @{$rec->{'array'}} array.
+    
+
+
+=head2 openmarc()
+
+Opens a specified file for reading data into a MARC object. If no format is specified openmarc() will default to USMARC. The I<increment> parameter defines how many records you would like to read from the file. If no I<increment> is defined then the file will just be opened, and no records will be read in. If I<increment> is set to -1 then the entire file will be read in.
+
+    $x = new MARC;
+    $x->openmarc({file=>"mymarc.dat",'format'=>"usmarc",
+		  increment=>"1"});
+    $x->openmarc({file=>"mymarcmaker.mkr",'format'=>"marcmaker",
+		  increment=>"5"});
+
+note: openmarc() will return the number of records read in. If the file opens
+successfully, but no records are read, it returns C<"0 but true">. For example:
+
+    $y=$x->openmarc({file=>"mymarc.dat",'format'=>"usmarc",
+		     increment=>"5"});
+    print "Read in $y records!";
+
+When the I<MARCMaker> format is specified, the I<lineterm> parameter can be
+used to override the CRLF line-ending default (the format was originally
+released for MS-DOS). A I<charset> parameter accepts a hash-reference to a
+user supplied character translation table. The "usmarc.txt" table supplied
+with the LoC. MARCMaker utility is used internally as the default. You can
+use the B<usmarc_default> method to get a hash-reference to it if you only
+want to modify a couple of characters. See example below.
+
+    $x->openmarc({file=>"makrbrkr.mrc",'format'=>"marcmaker",
+		  increment=>"5",lineterm=>"\n",
+		  charset=>\%char_hash});
+
+=head2 nextmarc()
+
+Once a file is open nextmarc() can be used to read in the next group of records. The increment can be passed to change the number of records read in if necessary. An increment of -1 will read in the rest of the file. Specifying the increment will change the value set with openmarc(). Otherwise, that value is the default.
+
+    $x->nextmarc();
+    $x->nextmarc(10);
+    $x->nextmarc(-1);
+
+note: Similar to openmarc(), nextmarc() will return the number of records read in. 
+
+    $y=$x->nextmarc();
+    print "$y more records read in!";
+
+=head2 nextrec()
+
+MARC:Rec instances can read from a filehandle and produce a new MARC::Rec instance.
+If nextrec is passed a string, it will read from that instead. The string should be
+formatted according to the {format} field of the instance.
+
+Cases where a new instance cannot be created are classified by a status value:
+
+    my ($newrec,$status) = $rec->nextrec();
+
+$status is undefined if we are at the end of the filehandle. If the
+data read from the filehandle cannot be made into a marc record,
+$status will be negative.  For example, $status is -1 if there is a
+distinction between recsize and leader definition of recsize, and -2
+if the leader is not numeric.
+
+An idiom for reading records incrementally with MARC::Recs is:
+
+    my $proto=MARC::Rec->new($filehandle,$format);
+    while (1) {
+	  my ($rec,$status)=$proto->nextrec();
+	  last unless $status;
+	  die "Bad record, bad, bad record: error $status"
+	      if $status <0;
+	  print $rec->output({$format=>'ascii'});
+	  # or replace print and output with your own functions/methods.
+    }
+    close $filehandle or die "File $filehandle is not happy on close\n";
+
+If you are getting records from an external source as strings, the idiom is:
+
+    my $proto=MARC::Rec->new($filehandle,$format);
+    while (1) {
+          my $string = get_external_marc();
+          last unless $string;
+          my ($rec,$status)=$proto->nextrec($string);
+          last unless $status;
+          die "Bad record, bad, bad record: error $status"
+              if $status <0;
+          print $rec->output({$format=>'ascii'});
+          # or replace print and output with your own functions/methods.
+    }
+
+
+=head2 closemarc()
+
+If you are finished reading in records from a file you should close it immediately.
+
+    $x->closemarc();
+
+=head2 add_map()
+
+add_map() takes a recnum and a ref to a field in ($tag,
+$i1,$i2,a=>"bar",...) or ($tag, $field) formats and will append to the
+various indices that we have hanging off that record.  It is intended
+for use in creating records de novo and as a component for
+rebuild_map(). It carefully does not copy subfield values or entire
+fields, maintaining some reference relationships.  What this means for
+indices created with add_map that you can directly edit subfield
+values in $marc->[recnum]{array} and the index will adjust
+automatically. Vice-versa, if you edit subfield values in
+$marc->{recnum}{tag}{subfield_code} the fields in
+$marc->[recnum]{array} will adjust. If you change structural
+information in the array with such an index, you must rebuild the part
+of the index related to the current tag (and possibly the old tag if
+you change the tag).
+
+   use MARC 1.02;
+   while (<>) {
+        chomp;
+        my ($author,$title) = split(/\t/);
+        my $rnum = $x->createrecord({leader=>
+			    	       "00000nmm  2200000 a 4500"});
+
+        my @auth = (100, ' ', ' ', a=>$author);
+        my @title = (245, ' ', ' ', a=>$title);
+        push @{$x->[$rnum]{array}}, \@auth;
+        $x->add_map($rnum,\@auth);
+        push @{$x->[$rnum]{array}}, \@title;
+        $x->add_map($rnum,\@title);
+   }
+
+MARC::Rec::add_map($rfield) does not need the record specification and has the same
+effect as add_map.
+
+=head2 rebuild_map
+
+rebuild_map takes a recnum and a tag and will synchronise the index with
+the array elements of the marc record at the recnum with that tag.
+
+      #Gonna change all 099's to 092's since this is a music collection.
+      grep {$->[0] =~s/099/092} @{$x->[$recnum]{array}};
+      
+      #Oops, now the index is out of date on the 099's...
+      $x->rebuild_map($recnum,099);
+      #... and the 092's since we now have new ones.
+      $x->rebuild_map($recnum,092);
+      #All fixed.
+
+MARC::Rec::rebuild_map($tag) does not need the record number and has the same effect
+as rebuild_map.
+
+=head2 rebuild_map_all
+
+rebuild_map takes a recnum and will synchronise the index with
+the array elements of the marc record at the recnum.
+
+MARC::Rec::rebuild_map_all() does not need the record number and has the same effect
+as rebuild_map_all.
+
+=head2 getfields
+
+getfields takes a template and returns an array of fieldrefs from the
+record number implied by that template. The fields referred are 
+fields from the $marc->[$recnum]{array} group. The fields are all
+fields from the first one with the tag from the template to the last
+with that tag. Some marc records (e.g. cjk) may have fields with other
+tags mixed in. Consecutive calls to updatefields with a different
+tag and the same record are probably a bad idea unless you have assurance
+that fields with the same tag are always together.
+
+MARC::Rec::getfields is identical to getfields, but ignores any record
+specification in the template.
+
+=head2 marc_count()
+
+Returns the total number of records in a MARC object. This method was
+previously named B<length()>, but that conflicts with the Perl built-in
+of the same name. Use the new name, the old one is deprecated and will
+disappear shortly.
+
+    $length=$x->marc_count();
+
+=head2 getfirstvalue()
+
+getfirstvalue will return the first value of a field or subfield or
+indicator or i12 in a particular record found in the MARC object. It
+does not depend on the index being up to date.
+
+MARC::Rec::getfirstvalue is identical to getfields, but ignores any record
+specification in the template.
+
+=head2 getvalue()
+
+This method will retrieve MARC field data from a specific record in the MARC object. getvalue() takes four parameters: I<record>, I<field>, I<subfield>, and I<delimiter>. Since a single MARC record could contain several of the fields or subfields the results are returned to you as an array. If you only pass I<record> and I<field> you will be returned the entire field without subfield delimiters. Optionally you can use I<delimiter> to specify what character to use for the delimiter, and you will also get the subfield delimiters. If you also specify I<subfield> your results will be limited to just the contents of that subfield. Repeated subfield occurances will end up in separate array elements in the order in which they were read in. The I<subfield> designations C<'i1', 'i2' and 'i12'> can be used to get indicator(s).
+
+        #get the 650 field(s)
+    @results = $x->getvalue({record=>'1',field=>'650'}); 
+
+	#get the 650 field(s) with subfield delimiters (ie. |x |v etc)
+    @results = $x->getvalue({record=>'1',field=>'650',delimiter=>'|'});
+
+        #get all of the subfield u's from the 856 field
+    @results = $x->getvalue({record=>'12',field=>'856',subfield=>'u'});
+
+MARC::Rec::getvalue($template) is identical to getvalue, but ignores any record specification.
+
+=head2 unpack_ldr($record)
+
+Returns a ref to a hash version of the record'th LDR.
+Installs the ref in $marc as $marc->[$record]{unp_ldr}
+
+    my $rldr = $x->unpack_ldr(1);
+    print "Desc is $rldr{Desc}";
+    my ($m040) = $x->getvalues({record=>'1',field=>'040'});
+    print "First record is LC, let's leave it alone" 
+          if $rldr->{'Desc'} eq 'a' && $m040=~/DLC\s*\c_c\s*DLC/; 
+
+The hash version contains the following information:
+
+	Key		000-Pos	length	Function [standard value]
+	---     	-------	------	--------
+	rec_len		00-04	   5	Logical Record Length
+	RecStat		05	   1	Record Status
+	Type		06	   1	Type of Record
+	BLvl		07	   1	Bibliographic Level
+	Ctrl		08	   1
+	Undefldr	09-11	   3	[x22]
+	base_addr	12-16	   5	Base Address of Data
+	ELvl		17	   1	Encoding Level
+	Desc		18	   1	Descriptive Cataloging Form
+	ln_rec		19	   1	Linked-Record Code
+	len_len_field	20	   1	Length "length of field" [4]
+	len_start_char	21	   1	Length "start char pos" [5]
+	len_impl	22	   1	Length "implementation dep" [0]
+	Undef2ldr	23	   1	[0]
+
+MARC::Rec::unpack_ldr() is identical to unpack_ldr, but does not need the record number.
+
+=head2 get_hash_ldr($record)
+
+Takes a record number. Returns a ref to the cached version of the hash ldr if it exists.
+Does this *without* overwriting the hash ldr. Allows external code to safely manipulate
+hash versions of the ldr.
+
+     my $rhldr = $marc->get_hash_ldr($record);
+     return undef unless $rhldr;
+     $rhldr->{'Desc'} =~ s/a/b/;
+     $ldr = $x->pack_ldr($record);
+
+MARC::Rec::get_hash_ldr() is identical to get_hash_ldr, but does not need the record number.
+
+=head2 pack_ldr($record)
+
+Takes a record number. Updates the appropriate ldr. 
+
+     $marc->[$record]{'unp_ldr'}{'Desc'} =~ s/a/b/;
+     my $ldr = $x->pack_ldr($record);
+     return undef unless $ldr;
+
+MARC::Rec::pack_ldr() is identical to pack_ldr, but does not need the record number.
+
+=head2 bib_format($record)
+
+Takes a record number. Returns the "format" used in determining the meanings of the fixed fields in 008. Will force update of the ldr based on any existing hash version.
+
+      foreach $record (1..$#$x) {
+	    next if $x->bib_format($record) eq 'SERIALS';
+		# serials are hard
+	    do_something($x->[record]);
+      }
+
+MARC::Rec::bib_format() is identical to bib_format, but does not need the record number.
+
+=head2 unpack_008($record)
+
+Returns a ref to hash version of the 008 field, based on the field's value.
+Installs the ref as $marc->[$record]{unp_008}
+
+      foreach $record (1..$#$x) {
+	    my $rff = $x->unpack_008($record);
+	    print "Record $record: Y2K problem possible"
+		if ($rff->{'Date1'}=~/00/ or $rff->{'Date2'}=~/00/);
+      }
+
+MARC::Rec::unpack_008() is identical to unpack_008, but does not need the record number.
+
+=head2 get_hash_008($record)
+
+Takes a record number. Returns a ref to the cached version of the hash 008 if it exists.
+Does this *without* overwriting the hash 008. Allows external code to safely manipulate
+hash versions of the 008.
+
+     my $rh008 = $marc->get_hash_008($record);
+     return undef unless $rh008;
+     $rh008->{'Date1'} =~ s/00/01/;
+     my $m008 = $x->pack_008($record);
+     return undef unless $m008;
+
+MARC::Rec::get_hash_008() is identical to get_hash_008, but does not need the record number.
+
+=head2 pack_008($record)
+
+Takes a record number and updates the appropriate 008. Will force update of the
+ldr based on any existing hash version.
+
+      foreach $record (1..$#$x) {
+	    my $rff = $x->unpack_008($record);
+	    $rff->{'Date1'}='2000';
+	    print "Record:$record Y2K problem created";
+	    $x->pack_008($record);
+	    # New value is in the 008 field of $record'th marc
+      }
+
+MARC::Rec::pack_008() is identical to pack_008, but does not need the record number.
+
+=head2 deletefirst()
+
+deletefirst() takes a template. It deletes the field data for a first
+match, using the template and leaves the rest alone. If the template
+has a subfield element it deletes based on the subfield information in
+the template. If the last subfield of a field is deleted,
+deletefirst() also deletes the field.  It complains about attempts to
+delete indicators.  If there is no match, it does nothing. Deletefirst
+also rebuilds the map if the template asks for that
+$do_rebuild_map. Deletefirst returns the number of matches deleted
+(that would be 0 or 1), or undef if it feels grumpy (i.e. carps).
+
+MARC::Rec::deletefirst($template) is identical to deletefirst, but ignores any record number
+specified by $template.
+
+Most use of deletefirst is expected to be by MARC::Tie.
+
+
+=head2 deletemarc()
+
+This method will allow you to remove a specific record, fields or subfields from a MARC object. Accepted parameters include: I<record>, I<field> and I<subfield>. Note: you can use the .. operator to delete a range of records. deletemarc() will return the number of items deleted (be they records, fields or subfields). The I<record> parameter is optional. It defaults to all user records [1..$#marc] if not specified.
+
+        #delete all the records in the object
+    $x->deletemarc();
+
+        #delete records 1-5 and 7 
+    $x->deletemarc({record=>[1..5,7]});
+
+        #delete all of the 650 fields from all of the records
+    $x->deletemarc({field=>'650'});
+
+        #delete the 110 field in record 2
+    $x->deletemarc({record=>'2',field=>'110'});
+
+        #delete all of the subfield h's in the 245 fields
+    $x->deletemarc({field=>'245',subfield=>'h'});
+
+=head2 updatefirst()
+
+updatefirst() takes a template, and an array from
+$marc->[recnum]{array}. It replaces/creates the field data for a first
+match, using the template and the array, and leaves the rest alone. If
+the template has a subfield element, (this includes indicators) it
+ignores all other information in the array and only updates/creates
+based on the subfield information in the array. If the template has no
+subfield information then indicators are left untouched unless a new
+field needs to be created, in which case they are left blank.
+
+MARC::Rec::updatefirst($template) is identical to deletefirst, but ignores any record number
+specified by $template.
+
+Most use of updatefirst() is expected to be from MARC::Tie.
+It does not currently provide a useful return value.
+
+=head2 updatefields()
+
+updatefields() takes a template which specifies recnum, a
+$do_rebuild_map and a field (needs the field in case $rafields->[0] is
+empty). It also takes a ref to an array of fieldrefs formatted like
+the output of getfields(), and replaces/creates the field data. It
+assumes that it should replace the fields with the first tag in the
+fieldrefs. It calls rebuild_map() if $do_rebuild_map.
+
+    #Let's kill the *last* 500 field.
+    my $loc500 = {record=>1,field=>500,rebuild_map=>1};
+    my @rfields = $x->getfields($loc500);
+    pop @rfields;
+    $x->updatefields($loc500,\@rfields);
+
+=head2 getmatch()
+
+getmatch() takes a subfield code (can be an indicator) and a fieldref.
+Returns 0 or a ref to the value to be updated.
+    
+    #Let's update the value of i2 for the *last* 500
+    my $loc500 = {record=>1,field=>500,rebuild_map=>1};
+    my @rfields = $x->getfields($loc500);
+    my $rvictim = pop @rfields;
+    my $rval = getmatch('i2',$rvictim);
+    $$rval = "4" if $rval;
+
+MARC::Rec::getmatch($subf,$rfield) is identical to getmatch;
+
+=head2 insertpos()
+
+insertpos() takes a subfield code (can not be an indicator), a value,
+and a fieldref. Updates the fieldref with the first place that the
+fieldref can match. Assumes there is no exact subfield match in
+$fieldref.
+
+    #Let's update the value of subfield 'a' for the *last* 500
+    my $value = "new info";
+    my $loc500 = {record=>1,field=>500,rebuild_map=>1};
+    my @rfields = $x->getfields($loc500);
+    my $rvictim = pop @rfields;
+    my $rval = getmatch('a',$rvictim);
+    if ($rval) {
+        $$rval = $value ;
+    } else {
+	$x->insertpos('a',$value,$rvictim);
+    }
+
+MARC::Rec::insertpos($subf,$value,$rfield) is identical to insertpos;
+
+=head2 selectmarc()
+
+This method will select specific records from a MARC object and delete the rest. You can specify both individual records and ranges of records in the same way as deletemarc(). selectmarc() will also return the number of records deleted. 
+
+    $x->selectmarc(['3']);
+    $y=$x->selectmarc(['4','21-50','60']);
+    print "$y records selected!";
+
+=head2 searchmarc()
+
+This method will allow you to search through a MARC object, and retrieve record numbers for records that matched your criteria. You can search for: 1) records that contain a particular field, or field and subfield ; 2) records that have fields or subfields that match a regular expression ; 3) and records that have fields or subfields that B<do not> match a regular expression. The record numbers are returned to you in an array which you can then use with deletemarc(), selectmarc() and output() if you want.
+
+=over 4
+
+=item *
+
+1) Field/Subfield Presence:
+
+    @records=$x->searchmarc({field=>"245"});
+    @records=$x->searchmarc({field=>"245",subfield=>"a"});
+
+=item *
+
+2) Field/Subfield Match:
+
+    @records=$x->searchmarc({field=>"245",
+			     regex=>"/huckleberry/i"});
+    @records=$x->searchmarc({field=>"260",subfield=>"c",
+			     regex=>"/19../"});
+
+=item *
+
+3) Field/Subfield NotMatch:
+
+    @records=$x->searchmarc({field=>"245",
+			     notregex=>"/huckleberry/i"});
+    @records=$x->searchmarc({field=>"260",
+			     subfield=>"c",notregex=>"/19../"});
+
+=back
+
+=head2 createrecord()
+
+You can use this method to initialize a new record. It only takes one optional parameter, I<leader> which sets the 24 characters in the record leader: see http://lcweb.loc.gov/marc/bibliographic/ecbdhome.html for more details on the leader. Note: you do not need to pass character positions 00-04 or 12-16 since these are calculated by MARC.pm if outputting to MARC you can assign 0 to each position. If no leader is passed a default USMARC leader will be created of "00000nam  2200000 a 4500". createrecord() will return the record number for the record that was created, which you will need to use later when adding fields with addfield(). Createrecord now makes the new record an instance of an appropriate MARC::Rec subclass. 
+
+    use MARC;
+    my $x = new MARC;
+    $record_number = $x->createrecord();
+    $record_number = $x->createrecord({leader=>
+			    	       "00000nmm  2200000 a 4500"});
+
+MARC::Rec::createrecord($leader) returns an instance of a suitable subclass of MARC::Rec.
+
+=head2 getupdate()
+
+The B<getupdate()> method returns an array that contains the contents of a fieldin a defined order that permits restoring the field after deleting it. This permits changing only individual subfields while keeping other data intact. If a field is repeated in the record, the resulting array separates the field infomation with an element containing "\036" - the internal field separator which can never occur in real MARC data parameters. A non-existing field returns C<undef>. An example will make the structure clearer. The next two MARC fields (shown in ASCII) will be described in the following array:
+
+		246  30  $aPhoto archive
+		246  3   $aAssociated Press photo archive
+
+    my $update246 = {field=>'246',record=>2,ordered=>'y'};
+	# next two statements are equivalent
+    my @u246 = $x->getupdate($update246);
+	# or
+    my @u246 = ('i1','3','i2','0',
+		'a','Photo archive',"\036",
+                'i1','3','i2',' ',
+		'a','Associated Press photo archive',"\036");
+	
+After making any desired modifications to the data, the existing field can be replaced using the following sequence (for non-repeating fields):
+
+    $x->deletemarc($update246));
+    my @records = ();
+    foreach my $y1 (@u246) {
+        last if ($y1 eq "\036");
+    	push @records, $y1;
+    }
+    $x->addfield($update246, @records);
+
+=head2 updaterecord()
+
+The updaterecord() method is a more complete version of the preceeding sequence with error checking and the ability to split the update array into multiple addfield() commands when given repeating fields. It takes an array of key/value pairs, formatted like the output of getupdate(), and replaces/creates the field data. For repeated tags, a "\036" element is used to delimit data into separate addfield() commands. It returns the number of successful addfield() commands or C<undef> on failure.
+
+    $repeats = $x->updaterecord($update246, @u246);	# same as above
+
+=head2 addfield()
+
+This method will allow you to addfields to a specified record. The syntax may look confusing at first, but once you understand it you will be able to add fields to records that you have read in, or to records that you have created with createrecord(). addfield() takes six parameters: I<record> which indicates the record number to add the field to, I<field> which indicates the field you wish to create (ie. 245), I<i1> which holds one character for the first indicator, I<i2> which holds one character for the second indicator, and I<value> which holds the subfield data that you wish to add to the field. addfield() will automatically try to insert your new field in tag order (ie. a 500 field before a 520 field), however you can turn this off if you set I<ordered> to "no" which will add the field to the end. Here are some examples:
+
+    $y = $x->createrecord(); # $y will store the record number created
+
+    $x->addfield({record=>"$y", field=>"100", i1=>"1", i2=>"0",
+		  value=> [a=>"Twain, Mark, ", d=>"1835-1910."]});
+
+    $x->addfield({record=>"$y", field=>"245",
+		  i1=>"1", i2=>"4", value=>
+                 [a=>"The adventures of Huckleberry Finn /",
+                  c=>"Mark Twain ; illustrated by E.W. Kemble."]});
+
+This example intitalized a new record, and added a 100 field and a 245 field. For some more creative uses of the addfield() function take a look at the I<EXAMPLES> section. The I<value> parameters, including I<i1> and I<i2>, can be specified using a separate array. This permits restoring field(s) from the array returned by the B<getupdate()> method - either as-is or with modifications. The I<i1> and I<i2> key/value pairs must be first and in that order if included.
+
+	# same as "100" example above
+    my @v100 = 'i1','1','i2',"0",'a',"Twain, Mark, ",
+	       'd',"1835-1910.";
+    $x->addfield({record=>"$y", field=>"100"}, @v100);
+
+=head2 add_005s()
+
+Add_005s takes a specification of records (defaults to everything) and 
+updates the indicated records with updated 005 fields (date of last transaction).
+
+=head2 output()
+
+Output is a multifunctional method for creating formatted output from a MARC object. There are three parameters I<file>, I<format>, I<records>. If I<file> is specified the output will be directed to that file. It is important to specify with E<gt> and E<gt>E<gt> whether you want to create or append the file! If no I<file> is specified then the results of the output will be returned to a variable (both variations are listed below). 
+
+The MARC standard includes a control field (005) that records the date of last automatic processing. This is implemented as a side-effect of output() to a file or if explicitly requested via a add_005s field of the template. The current time is stamped on the records indicated by the template.
+
+Valid I<format> values currently include usmarc, marcmaker, ascii, html, urls, and isbd. The optional I<records> parameter allows you to pass an array of record numbers which you wish to output. You must pass the array as a reference, hence the forward-slash in \@records below. If you do not include I<records> the output will default to all the records in the object. 
+
+The I<lineterm> parameter can be used to override the line-ending default
+for any of the formats. I<MARCMaker> defaults to CRLF (the format was
+originally released for MS-DOS). The others use '\n' as the default.
+
+With the I<MARCMaker> format, a I<charset> parameter accepts a hash-reference
+to a user supplied character translation table. The "ustext.txt" table supplied
+with the LoC. MARCBreaker utility is used internally as the default. You can
+use the B<ustext_default> method to get a hash-reference to it if you only
+want to modify a couple of characters. See example below.
+
+The I<MARCMaker> Specification requires that long lines be split to less
+than 80 columns. While that behavior is the default, the I<nolinebreak>
+parameter can override it and the resulting output will be much like the
+I<ascii> format.
+
+MARC::Rec::output($template) is the same as output except that ignores
+record number(s) and only outputs its caller. (E.g., with $format
+eq 'urls' it does not output html header and footer information.)
+
+=over 4
+
+=item *
+
+MARC
+
+    $x->output({file=>">mymarc.dat",'format'=>"usmarc"});
+    $x->output({file=>">mymarc.dat",'format'=>"usmarc",
+		records=>\@records});
+    $y=$x->output({'format'=>"usmarc"}); #put the output into $y
+
+=item *
+
+MARCMaker
+
+    $x->output({file=>">mymarcmaker.mkr",'format'=>"marcmaker"});
+    $x->output({file=>">mymarcmaker.mkr",'format'=>"marcmaker",
+		records=>\@records});
+    $y=$x->output({'format'=>"marcmaker"}); #put the output into $y
+
+    $x->output({file=>"brkrtest.mkr",'format'=>"marcmaker",
+		nolinebreak=>"1", lineterm=>"\n",
+		charset=>\%char_hash});
+
+
+=item *
+
+ASCII
+
+    $x->output({file=>">myascii.txt",'format'=>"ascii"});
+    $x->output({file=>">myascii.txt",'format'=>"ascii",
+		records=>\@records});
+    $y=$x->output({'format'=>"ascii"}); #put the output into $y
+
+=item *
+
+HTML
+
+The HTML output method has some additional parameters. I<fields> which if set to "all" will output all of the fields. Or you can pass the tag number and a label that you want to use for that tag. This will result in HTML output that only contains the specified tags, and will use the label in place of the MARC code.
+
+    $x->output({file=>">myhtml.html",'format'=>"html",
+		fields=>"all"});
+
+        #this will only output the 100 and 245 fields, with the 
+	#labels "Title: " and "Author: "
+    $x->output({file=>">myhtml.html",'format'=>"html",
+                245=>"Title: ",100=>"Author: "});    
+
+    $y=$x->output({'format'=>"html"});
+
+If you want to build the HTML file in stages, there are four other I<format> values available to you: 1) "html_header", 2) "html_start", 3) "html_body", and 4) "html_footer". Be careful to use the >> append when adding to a file though!
+
+    $x->output({file=>">myhtml.html",
+		'format'=>"html_header"}); # Content-type
+    $x->output({file=>">>myhtml.html",
+		'format'=>"html_start"});  # <BODY>
+    $x->output({file=>">>myhtml.html",
+		'format'=>"html_body",fields=>"all"});
+    $x->output({file=>">>myhtml.html",
+		'format'=>"html_footer"});
+
+=item *
+
+URLS
+
+    $x->output({file=>"urls.html",'format'=>"urls"});
+    $y=$x->output({'format'=>"urls"});
+
+=item *
+
+ISBD
+
+An experimental output format that attempts to mimic the ISBD.
+
+    $x->output({file=>"isbd.txt",'format'=>"isbd"});
+    $y=$x->output({'format'=>"isbd"});
+
+=item *
+
+XML
+
+Roundtrip conversion between MARC and XML is handled by the subclass 
+MARC::XML. MARC::XML is available for download from the CPAN.
+
+
+=back
+
+=head2 usmarc_default()
+
+This method returns a hash reference to a translation table between mnemonics
+delimited by curly braces and single-byte character codes in the MARC record.
+Multi-byte characters are not currently supported. The hash has keys of the
+form '{esc}' and values of the form chr(0x1b). It is used during MARCMaker
+input.
+
+    my %inc = %{$x->usmarc_default()};
+    printf "dollar = %s\n", $inc{'dollar'};	# prints '$'
+    $inc{'yen'} = 'Y';
+    $x->openmarc({file=>"makrbrkr.mrc",'format'=>"marcmaker",
+		  charset=>\%inc});
+
+MARC::Rec::usmarc_default is identical to usmarc_default;
+
+=head2 ustext_default()
+
+This method returns a hash reference to a translation table between single-byte
+character codes and mnemonics delimited by curly braces. Multi-byte characters
+are not currently supported. The hash has keys of the form chr(0x1b) and
+values of the form '{esc}'. It is used during MARCMaker output.
+
+    my %outc = %{$x->ustext_default()};
+    printf "dollar = %s\n", $outc{'$'};	# prints '{dollar}'
+    $outc{'$'} = '{uscash}';
+    printf "dollar = %s\n", $outc{'$'};	# prints '{uscash}'
+    $y = $x->output({'format'=>"marcmaker", charset=>\%outc});
+
+MARC::Rec::ustext_default is identical to ustext_default;
+
+=head2 as_string()
+
+As_string() takes no paramaters and returns a (Unix) newline separated version of the record.
+
+  Format is: $tag<SPACE>$i1$i2<SPACE>$subfields
+  where $subfields are separated by "\c_" binary subfield indicators.
+  Tag 000 is ldr.
+
+Subclasses may need to override this format. If so, 
+they should override from_string.
+
+=head2 from_string()
+
+From_string() takes a string paramater and updates the calling record's {array} information.
+It assumes the string is formatted like the output of as_string(). 
+
+=head1 EXAMPLES
+
+Here are a few examples to fire your imagination.
+
+=over 4
+
+=item * 
+
+This example will read in the complete contents of a MARC file called "mymarc.dat" and then output it as a MARCMaker file called "mymkr.mkr".
+
+    #!/usr/bin/perl
+    use MARC;
+    $x = MARC->new("mymarc.dat","marcmaker");
+    $x->output({file=>"mymkr.mkr",'format'=>"marcmaker");
+
+=item *
+
+The MARC object occupies a fair number of working memory, and you may want to do conversions on very large files. In this case you will want to use the openmarc(), nextmarc(), deletemarc(), and closemarc() methods to read in portions of the MARC file, do something with the record(s), remove them from the object, and then read in the next record(s). This example will read in one record at a time from a MARC file called "mymarc.dat" and convert it to a MARC Maker file called "myfile.mkr".
+
+    #!/usr/bin/perl
+    use MARC;
+    $x = new MARC;
+    $x->openmarc({file=>"mymarc.dat",'format'=>"usmarc"});
+    while ($x->nextmarc(1)) {
+	$x->output({file=>">>myfile.mkr",'format'=>"marcmaker"});
+	$x->deletemarc(); #empty the object for reading in another
+    }        
+
+=item *
+
+Perhaps you have a tab delimited text file of data for online journals you have access to from Dow Jones Interactive, and you would like to create a batch of MARC records to load into your catalog. In this case you can use createrecord(), addfield() and output() to create records as you read in your delimited file. When you are done, you then output to a file in USMARC.
+
+    #!/usr/bin/perl
+    use MARC;
+    $x = new MARC;
+    open (INPUT_FILE, "delimited_file");
+    while ($line=<INPUT_FILE>) {
+        ($journaltitle,$issn) = split /\t/,$line;
+        $num=$x->createrecord();
+        $x->addfield({record=>$num, 
+                      field=>"022", 
+                      i1=>" ", i2=>" ", 
+                      value=>$issn});
+        $x->addfield({record=>$num, 
+                      field=>"245", 
+                      i1=>"0", i2=>" ", 
+                      value=>[a=>$journaltitle]});
+        $x->addfield({record=>$num, 
+                      field=>"260", 
+                      i1=>" ", i2=>" ", 
+                      value=>[a=>"New York (N.Y.) :",
+			      b=>"Dow Jones & Company"]});
+	$x->addfield({record=>$num,
+		      field=>"710",
+		      i1=>"2", i2=>" ",
+		      value=>[a=>"Dow Jones Interactive."]});
+	$x->addfield({record=>$num,
+		      field=>"856",
+		      i1=>"4", i2=>" ",
+		      value=>[u=>"http://www.djnr.com",
+			      z=>"Connect"]});
+    }
+    close INPUT_FILE;
+    $x->output({file=>">dowjones.mrc",'format'=>"usmarc"})
+
+=item * 
+
+Perhaps you have periodicals coming in that you want to order by 
+location and then title. MARC::Rec's get you out of some array indexing.
+
+#!/usr/bin//perl
+use MARC 1.03;
+
+my @newmarcs=@$marc[1..$#$marc]; # array slice.
+my @sortmarcs = sort by_loc_oclc @newmarcs;
+ at marc[1..$#$marc] = @sortmarcs;
+
+sub by_loc_title {
+    my ($aloc,$atitle) = loc_title($a);
+    my ($bloc,$btitle) = loc_title($b);
+    return  $aloc cmp $bloc 
+	          ||
+	  $atitle cmp $btitle;
+}
+
+sub loc_title {
+    my ($rec)=@_;
+    my $n049 = $rec->getfirstvalue({field=>040});
+    my ($loc) = $n049=~/(ND\S+)/; # Or the first two letters of your OCLC
+                                  # location.
+
+    my $title = $rec->getfirstvalue({field=>100,delimiter=>" "});
+
+    return ($loc,$title);
+}
+
+=back
+
+=head1 NOTES
+
+Please let us know if you run into any difficulties using MARC.pm--we'd be
+happy to try to help. Also, please contact us if you notice any bugs, or
+if you would like to suggest an improvement/enhancement. Email addresses 
+are listed at the bottom of this page.
+
+Development of MARC.pm and other library oriented Perl utilities is conducted
+on the Perl4Lib listserv. Perl4Lib is an open list and is an ideal place to
+ask questions about MARC.pm. Subscription information is available at
+http://www.vims.edu/perl4lib
+
+Two global boolean variables are reserved for test and debugging. Both are
+"0" (off) by default. The C<$TEST> variable disables internal error messages
+generated using I<Carp>. It also overrides the date_stamp in the "005" field
+with a constant "19960221075055.7". It should only be used in the automatic
+test suite. The C<$DEBUG> variable adds verbose diagnostic messages. Since
+both variables are used only in testing, I<MARC::Rec> uses C<$MARC::TEST>
+and C<$MARC::DEBUG> rather than define a second pair.
+
+=head1 AUTHORS
+
+Chuck Bearden cbearden at rice.edu
+
+Bill Birthisel wcbirthisel at alum.mit.edu
+
+Derek Lane dereklane at pobox.com
+
+Charles McFadden chuck at vims.edu
+
+Ed Summers ed at cheetahmail.com
+
+=head1 SEE ALSO
+
+perl(1), http://lcweb.loc.gov/marc
+
+=head1 COPYRIGHT
+
+Copyright (C) 1999,2000, Bearden, Birthisel, Lane, McFadden, and Summers.
+All rights reserved. This module is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself. 23 April 2000.
+Portions Copyright (C) 1999,2000, Duke University, Lane.
+
+=cut

Added: packages/libmarc-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libmarc-perl/branches/upstream/current/Makefile.PL	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/Makefile.PL	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,166 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+require 5.004;
+
+unless ($^O =~ /Win/i) {
+    WriteMakefile(
+        'NAME'	=> 'MARC',
+        'VERSION_FROM' => 'MARC.pm', # finds $VERSION
+        'SKIP'	=> [qw(tool_autosplit)],
+        'clean'	=> {FILES => "*/output* output*"},
+    );
+    exit;
+}
+
+# On Windows, create substitute scripts for the "make deprived"
+
+use File::Copy;
+use File::Path;
+use Pod::Html;
+use File::Find;
+
+    # clean up test and example result files
+find(\&wanted, ".");
+
+sub wanted {
+    return unless (/^output/);
+    unlink ($_);
+}
+
+my $version = simple_version("MARC.pm");
+my $INST_LIBDIR = "./lib";
+my $INST_HTMLDIR = "./html";
+my $INST_FILES = "MARC.pm";
+my $INST_NAME = "MARC";
+my @HTML_FILES = "MARC";
+
+print <<INTRO3;
+                           MARC version $version
+
+                      No 'Makefile' will be created
+                      Test with:    perl test.pl
+                      Install with: perl install.pl
+
+INTRO3
+
+my $dfile = "test.pl";
+unlink $dfile;
+print "Creating new $dfile\n";
+open (DEFAULT, "> $dfile") or die "Can't create $dfile: $!\n";
+
+print DEFAULT <<"TEST4";	# double quotes - need interpolation
+# Created by Makefile.PL
+# $INST_NAME Version $version
+TEST4
+
+print DEFAULT <<'TEST4';	# single quotes - minimize chaacter quoting
+use Test::Harness;
+runtests ("t/test1.t","t/test2.t","t/test3.t","t/test4.t","t/test5.t");
+
+print "\nTo run individual tests, type:\n";
+print "    C:\\> perl t/test?.t Page_Pause_Time (0..5)\n";
+print "See README and other documentation for additional information.\n\n";
+TEST4
+
+close DEFAULT;
+
+unless (-d $INST_LIBDIR) {
+    File::Path::mkpath([ "$INST_LIBDIR" ],1,0777) or
+        die "ERROR creating directories: ($!)\n";
+}
+unless (-d $INST_HTMLDIR) {
+    File::Path::mkpath([ "$INST_HTMLDIR" ],1,0777) or
+        die "ERROR creating directories: ($!)\n";
+}
+File::Copy::copy($INST_FILES,$INST_LIBDIR) or
+    die "ERROR copying files: ($!)\n";
+
+foreach $source (@HTML_FILES) {
+    pod2html(
+	     "--norecurse",
+	     "--infile=$source.pm",
+	     "--outfile=$INST_HTMLDIR/$source.html"
+	    );
+}
+
+$dfile = "install.pl";
+unlink $dfile, "pod2html-itemcache","pod2html-dircache";
+print "Creating new $dfile\n";
+open (DEFAULT, "> $dfile") or die "Can't create $dfile: $!\n";
+
+print DEFAULT <<"INST5";
+# Created by Makefile.PL
+# $INST_NAME Version $version
+INST5
+
+my $template = <<'INST5';
+
+use Config qw(%Config);
+use strict;
+use ExtUtils::Install qw( install );
+
+my $FULLEXT = "%s";	# $INST_NAME
+my $INST_LIB = "./lib";
+my $HTML_LIB = "./html";
+
+my $html_dest = "";	# edit real html base here if autodetect fails
+
+if (exists $Config{installhtmldir} ) {
+    $html_dest = "$Config{installhtmldir}";
+}
+elsif (exists $Config{installprivlib} ) {
+    $html_dest = "$Config{installprivlib}";
+    $html_dest =~ s%\\lib%\\html%;
+}
+
+if ( length ($html_dest) ) {
+    $html_dest .= '\lib\site';
+}
+else {
+    die "Can't find html base directory. Edit install.pl manually.\n";
+}
+
+install({
+	   read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
+	   write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
+	   $INST_LIB => "$Config{installsitelib}",
+	   $HTML_LIB => "$html_dest"
+	  },1,0);
+
+__END__
+INST5
+
+printf DEFAULT $template, $INST_NAME;
+close DEFAULT;
+
+    # a low-fat version of parse_version from ExtUtils::MM_Unix.
+sub simple_version {
+    my $parsefile = shift;
+    my $result;
+    open(FH,$parsefile) or die "Could not open '$parsefile': $!";
+    my $inpod = 0;
+    while (<FH>) {
+	$inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
+	next if $inpod;
+	chop;
+	next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
+	my $eval = qq{
+	    package ExtUtils::MakeMaker::_version;
+	    no strict;
+
+	    local $1$2;
+	    \$$2=undef; do {
+		$_
+	    }; \$$2
+	};
+	local($^W) = 0;
+	$result = eval($eval);
+	die "Could not eval '$eval' in $parsefile: $@" if $@;
+	$result = "undef" unless defined $result;
+	last;
+    }
+    close FH;
+    return $result;
+}

Added: packages/libmarc-perl/branches/upstream/current/README
===================================================================
--- packages/libmarc-perl/branches/upstream/current/README	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/README	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,164 @@
+MARC (manipulate MAchine Readable Cataloging)
+VERSION=1.07, 23 April 2000
+
+This is a cross-platform module. All of the files except README.txt
+are LF-only terminations. You will need a better editor than Notepad
+to read them on Win32. README.txt is README with CRLF.
+
+DESCRIPTION:
+
+MARC.pm is a Perl 5 module for reading in, manipulating, and outputting
+bibliographic records in the USMARC format. You will need to have Perl
+5.004 or greater for MARC.pm to work properly. Since it is a Perl module
+you use MARC.pm from one of your own Perl scripts. It handles conversions
+from MARC into ASCII (text),  Library of Congress MARCMaker, HTML,
+and ISBD. Input from MARCMaker format is also supported. Individual
+records, fields, indicators, and subfields can be created, modified, and
+deleted. It can extract URLs from the 856 field into HTML.
+
+The MARC::XML module adds conversions to and from XML.
+
+The MARC::Tie module adds another way to access this data.
+
+MARC.pm can handle both single and batches of MARC records. The limit on
+the number of records in a batch is determined by the memory capacity of
+the machine you are running. If memory is an issue for you MARC.pm will
+allow you to read in records from a batch gradually. MARC.pm also includes
+a variety of tools for searching, removing, and even creating records from
+scratch.
+
+FILES:
+
+    Changes		- for history lovers
+    Makefile.PL		- the "starting point" for traditional reasons
+    MANIFEST		- file list
+    README		- this file for CPAN
+    README.txt		- this file for DOS
+    MARC.pm		- the reason you're reading this
+
+    t			- test directory
+    t/marc.dat		- two record data file for testing
+    t/marc4.dat		- slightly different version of t/marc.dat
+    t/badmarc.dat	- corrupt data file for testing
+    t/test1.t		- basic tests, search, update
+    t/test2.t		- MARCMaker format tests
+    t/test3.t		- Inheritance version of test1.t
+    t/test4.t		- tests for the *map* methods
+    t/test5.t		- updatefirst/deletefirst tests
+    t/MARCopt.pm	- Inheritance stub module
+    t/makrbrkr.mrc	- LoC. MARCMaker reference records
+    t/makrtest.src	- MARCMaker source for makrbrkr.mrc
+    t/brkrtest.ref	- MARCBreaker output from makrbrkr.mrc
+    t/makrtest.bad	- corrupt MARCMaker source file for testing
+
+    eg			- test directory
+    eg/microlif.001	- eighteen record data file for demo
+    eg/addlocal.pl	- simple modify/write demo with comments
+    eg/specials.001	- complex data file for fixlocal demo
+    eg/fixlocal.pl	- multi-field search and replace demo with comments
+			  and option templates
+    eg/uclocal.pl	- complex modify/write demo with extensive use of
+			  templates and tutorial comments
+
+INSTALL and TEST:
+
+On linux and Unix, this distribution uses Makefile.PL and the "standard"
+install sequence for CPAN modules:
+	perl Makefile.PL
+	make
+	make test
+	make install
+
+On Win32, Makefile.PL creates equivalent scripts for the "make-deprived"
+and follows a similar sequence.
+	perl Makefile.PL
+	perl test.pl
+	perl install.pl
+
+Both sequences create install files and directories. The test uses a
+small sample input file and creates outputs in various formats. You can
+specify an optional PAUSE (0..5 seconds) between pages of output. The
+'perl t/test1.pl PAUSE' form works on all OS types. The test will
+indicate if any unexpected errors occur (not ok).
+
+Once you have installed, you can check if Perl can find it. Change to
+some other directory and execute from the command line:
+
+            perl -e "use MARC"
+
+No response that means everything is OK! If you get an error like
+* Can't locate method "use" via package MARC *, then Perl is not
+able to find MARC.pm--double check that the file copied it into the
+right place during the install.
+
+EXPERIMENTAL ELEMENTS:
+
+A number of functions were added in Version 0.92 by Derek Lane to
+support updating "000" and "008" fields. All of these are experimental
+and may be subject to changes or syntax refinements. Here are his
+comments:
+
+	(unpack_ldr): gets an updateable version of the LDR
+	
+	(_unpack_ldr): This and other _ - series functions work fine on a
+	record-by-record basis. In general all official methods in the
+	(un)?pack.* series call corresponding _(un)?pack.* methods. The
+	official interfaces have to specify the records.
+	
+	(_pack_ldr): Added in 0.95d
+	
+	(bib_format): returns, e.g. BOOK or SERIAL. Don't confuse this
+	with usmarc vs XML.
+	
+	(_bib_format): Suitable for record-by-record access.
+
+	(unpack_008): Returns updateable fixed field information.
+
+	(_unpack_008): Internal record-by-record equivalent.
+
+	(_pack_008): Added in 0.95d
+
+COMPATIBILITY:
+
+The length() method has been removed because it overrides a Perl builtin.
+Use the new marc_count() method instead.
+
+Version 0.93 adds character_set conversions to MarcMaker format reads and
+writes. The usmarc/ustext character maps are used by default, so existing
+files in that format will produce different results than earlier versions.
+
+Starting with version 1.00, the XML conversions are moved to MARC::XML.
+
+Version 1.05 no longer assumes fields with same tag are contiguous. This
+is required for CJK characters and may introduce other changes from earlier
+conversions. The addition of proper date stamp generation in the "005" field
+may now create different output from the same source data.
+
+NOTES:
+
+Please let us know if you run into any difficulties using MARC.pm--
+e'd be happy to try to help. Also, please contact us if you notice any
+bugs, or if you would like to suggest an improvement/enhancement. Email
+addresses are listed at the bottom of this page.
+
+The module is provided in standard CPAN distribution format. Additional
+documentation is created during the installation (html and man formats).
+
+Download the latest version from CPAN or:
+
+    http://marcpm.sourceforge.net
+
+AUTHORS:
+
+    Chuck Bearden cbearden at rice.edu
+    Bill Birthisel wcbirthisel at alum.mit.edu
+    Charles McFadden chuck at vims.edu
+    Ed Summers esummers at odu.edu
+    Derek Lane dereklane at pobox.com
+
+COPYRIGHT
+
+Copyright (C) 1999, 2000 Bearden, Birthisel, Lane, McFadden, and Summers.
+All rights reserved. This module is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+Portions Copyright (C) 1999, 2000 Duke University, Lane.

Added: packages/libmarc-perl/branches/upstream/current/README.txt
===================================================================
--- packages/libmarc-perl/branches/upstream/current/README.txt	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/README.txt	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,164 @@
+MARC (manipulate MAchine Readable Cataloging)
+VERSION=1.07, 23 April 2000
+
+This is a cross-platform module. All of the files except README.txt
+are LF-only terminations. You will need a better editor than Notepad
+to read them on Win32. README.txt is README with CRLF.
+
+DESCRIPTION:
+
+MARC.pm is a Perl 5 module for reading in, manipulating, and outputting
+bibliographic records in the USMARC format. You will need to have Perl
+5.004 or greater for MARC.pm to work properly. Since it is a Perl module
+you use MARC.pm from one of your own Perl scripts. It handles conversions
+from MARC into ASCII (text),  Library of Congress MARCMaker, HTML,
+and ISBD. Input from MARCMaker format is also supported. Individual
+records, fields, indicators, and subfields can be created, modified, and
+deleted. It can extract URLs from the 856 field into HTML.
+
+The MARC::XML module adds conversions to and from XML.
+
+The MARC::Tie module adds another way to access this data.
+
+MARC.pm can handle both single and batches of MARC records. The limit on
+the number of records in a batch is determined by the memory capacity of
+the machine you are running. If memory is an issue for you MARC.pm will
+allow you to read in records from a batch gradually. MARC.pm also includes
+a variety of tools for searching, removing, and even creating records from
+scratch.
+
+FILES:
+
+    Changes		- for history lovers
+    Makefile.PL		- the "starting point" for traditional reasons
+    MANIFEST		- file list
+    README		- this file for CPAN
+    README.txt		- this file for DOS
+    MARC.pm		- the reason you're reading this
+
+    t			- test directory
+    t/marc.dat		- two record data file for testing
+    t/marc4.dat		- slightly different version of t/marc.dat
+    t/badmarc.dat	- corrupt data file for testing
+    t/test1.t		- basic tests, search, update
+    t/test2.t		- MARCMaker format tests
+    t/test3.t		- Inheritance version of test1.t
+    t/test4.t		- tests for the *map* methods
+    t/test5.t		- updatefirst/deletefirst tests
+    t/MARCopt.pm	- Inheritance stub module
+    t/makrbrkr.mrc	- LoC. MARCMaker reference records
+    t/makrtest.src	- MARCMaker source for makrbrkr.mrc
+    t/brkrtest.ref	- MARCBreaker output from makrbrkr.mrc
+    t/makrtest.bad	- corrupt MARCMaker source file for testing
+
+    eg			- test directory
+    eg/microlif.001	- eighteen record data file for demo
+    eg/addlocal.pl	- simple modify/write demo with comments
+    eg/specials.001	- complex data file for fixlocal demo
+    eg/fixlocal.pl	- multi-field search and replace demo with comments
+			  and option templates
+    eg/uclocal.pl	- complex modify/write demo with extensive use of
+			  templates and tutorial comments
+
+INSTALL and TEST:
+
+On linux and Unix, this distribution uses Makefile.PL and the "standard"
+install sequence for CPAN modules:
+	perl Makefile.PL
+	make
+	make test
+	make install
+
+On Win32, Makefile.PL creates equivalent scripts for the "make-deprived"
+and follows a similar sequence.
+	perl Makefile.PL
+	perl test.pl
+	perl install.pl
+
+Both sequences create install files and directories. The test uses a
+small sample input file and creates outputs in various formats. You can
+specify an optional PAUSE (0..5 seconds) between pages of output. The
+'perl t/test1.pl PAUSE' form works on all OS types. The test will
+indicate if any unexpected errors occur (not ok).
+
+Once you have installed, you can check if Perl can find it. Change to
+some other directory and execute from the command line:
+
+            perl -e "use MARC"
+
+No response that means everything is OK! If you get an error like
+* Can't locate method "use" via package MARC *, then Perl is not
+able to find MARC.pm--double check that the file copied it into the
+right place during the install.
+
+EXPERIMENTAL ELEMENTS:
+
+A number of functions were added in Version 0.92 by Derek Lane to
+support updating "000" and "008" fields. All of these are experimental
+and may be subject to changes or syntax refinements. Here are his
+comments:
+
+	(unpack_ldr): gets an updateable version of the LDR
+	
+	(_unpack_ldr): This and other _ - series functions work fine on a
+	record-by-record basis. In general all official methods in the
+	(un)?pack.* series call corresponding _(un)?pack.* methods. The
+	official interfaces have to specify the records.
+	
+	(_pack_ldr): Added in 0.95d
+	
+	(bib_format): returns, e.g. BOOK or SERIAL. Don't confuse this
+	with usmarc vs XML.
+	
+	(_bib_format): Suitable for record-by-record access.
+
+	(unpack_008): Returns updateable fixed field information.
+
+	(_unpack_008): Internal record-by-record equivalent.
+
+	(_pack_008): Added in 0.95d
+
+COMPATIBILITY:
+
+The length() method has been removed because it overrides a Perl builtin.
+Use the new marc_count() method instead.
+
+Version 0.93 adds character_set conversions to MarcMaker format reads and
+writes. The usmarc/ustext character maps are used by default, so existing
+files in that format will produce different results than earlier versions.
+
+Starting with version 1.00, the XML conversions are moved to MARC::XML.
+
+Version 1.05 no longer assumes fields with same tag are contiguous. This
+is required for CJK characters and may introduce other changes from earlier
+conversions. The addition of proper date stamp generation in the "005" field
+may now create different output from the same source data.
+
+NOTES:
+
+Please let us know if you run into any difficulties using MARC.pm--
+e'd be happy to try to help. Also, please contact us if you notice any
+bugs, or if you would like to suggest an improvement/enhancement. Email
+addresses are listed at the bottom of this page.
+
+The module is provided in standard CPAN distribution format. Additional
+documentation is created during the installation (html and man formats).
+
+Download the latest version from CPAN or:
+
+    http://marcpm.sourceforge.net
+
+AUTHORS:
+
+    Chuck Bearden cbearden at rice.edu
+    Bill Birthisel wcbirthisel at alum.mit.edu
+    Charles McFadden chuck at vims.edu
+    Ed Summers esummers at odu.edu
+    Derek Lane dereklane at pobox.com
+
+COPYRIGHT
+
+Copyright (C) 1999, 2000 Bearden, Birthisel, Lane, McFadden, and Summers.
+All rights reserved. This module is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+Portions Copyright (C) 1999, 2000 Duke University, Lane.

Added: packages/libmarc-perl/branches/upstream/current/eg/addlocal.pl
===================================================================
--- packages/libmarc-perl/branches/upstream/current/eg/addlocal.pl	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/eg/addlocal.pl	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,102 @@
+#!/usr/bin/perl
+
+# The following example automates a simple but time-consuming task for
+# a librarian. Booksellers commonly include a disk containing standard
+# bibliographical and catalogging data with their shipments to libraries.
+# The data is in MAchine Readable Catalog (MARC) format. The MARC.pm
+# module creates, reads, updates, and writes that data. Most library
+# databases also import from and export into MARC format. But a library
+# often must add to the data provided by the booksellers. We are going to
+# add the Wisconsin inter-library loan code for the Clinton Public Library
+# and the local call number to each MARC record (each catalog item).
+
+# A record consists of a number of tags (data types) and each tag can have
+# one or more subfields (data elements). Tags are designated by 3-digit
+# identifiers (000-999) corresponding to specific data types (i.e. the 245
+# tag is the Title Statement). In this example, we care about the 852 tag
+# (Location) subfield 'h' (Dewey or similar Recommended Call Number) and
+# the 900 and 999 tags (reserved for "local" use). We plan to append a 999
+# field to each record based in part on the 852 tag subfield 'h'. We will
+# also print a text listing of any records missing this subfield so the
+# librarian can update those manually. Finally, we will insert the call
+# number as a 900 tag.
+
+    use MARC 0.93;
+    my $infile = "microlif.001";
+    my $outfile = "output.002";
+    my $outfile2 = "output2.txt";
+    my $outtext = "output.txt";
+    unlink $outfile, $outtext, $outfile2;
+
+# Your filenames will vary. You probably want absolute pathnames.
+# In Clinton, WI, we have a shortcut to the newbooks.d directory and
+# use these:
+#   my $infile = "a:\\microlif.001";			# floppy from vendor
+#   my $outfile = "d:\\microlif.002";			# file to import 
+#   my $outfile2 = "d:\\newbooks.d\\updated.txt";	# ascii to check
+#   my $outtext = "d:\\newbooks.d\\missing.txt";	# needs attention
+
+    my $count = 0;
+    my $missing = 0;    
+    $x = MARC->new;
+    $x->openmarc({file=>$infile,'format'=>"usmarc"}) || die;
+
+# You may want a more informative failure routine if run from a GUI
+
+# We process records one at a time for this operation. Multiple 852 fields
+# are legal (for multiple copies) - the 'h' subfield should be the same.
+# But a few percent of incoming materials do not include this subfield.
+
+    while ($x->nextmarc(1)) {
+        my ($callno) = $x->getvalue({record=>'1',field=>'852',subfield=>'h'});
+	$callno = "|" unless (defined $callno);
+
+# A single 'fill character' ("|" eq 0x7c) is used for none.
+# Some vendors don't like "empty" subfields
+
+        $x->addfield({record=>1, 
+                      field=>"999", 
+                      ordered=>"n", 
+                      i1=>" ", i2=>" ", 
+                      value=>[c=>"wL70",d=>"AR Clinton PL",f=>"$callno"]});
+
+# Tag 999 subfield 'f' gets the Call Number. The others are constant in this
+# example. Tag 999 is the last legal choice, so a simple append is fine.
+
+        $x->addfield({record=>1, 
+                      field=>"900", 
+                      ordered=>"y", 
+                      i1=>" ", i2=>" ", 
+                      value=>[a=>"$callno"]});
+
+# Tag 900 subfield 'a' gets the Call Number. Since some records already
+# have 9xx tags (e.g. 935), we want 'ordered' (which is also the default).
+
+        $x->output({file=>">>$outfile",'format'=>"usmarc"});
+	if ($callno eq "|") {
+            $x->output({file=>">>$outtext",'format'=>"ascii",
+		lineterm=>"\r\n"});
+	    $missing++;
+	}
+        $x->output({file=>">>$outfile2",'format'=>"ascii",
+		lineterm=>"\r\n"});
+        $x->deletemarc(); #empty the object for reading in another
+	$count++;
+    }
+
+# We write all the records to the output file in MARC format. Even the
+# incomplete ones at least have added the fixed data. The ascii output
+# in $outtext gives the librarian both a list of records requiring manual
+# attention and all the Title, Author, Publication and related data needed
+# to assign location based on standard references. This demo also writes
+# an ascii version of its output as $outfile2 so the final MARC records
+# can be viewed with the changes. Since Clinton runs on NT, we specify
+# a Notepad-compatible line termination.
+
+    print "\nprocessed $count records\n";
+    print "$missing had missing call numbers\n\n";
+    print "press <Enter> to continue\n";
+    my $junk = <>;
+
+# Allow results to be seen even when run from a GUI.
+

Added: packages/libmarc-perl/branches/upstream/current/eg/fixlocal.pl
===================================================================
--- packages/libmarc-perl/branches/upstream/current/eg/fixlocal.pl	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/eg/fixlocal.pl	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,137 @@
+#!/usr/bin/perl
+
+  # The following example is an expanded version of "addlocal.pl" that
+  # checks and fixes existing records in addition to processing new ones.
+  # It first looks for a call number subfield 'h' of the 852 field (#852.h).
+  # If missing, it then checks #900.a and #999.f for the data. It puts the
+  # call number found into all of these locations including any repeated
+  # fields. It will create the locations if necessary.
+
+use MARC 0.95;
+my $infile = "specials.001";
+my $outfile = "output.003";
+my $outtext = "output3.txt";
+my $outtext2 = "output4.txt";
+unlink $outfile, $outtext, $outtext2;
+
+sub fix_update {
+    my $subfield = shift;
+    my $value = shift;
+    my @f = ();
+    my $ff;
+    my $altered = 0;
+    my $fixed = 0;
+    while (@_) {
+	last unless defined ($ff = shift);
+	if ($ff eq "\036") {
+	    unless ($fixed) {
+	        push @f, $subfield, $value;
+	        $altered++;
+	    }
+	    push @f, $ff;
+    	    $fixed = 0;
+	    next;
+	}
+	push @f, $ff;
+	unless ($subfield eq $ff) {
+	    push @f, shift;
+	    next;
+	}
+	last unless defined ($ff = shift);
+	push @f, $value;
+	$fixed++;
+	if ($value ne $ff) { $altered++; }
+    }
+    return ($altered, at f);
+}
+
+my $loc852 = {record=>1, field=>'852', ordered=>'y'};
+my $loc900 = {record=>1, field=>'900', ordered=>'y'}; 
+my $loc999 = {record=>1, field=>'999', ordered=>'n'}; 
+
+$x = MARC->new;
+$x->openmarc({file=>$infile,'format'=>"usmarc"}) || die;
+
+  # We process records one at a time for this operation. Multiple 852 fields
+  # are legal (for multiple copies) - the 'h' subfield should be the same.
+  # But a few percent of incoming materials do not include this subfield.
+
+while ($x->nextmarc(1)) {
+    my $from999 = "";
+    my $from900 = "";
+    my ($callno) = $x->getvalue($loc852,'subfield','h');
+    my $from852 = (1 == scalar $x->getvalue($loc852)) ? $callno : "";
+    unless ($callno) {
+	    # "" and '0' are not legal call numbers
+        $callno = "";
+        ($from900) = $x->getvalue($loc900,'subfield','a');
+	if ($from900) {
+	    $callno = $from900;
+	}
+	else {
+            ($from999) = $x->getvalue($loc999,'subfield','f');
+	    if ($from999) {
+	        $callno = $from999;
+	    }
+	}
+    }
+    my $change = 0;
+
+    my ($found) = $x->searchmarc($loc999);
+    if (defined $found) {
+        my @m999 = $x->getupdate($loc999);
+	my @f999 = fix_update('f', $callno, @m999);
+	if (shift @f999) {
+	    $change++;
+	    $x->updaterecord ($loc999, @f999) || warn "999 update failed\n";
+	}
+    }
+    else {
+        $x->addfield($loc999,'i1',' ','i2',' ', 
+                     'c','wL70','d','AR Clinton PL','f',"$callno");
+	$change++;
+    }
+
+    ($found) = $x->searchmarc($loc900);
+    if (defined $found) {
+        my @m900 = $x->getupdate($loc900);
+	my @f900 = fix_update('a', $callno, @m900);
+	if (shift @f900) {
+	    $change++;
+	    $x->updaterecord ($loc900, @f900) || warn "900 update failed\n";
+	}
+    }
+    else {
+        $x->addfield($loc900,'i1',' ','i2',' ','a',"$callno");
+	$change++;
+    }
+
+    if ($callno && not $from852) {
+        ($found) = $x->searchmarc($loc852);
+        if (defined $found) {
+            my @m852 = $x->getupdate($loc852);
+	    my @f852 = fix_update('h', $callno, @m852);
+	    if (shift @f852) {
+	        $change++;
+	        $x->updaterecord ($loc852, @f852) || warn "852 update failed\n";
+	    }
+        }
+        else {
+            $x->addfield($loc852,'i1','1','i2',' ','h',"$callno");
+	    $change++;
+        }
+    }
+
+    $x->output({file=>">>$outfile",'format'=>"usmarc"});
+    $x->output({file=>">>$outtext",'format'=>"ascii"}) unless $callno;
+    $x->output({file=>">>$outtext2",'format'=>"ascii"}) if $change;
+    $x->deletemarc(); #empty the object for reading in another
+}
+
+  # We write all the records to the output file in MARC format. Even the
+  # incomplete ones at least have added the fixed data. The ascii output
+  # in $outtext gives the librarian both a list of records requiring manual
+  # call number assignment and all the Title, Author, Publication and
+  # related data needed to assign location based on standard references.
+  # For checking, we write all the modified records to $outtext2.
+

Added: packages/libmarc-perl/branches/upstream/current/eg/microlif.001
===================================================================
--- packages/libmarc-perl/branches/upstream/current/eg/microlif.001	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/eg/microlif.001	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1 @@
+00561nam  2200205 a 4500001001300000005001700013008004100030020003100071040001900102050002600121069001300147082001600160090001200176100001900188245003400207260003600241300002100277852003800298935001900336bl 98007343 19980718022935.2980710s1998    nyu           000 1 eng d  a051512317X (pbk.) :c$7.50  aNjSoBTcNjSoBT14aPS3568.O243bR57 1998  a0610107304a813/.54221  aFIC ROB1 aRoberts, Nora.10aRising tides /bNora Roberts.  aNew York :bJove Books,cc1998.  a339 p. ;c18 cm.1 hFIC ROBp3CPL000018270-9P7.50usd  aBILL BIRTHISEL00812pam  2200253 a 4500001001300000003000400013005001700017008004100034010001700075020003200092040001800124050002600142069001300168082001600181090001200197100003300209245005700242260005300299300003500352490004300387800007000430852003900500935001900539   97033862 DLC19980718022935.2980501s1998    mnuab         000 1 eng    a   97033862   a0764220438 (pbk.) :c$10.99  aDLCcDLCdDLC00aPS3566.H492bW55 1998  a0610107300a813/.54221  aFIC PHI1 aPhillips, Michael R.,d1946-10aWild grows the heather in Devon /cMichael Phillips.  aMinneapolis :bBethany House Publishers,cc1998.  a447 p. :bill., maps ;c21 cm.1 aThe secrets of Heathersleigh Hall ;v11 aPhillips, Michael R.,d1946-tSecrets of Heathersleigh Hall ;v1.1 hFIC PHIp3CPL000018271.9P10.99usd  aBILL BIRTHISEL00723nam  2200229 a 4500001001300000005001700013008004100030020003100071040001900102050002700121069001300148082001600161090001200177100002100189245009100210250002000301260004400321300002900365500004200394852003800436935001900474bl 99793844 19980718022935.3971028r19971996nyua          000 1 eng d  a0553572377 (pbk.) :c$6.50  aNjSoBTcNjSoBT14aPS3552.R698bM89 1997b  a0610107304a813/.54221  aFIC BRO1 aBrown, Rita Mae.10aMurder, she meowed /cRita Mae Brown & Sneaky Pie Brown ; illustrations by Wendy Wray.  aBantam pbk. ed.  aNew York :bBantam Books,c1997, c1996.  a300 p. :bill. ;c18 cm.  aReprint. Originally published: c1996.1 hFIC BROp3CPL000018272 9P6.50usd  aBILL BIRTHISEL00937cam  2200289 a 4500001001300000003000400013005001700017008004100034010001700075020002500092040001800117043001200135050002500147069001300172082001600185090001200201100002900213245008400242260003400326300002600360650005100386650007000437651004000507655004200547852003900589935001900628   97051141 DLC19980718022935.3980612s1998    nyub          000 1 eng    a   97051141   a0684834545 :c$21.50  aDLCcDLCdDLC  an-us-ma00aPS3553.R23bS56 1998  a0610107300a813/.54221  aFIC CRA1 aCraig, Philip R.,d1933-12aA shoot on Martha's Vineyard :ba Martha's Vineyard mystery /cPhilip R. Craig.  aNew York :bScribner,cc1998.  a285 p., map ;c22 cm. 0aJackson, Jeff (Fictitious character)xFiction. 0aPrivate investigatorszMassachusettszMartha's VineyardxFiction. 0aMartha's Vineyard (Mass.)xFiction. 7aDetective and mystery stories.2gsafd1 hFIC CRAp3CPL000018273$9P21.50usd  aBILL BIRTHISEL00636pam  2200241 a 4500001001300000003000400013005001700017008004100034010001700075020002500092040001800117050002700135069001300162082001600175090001200191100001900203245003100222250001200253260004400265300002700309852003900336935001900375   98005935 DLC19980718022935.3980609s1998    nyu           000 1 eng    a   98005935   a068815090X :c$24.50  aDLCcDLCdDLC00aPS3563.E4496bD43 1998  a0610107300a813/.54221  aFIC MEL1 aMeltzer, Brad.10aDead even /cBrad Meltzer.  a1st ed.  aNew York :bRob Weisbach Books,cc1998.  aviii, 401 p. ;c25 cm.1 hFIC MELp3CPL000018274/9P24.50usd  aBILL BIRTHISEL00785nam  2200241 a 4500001001300000005001700013008004100030020003200071040003500103050002700138069001300165082001600178090001200194100002000206245007200226246002100298250002800319260005100347300002400398500006300422852003900485935001900524bl 99786831 19980718022935.3970424r19971996nyu           000 1 eng d  a0060928336 (pbk.) :c$14.00  aBaker & TaylorcBaker & Taylor14aPS3573.E4937bD58 1997  a0610107304a813/.54221  aFIC WEL1 aWells, Rebecca.10aDivine secrets of the Ya-Ya Sisterhood :ba novel /cRebecca Wells.30aYa-Ya Sisterhood  a1st HarperPerennial ed.  aNew York, NY :bHarperPerennial,c1997, c1996.  ax, 356 p. ;c21 cm.  aOriginally published: New York, NY : HarperCollins, c1996.1 hFIC WELp3CPL000018275+9P14.00usd  aBILL BIRTHISEL01198pam  2200325 a 4500001001600000003000400016005001700020008004100037010002000078020003100098040001800129050002200147069001300169082001400182090001200196100001800208245003900226250003100265260005700296300002100353520026100374521002800635521003300663521002400696650003700720650002300757650003500780852003800815935001900853   95008884 /ACDLC19980718022935.4970814r19951994nyu    j      000 1 eng    a   95008884 /AC  a0786810998 (pbk.) :c$4.95  aDLCcDLCdDLC00aPZ7.Z647bLo 1995  a0610107300a[Fic]220  aFIC ZIN1 aZindel, Paul.10aLoch :ba novel /cby Paul Zindel.  a1st Hyperion Paperback ed.  aNew York :bHyperion Paperbacks for Children,c1995.  a209 p. ;c20 cm.  aFifteen-year-old Loch and his younger sister join their father on a scientific expedition searching for enormous prehistoric creatures sighted in a Vermont lake, but soon discover that the expedition's leaders aren't interested in preserving the creatures.0 a"RL: 6"--P. 4 of cover.1 a"Ages 11-15"--P. 4 of cover.2 a7-9bBaker & Taylor 1aUnderwater explorationxFiction. 1aMonstersxFiction. 1aBrothers and sistersxFiction.1 hFIC ZINp3CPL000018276%9P4.95usd  aBILL BIRTHISEL01081pam  2200301 a 4500001001600000003000400016005001700020008004100037010002000078020003100098040002900129050002200158069001300180082001400193090001200207100001800219245003500237250002600272260005700298300002100355500005800376520020600434521002400640650002300664651003500687852003800722935001900760   96003463 /ACDLC19980718022935.4960209r19961995nyu    j      000 1 eng    a   96003463 /AC  a0786811579 (pbk.) :c$4.95  aDLCcDLCdBaker & Taylor10aPZ7.Z647bDo 1996  a0610107300a[Fic]220  aFIC ZIN1 aZindel, Paul.14aThe doom stone /cPaul Zindel.  a1st Hyperion pbk. ed.  aNew York :bHyperion Paperbacks for Children,c1996.  a173 p. ;c20 cm.  aOriginally published: New York : HarperCollins, 1995.  aWhen fifteen-year-old Jackson visits his aunt in England, he becomes caught up in a chase to capture an unknown creature who is stalking and killing people on the plains surrounding ancient Stonehenge.2 a7-9bBaker & Taylor 1aMonstersxFiction. 1aStonehenge (England)xFiction.1 hFIC ZINp3CPL00001827709P4.95usd  aBILL BIRTHISEL00636nam  22002418a 4500001001300000003000400013005001700017008004100034010001700075020002500092040001300117050002600130069001300156082001600169090001200185100002900197245005700226260003300283263000900316300001100325852003900336935001900375   98010994 DLC19980718022935.5980115s1998    nyu           000 1 eng    a   98010994   a0684850265 :c$24.50  aDLCcDLC00aPS3558.E4753bF3 1998  a0610107300a813/.54221  aFIC HEL1 aHellenga, Robert,d1941-14aThe fall of a sparrow :ba novel /cRobert Hellenga.  aNew York :bScribner,c1998.  a9807  ap. cm.1 hFIC HELp3CPL00001827819P24.50usd  aBILL BIRTHISEL00951pam  2200313 a 4500001001300000003000400013005001700017008004100034010001700075020002500092040001800117043001200135050002700147069001300174082002600187090001400213100002700227245008700254250001700341260003800358300003500396600002700431650002200458650002200480650003200502650004300534852004100577935001900618   97017318 DLC19980718022935.5980306r1997    nyua          000 0aeng    a   97017318   a0679456589 :c$22.50  aDLCcDLCdDLC  an-us-ca00aSF284.52.R635bA3 1997  a0610107300a636.1/0835/092aB221  aB ROBERTS1 aRoberts, Monty,d1935-14aThe man who listens to horses /cMonty Roberts ; introduction by Lawrence Scanlan.  a1st U.S. ed.  aNew York :bRandom House,cc1997.  axxiv, 258 p. :bill. ;c25 cm.10aRoberts, Monty,d1935- 0aHorsesxBehavior. 0aHorsesxTraining. 0aHuman-animal communication. 0aHorse trainerszCaliforniaxBiography.1 hB ROBERTSp3CPL00001827929P22.50usd  aBILL BIRTHISEL00727cam  2200265 a 4500001001800000003000400018005001700022008004100039010002200080020002500102040003000127050002500157069001300182082001600195090001200211100002100223245003100244250001200275260003500287300002100322650002400343655003600367852003900403935001900442   97034305 //r98DLC19980718022935.5980615s1998    nyu           000 1 eng    a   97034305 //r98  a068814179X :c$21.50  aDLCcDLCdDLCdOCoLCdDLC00aPS3552.L63bH58 1998  a0610107300a813/.54221  aFIC BLO1 aBlock, Lawrence.10aHit man /cLawrence Block.  a1st ed.  aNew York :bW. Morrow,cc1998.  a259 p. ;c25 cm. 0aAssassinsxFiction. 7aBlack humor (Literature)2gsafd1 hFIC BLOp3CPL000018280.9P21.50usd  aBILL BIRTHISEL00652cam  22002538a 4500001001300000003000400013005001700017008004100034010001700075020002500092040001800117050002600135069001300161082001600174090001200190100002200202245004100224250001200265260004300277263000900320300001100329852003900340935001900379   98014627 DLC19980718022935.6980518s1998    nyu           000 1 eng    a   98014627   a0312185863 :c$23.95  aDLCcDLCdDLC00aPS3555.V2126bF6 1998  a0610107300a813/.54221  aFIC EVA1 aEvanovich, Janet.10aFour to score /cby Janet Evanovich.  a1st ed.  aNew York :bSt. Martin's Press,c1998.  a9808  ap. cm.1 hFIC EVAp3CPL000018281 9P23.95usd  aBILL BIRTHISEL00631pam  2200229 a 4500001001300000003000400013005001700017008004100034010001700075020002500092040002100117050002600138069001300164082001600177090001200193100003200205245004200237260004300279300002100322852003900343935001900382   98010479 DLC19980718022935.6980129s1998    nyu           000 1 eng    a   98010479   a0399143947 :c$25.95  aDLCcDLCdNjSoBT00aPS3553.O692bP57 1998  a0610107300a813/.54221  aFIC COR1 aCornwell, Patricia Daniels.10aPoint of origin /cPatricia Cornwell.  aNew York :bG.P. Putnam's Sons,c1998.  a356 p. ;c25 cm.1 hFIC CORp3CPL000018282$9P25.95usd  aBILL BIRTHISEL00683pam  2200241 a 4500001001300000003000400013005001700017008004100034010001700075020002500092040002100117050002700138069001300165082001600178090001200194100001900206245005500225250001200280260006600292300002500358852003900383935001900422   97041124 DLC19980718022935.7971015s1998    nyu           000 1 eng    a   97041124   a0679445315 :c$21.50  aDLCcDLCdNjSoBT14aPS3573.H452bQ57 1998b  a0610107300a813/.54221  aFIC WHI1 aWhite, Bailey.10aQuite a year for plums :ba novel /cBailey White.  a1st ed.  aNew York :bA.A. Knopf :bDistributed by Random House,c1998.  aix, 220 p. ;c20 cm.1 hFIC WHIp3CPL000018283/9P21.50usd  aBILL BIRTHISEL00900nam  22003018a 4500001001300000003000400013005001700017008004100034010001700075020003200092040001300124050002300137069001300160082001900173090001600192100002300208245007000231250001500301260003700316263000900353300001100362500002000373650005000393650003200443650006100475852004300536935001900579   98018543 DLC19980718022935.7980401s1998    nyu           001 0 eng    a   98018543   a0446674052 (pbk.) :c$16.99  aDLCcDLC00aRG133.5b.S55 1998  a0610107300a616.6/9206221  a616.692 SIL1 aSilber, Sherman J.10aHow to get pregnant with the new technology /cSherman J. Silber.  a[Rev. ed.]  aNew York :bWarner Books,c1998.  a9808  ap. cm.  aIncludes index. 0aHuman reproductive technologyxPopular works. 0aInfertilityxPopular works. 0aContraceptionxTechnological innovationsxPopular works.1 h616.692 SILp3CPL000018284+9P16.99usd  aBILL BIRTHISEL00486nam  22001575  4500001001300000005001700013008004100030020003200071040001900103069001300122245006000135260002300195490006100218852003000279935001900309bk 03123430 19980718022935.7980718s1998    xx                  eng d  a0671010131 (pbk.) :c$14.00  aBaker & Taylor  a0610107300aAmerican Medical Association Essential Guide to Asthma.0 bPocket Booksc19980 aThe American Medical Association Essential Guides Series1 p3CPL000018285%9P14.00usd  aBILL BIRTHISEL00525nam  22001815  4500001001300000005001700013008004100030020003200071040001900103069001300122100003400135245003400169260002300203300001100226490005700237852003000294935001900324bk 03123431 19980718022935.7980718s1998    xx                  eng d  a067101014X (pbk.) :c$14.00  aBaker & Taylor  a0610107310aAmerican Medical Association.10aEssential Guide to Menopause.0 bPocket Booksc1998  a253 p.0 aAmerican Medical Association Essential Guides Series1 p3CPL00001828609P14.00usd  aBILL BIRTHISEL01188cam  2200325 a 4500001002000000003000400020005001700024008004100041010002400082020003100106040001800137043001200155050002100167069001300188082002600201090001700227100001700244245007600261250002600337260004500363300003500408440002500443520017800468521002400646650005400670650005400724650002200778852004300800935001900843   87014817 /AC/r94DLC19980718022935.8940930c19871980nyua   j      00010 eng    a   87014817 /AC/r94  a0020432801 (pbk.) :c$5.99  aDLCcDLCdDLC  anp-----10aE78.G73bG6 1987  a0610107300a398.2/08997078aE219  a398.2089 GOB10aGoble, Paul.14aThe gift of the sacred dog :bstory and illustrations /cby Paul Goble.  a1st Aladdin Books ed.0 aNew York :bAladdin Books,c1987, c1980.  a[32] p. :bcol. ill. ;c26 cm. 0aReading rainbow book  aIn response to an Indian boy's prayer for help for his hungry people, the Great Spirit sends the gift of the Sacred Dogs, horses, which enable the tribe to hunt for buffalo.2 a2-3bBaker & Taylor 0aIndians of North AmericazGreat PlainsxFolklore. 1aIndians of North AmericazGreat PlainsxFolklore. 1aHorsesxFolklore.1 h398.2089 GOBp3CPL00001828719P5.99usd  aBILL BIRTHISEL

Added: packages/libmarc-perl/branches/upstream/current/eg/specials.001
===================================================================
--- packages/libmarc-perl/branches/upstream/current/eg/specials.001	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/eg/specials.001	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1 @@
+01316nam  22003498a 4500001001300000005001700013008004100030010001700071020003200088020003200120035001300152039001800165040001800183043001200201050002100213082002100234100003000255240005700285245015900342260010000501300001700601440002300618500002200641651005500663651005500718700002900773852005300802852005300855900001200908961001300920999003300933ocm12668227 19981205175323.0850913c19861985nyu           00110 eng    a   85023098   a0940450348 (v. 1) :c$27.50  a0940450356 (v. 2) :c$27.50  a431294040 a2b3c3d3e3  aDLCcDLCdWIH  an-us---0 aE331b.A192 19860 a973.4/6/092421910aAdams, Henry,d1838-1918.10aHistory of the United States of America.kSelections10aHistory of the United States during the administrations of Thomas Jefferson and James Madison /cHenry Adams ; [text selection and notes by Earl Harbert].0 aNew York, N.Y. :bLiterary Classics of the United States :bdistributed by Viking Press,c1986-  av. ;c20 cm. 0aLibrary of America  aIncludes indexes. 0aUnited StatesxPolitics and governmenty1801-1809. 0aUnited StatesxPolitics and governmenty1809-1817.10aHarbert, Earl N.,d1934-  aARCPLh823 Adap3CPL000009208.xFSC at aR@e2 at gARCPL  aARCPLh823 Adap3CPL0000107980xFSC at aR@e1 at gARCPL  a823 Ada  a19920131  cwL70dAR Clinton PLf823 Ada00624nam  2200181 a 450000500170000000800410001701000150005802000240007304000080009724501320010525000120023726000580024930000120030750000200031965100450033970000220038499900360040619981203164843.0980604s19uu                  000 0 eng d  a   6520721  alccn 6520721c$5.00  acpl10aWe, the People :bThe Story of the United States Capitol, Its Past and Its Promise /cUnited States Capitol Historical Society.  a6th ed.  aWashington, DC :bNational Geographic Society,c1969.  a143p. ;  aIncludes index. 7aUnited States CapitolzWashington, D. C.10aAikman, Lonnelle.  cwL70dAR Clinton PLf917.53 WeT00692nam  2200241Ii 4500001001300000005001700013008004100030020001500071035001300086040002400099092000600123100002500129245003800154260004400192300002100236490002000257650001700277852003900294852005900333900001200392961001300404999003300417ocm04123596 19981203165106.0780809s1968    nyu    j      00011 eng d  a0440435749  a22677887  aOCAcOCAdm.c.dWSD  ax10aAlexander, Lloyd.   14aThe high king /cLloyd Alexander.0 aNew York :bDell Publishing Co.,c1968.  a304 p. ;c19 cm.0 aA Yearling book 1aFairy tales.  hJuv Alep3CPL000017304Xt1xFSC at aR  aARCPLhJuv Alexanderp3CPL000004252Vt2xFSC at aR@gARCPL  aJuv Ale  a19920131  cwL70dAR Clinton PLfJuv Ale00715nam  2200217 a 450000500170000000800410001701000140005802000290007204000080010110000180010924500530012726000510018030000120023150400270024365000200027065000250029070000280031585200590034385200590040299900360046119981206221347.0980407s19uu                  000 0 eng d  a   786672  a0882661329 (pbk.)c$4.95  acpl1 aRogers, Marc.10aGrowing & Saving Vegetable Seeds /cMarc Rogers.  aCharlotte, VT :bGarden Way Publishing,c1978.  a140p. ;  aBibliography:  p. 127. 7aVegetable seed. 7aVegetable gardening.10aAlexander, Polly,eill.  h635.04 Rogp3CPL000015763/t1xFSC at aR@c197908209p4.95  h635.04 Rogp3CPL0000157592t2xFSC at aR@c198206039p4.95  cwL70dAR Clinton PLf635.04 Rog00769nam  2200241 a 450000500170000000800410001701000150005802000310007304000080010410000250011224500360013726000370017330000120021044000270022250000200024970000360026970000340030570000340033985200580037385200580043190000140048999900240050319981207172555.0980326s19uu                  000 0 eng d  a   7295538  alccn 77085477//r872c$1.95  acpl1 aAlexander, Taylor R.10aEcology /cTaylor R. Alexander.  aNew York :bGolden Press,c1974.  a160p. ; 0aGolden Science Guides.  aIncludes index.10aFichter, George S.,eCo-author.10aPerlman, Raymond,eCo-author.10aWebster, Vera R.,eCo-author.  h574.5 Alep3CPL000016421Wt2xFSC at aR@c198706309p1.95  h574.5 Alep3CPL0000171790t1xFSC at aR@c198406309p1.95  a574.5 Ale  cwL70dAR Clinton PL00870nam  2200265 a 4500001001300000003000600013005001700019008004100036020001500077040001700092082001500109100001800124245006800142250001300210260004100223300003800264440001200302500002000314504002700334520012700361521002500488650004400513650003200557900001500589   46731069 KyAlM19981203165445.0970916s1998    nyuo          001 0 eng d  a0823925420  aKyAlMcKyAlM14a791.432131 aAllman, Paul.10aExploring careers in video and digital video /cby Paul Allman.  aRev. ed.  aNew York :bRosen Publishing,c1998.  a144 p. :bill., photos. ;c23 cm. 0aCareers  aIncludes index.  aIncludes bibliography.  aThis book describes the various careers available in television and how to acquire the necessary training and preparation.2 a9-12bMedialog, Inc.07aTelevisionxVocational guidance.2sears07aVocational guidance.2sears  a791.43 All00962nam  2200277Ia 4500001001300000005001700013008004100030020001500071035001300086040001800099090002300117092001800140245010700158260007700265263000900342300002100351650003600372650003000408710003100438740002500469852004700494852007500541900001700616961001300633999003800646ocm13303035 19981203165626.0860317c19861981nyu           00010 eng d  a0517490110  a42324246  aSALcSALdWEC  aCS2377b.M689 1986  a929.4bModern00aModern American encyclopedia of names for your baby /ccompiled by the editors of American Baby Books.0 aNew York :bGramercy Pub. Co. :bDistributed by Crown Publishers,c1986.  a8601  a174 p. ;c22 cm. 0aNames, PersonalzUnited States. 0aNames, PersonalxEnglish.20aAmerican Baby Books (Firm)01aNames for your baby.  p3CPL000014664$t2xFSC at aR@c198312309p4.00  aARCPLh929.4403 Modp3CPL000009421Yt1xFSC at aR@c19871030 at gARCPL9p6.95  a929.4403 Mod  a19920131  cwL70dAR Clinton PLf929.4403 Mod01211pam  2200337 i 4500001001300000005001700013008004100030010001700071020003700088035001300125040002400138050001900162082001300181100002700194245012800221260004200349300003200391500002000423504003000443650002300473650002200496650001800518700005100536710004500587852006000632852007400692871006200766900001600828961001300844999001600857ocm02091677 19981205171708.0760311s1976    nyua     b    00110 engm   a   76008471   a0385291434 (pbk.)c$8.95 & $5.95  a15221253  aDLCcDLCdm.c.dGZR0 aHQ772.5b.A398  a649/.12310aAmes, Louise Bates.   10aYour four-year-old :bwild and wonderful /cby Louise Bates Ames and Frances L. Ilg, Gesell Institute of Child Development.0 aNew York :bDelacorte Press,c[c1976]  av, 152 p. :bill. ;c22 cm.  aIncludes index.  aBibliography: p. 139-146. 0aChild development. 0aChild psychology. 0aChild rearing10aIlg, Frances Lillian,d1902-ejoint author.   20aGesell Institute of Child Development     h649.124 Amep3CPL000016049 t2xFSC at aR@c199407309p5.95  aARCPLh649.124 Amep3CPL000002955$t1xFSC at aR@c19910228 at gARCPL9p8.9529a      aGesell Institute of Child Development, New Haven.  a649.124 Ame  a19920131  f649.124 Ame01267nam  2200349Ia 4500001001300000005001700013008004100030020003900071035001300110040001800123099001800141100002700159245008600186260004500272300002900317500005400346500001900400650001900419650002300438650002200461653004500483700003800528852006100566852004700627886008300674886003000757886003000787886003000817900001600847961001300863999004100876ocm16503266 19981205183627.0870817r19841976enka          00010 eng d  a0385291426 (pbk.) :c$8.95 & $6.95  a50615246  aWZWcWZWdWIJ  a155.423 Am37y10aAmes, Louise Bates.   10aYour three year old:bfriend or enemy /cby Louise Bates Ames and Frances L. Ilg.0 aNew York:bDell Pub., Co.,c1984, c1976.  a168 p. :bill. ;c23 cm.  aOriginally published: New York : Delacorte, 1976.  a"A Delta book" 0aChild rearing. 0aChild development. 0aChild psychology.  aChildren, 3-4 yearsaHome care - Manuals10aIlg, Frances L.q(Frances Lilian)  aARCPLp3CPL000010219Vt2xFSC at aR@c19940730 at gARCPL9p6.95  p3CPL000016050Ut1xFSC at aR@c199104309p8.952 2UK MARCa690b00z11030achildren, 3-4 yearsz21030ahome carez60030amanuals2 2UK MARCa691b00a32189372 2UK MARCa692b00a00068582 2UK MARCa692b00a0296805  a649.124 Ame  a19920131  cwL70dAR Clinton PLf649.124 Ames,L.00336nam  2200133 a 450000500170000000800410001702000150005804000080007310000190008124500500010025000090015026000310015930000120019019981203170301.0971118s19uu                  000 0 eng d  a0375500316  acpl1 aAngelou, Maya,10aEven the Stars Look Lonesome /cMaya Angelou.  a1st.  aNew York :brandom,c1997.  a145p. ;00578nam  2200193 a 450000500170000000800410001702000150005804000080007310000190008124500440010025000250014426000430016930000120021260000170022485200490024185200490029090000100033999900350034919981203170305.0971117s19uu                  000 0 eng d  a0553380095  acpl1 aAngelou, Maya,10aHeart of a Woman (The) /cMaya Angelou.  aBantam trade edition  aNew York :bBantam Books,c1997, c1981  a324p. ;17aMaya Angelou  hB Angeloup3CPL000014469%t2xFSC at aR9p12.00  hB Angeloup3CPL000014465 t1xFSC at aR9p12.00  aB Ang  cwL70dAR Clinton PLfB Angelou00438nam  2200157 a 450000500170000000800410001701000120005802000290007004000080009910000200010724500360012725000240016326000600018730000120024744000210025919981210154218.0981210s19uu                  000 0 eng d  a9325511  a0812533666 (pbk.)c$6.99  acpl1 aAnthony, Piers.10aIsle of Woman /cPiers Anthony.  a1st mass market ed.  aNew York :bTom Doherty Associates Books,c1994, c1993.  a470p. ; 0aGeodysseyvno. 100482nam  2200169 a 450000500170000000800410001701000120005802000290007004000080009910000200010724500350012725000240016226000600018630000120024644000210025899900330027919981210154203.0981210s19uu                  000 0 eng d  a9421747  a0812550919 (pbk.)c$5.99  acpl1 aAnthony, Piers.10aShame of Man /cPiers Anthony.  a1st mass market ed.  aNew York :bTom Doherty Associates Books,c1995, c1994.  a503p. ; 0aGeodysseyvno. 2  ccwL70dAR Clinton PLfSF Ant01055nam  2200301 a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001700109082001500126100001900141245007400160260004100234300004200275440004200317500002000359500002300379504002700402520016900429521002500598650003000623650003500653650002600688900001500714999002400729   46730883 KyAlM19981203171438.0970613s1997    nyuo          001 0 eng d  a   96035171   a0823922502  aKyAlMcKyAlM14a306.732121 aAyer, Eleanor.10aIt's okay to say no :bchoosing sexual abstinence /cby Eleanor Ayer.  aNew York :bRosen Publishing,c1997.  a64 p. :bill., col. photos. ;c25 cm. 4aThe Teen pregnancy prevention library  aIncludes index.  aIncludes glossary.  aIncludes bibliography.  aThis book discusses what abstinence means, the dangers of teenage sexual activity, the difficulty of choosing abstinence, and the advantages of abstaining from sex.2 a9-12bMedialog, Inc.07aSexual abstinence.2sears07aYouthxSexual behavior.2sears07aBirth control.2sears  a306.73 Aye  cwL70dAR Clinton PL
\ No newline at end of file

Added: packages/libmarc-perl/branches/upstream/current/eg/uclocal.pl
===================================================================
--- packages/libmarc-perl/branches/upstream/current/eg/uclocal.pl	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/eg/uclocal.pl	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,217 @@
+#!/usr/bin/perl -w
+
+  # The following example is an expanded version of "addlocal.pl" that
+  # checks and fixes existing records in addition to processing new ones.
+  # It looks for a call number subfield 'h' of each 852 field (#852.h).
+  # It also checks #900.a and #999.f for the data. It then converts the
+  # call number fields to upper case and confirms they are all identical.
+  # For mismatches and missing 852 data, the records are not modified,
+  # but an ascii version is written so the librarian can determine what
+  # is correct. Missing 900 and 999 data is created. An ascii version of
+  # the altered records is written for checking. This is a somewhat
+  # contrived example. But it shows what can be done with manipulating
+  # field data and using option templates.
+
+use MARC 0.98;
+use strict;
+
+my $infile = "specials.001";
+my $outfile = "output.004";	# results in usmarc format
+my $outtext = "output5.txt";	# original input in ascii for ok callno.
+my $outtext2 = "output6.txt";	# changed records in ascii
+my $outtext3 = "output7.txt";	# invalid or mismatched records in ascii
+my $outtext4 = "output8.txt";	# ascii for all ok callno (change or not)
+unlink $outfile, $outtext, $outtext2, $outtext3, $outtext4;
+
+  # This subroutine takes an array of all the call numbers found. It
+  # returns an upper-cased version if all compare or '' if not
+
+sub check_callno {
+    my $num1 = uc(shift);
+    foreach (@_) {
+	return '' unless ($num1 eq uc($_));
+    }
+    return $num1;
+}
+
+  # This subroutine does most of the dirty work. There are four required
+  # parameters: $marc, $template, $subfield, and $value. It will return
+  # "undef" unless all four are specified. Zero (0 or "0") is a possible
+  # $subfield or $value. Blank ('') can be used for the $value.
+
+sub fix_subfield {
+    my $marc = shift || return;
+    my $template = shift || return;
+    my $subfield = shift;
+    my $value = shift;
+    return unless (defined $subfield and defined $value);
+    my $altered = 0;
+
+  # If the $subfield already exists, get the data in a format suitable
+  # for making updates. Note the use of $template.
+
+    my ($found) = $marc->searchmarc($template);
+    if (defined $found) {
+        my @u = $marc->getupdate($template);
+        my @f = ();
+        my $ff;
+        my $fixed = 0;
+
+  # $fixed accounts for the situation when the call number may be present
+  # in some of the 852 fields, but not all of them. $fixed gets set when
+  # the $subfield is found within a single field. If processing reaches
+  # the end of the field (the "\036" delimiter) without $fixed, then the
+  # $subfield and $value are appended to that field.
+
+        while (@u) {
+	    last unless defined ($ff = shift @u);
+	    if ($ff eq "\036") {
+	        unless ($fixed) {
+	            push @f, $subfield, $value;
+	            $altered++;
+	        }
+	        push @f, $ff;
+    	        $fixed = 0;
+	        next;
+	    }
+	    push @f, $ff;
+
+  # All subfields that don't match out target just get copied.
+
+	    unless ($subfield eq $ff) {
+	        push @f, shift @u;
+	        next;
+	    }
+	    last unless defined ($ff = shift @u);
+
+  # Fix the target if necessary and set $altered if anything changed.
+
+	    if ($value eq $ff) {
+	        push @f, $ff;
+	    }
+	    else {
+	        $altered++;
+	        push @f, $value;
+	    }
+	    $fixed++;
+        }
+
+  # Actually fix the record if required. Again note the use of $template.
+
+	if ($altered) {
+	    $marc->updaterecord ($template, @f)
+		|| warn "update failed: $template->{field}, $subfield\n";
+	}
+    }
+
+  # This next part is tricky. If fix_subfield is called with just the
+  # four required parameters, you bypass the next step. The preceeding
+  # part is run if searchmarc() finds the field specified in the
+  # $template. But if the field does not exist, and there are optional
+  # parameters in the call to fix_subfield, those parameters are used
+  # as a series of subfields for an addfield(). In plain language, you
+  # can tell fix_subfield what to add if the field doesn't exist.
+
+    elsif (@_) {
+        $marc->addfield($template, @_)
+		|| warn "addfield failed: $template->{field}, $subfield\n";
+	$altered++;
+    }
+    return $altered;
+}
+
+  # The $template hashes for this example:
+
+my $loc852 = {record=>1, field=>'852', ordered=>'y'};
+my $loc900 = {record=>1, field=>'900', ordered=>'y'}; 
+my $loc999 = {record=>1, field=>'999', ordered=>'n'};
+
+  # The create_if_not_found field specifications:
+ 
+my @default900 = ('i1',' ','i2',' ','a');
+my @default999 = ('i1',' ','i2',' ','c','wL70','d','AR Clinton PL','f');
+
+my $invalid = 0;
+my $updated = 0;
+my $totalcount = 0;
+my $x = MARC->new;
+$x->openmarc({file=>$infile,'format'=>"usmarc"}) || die;
+
+  # We process records one at a time for this operation. Multiple 852 fields
+  # are legal (for multiple copies).
+
+while ($x->nextmarc(1)) {
+    my $change = 0;
+    my @callno = $x->getvalue($loc852,'subfield','h');
+
+  # But multiple 900 and 999 fields are not permitted. So we force a
+  # miscompare if we discover one.
+
+    my ($from900, $dup900) = $x->getvalue($loc900,'subfield','a');
+    if (defined $from900) { push @callno, $from900; }
+    if (defined $dup900) { push @callno, ''; }
+    my ($from999, $dup999) = $x->getvalue($loc999,'subfield','f');
+    if (defined $from999) { push @callno, $from999; }
+    if (defined $dup999) { push @callno, ''; }
+    
+  # We now have an array of all the call numbers found. The subroutine
+  # returns an upper-cased version if all compare or '' if not.
+
+    my $callno = check_callno(@callno);
+
+  # Write a "good" result back to everywhere that it should be. Keep track
+  # of which records were modified. And notice that a $template conveys
+  # a lot of repeated information.
+
+    if ($callno) {
+        $x->output({file=>">>$outtext",'format'=>"ascii"});
+
+  # $outtext is a "before" ascii file to compare changes with the "after"
+  # ascii file $outtext4.
+
+        if (fix_subfield($x,$loc852,'h',"$callno")) {
+	    $change++;
+        }
+
+  # The 852 subfield passes just the four required parameters. Hence
+  # nothing is added if the 852 field is missing.
+
+        if (fix_subfield($x,$loc900,'a',"$callno", at default900,"$callno")) {
+	    $change++;
+        }
+
+  # The 900 and 999 fields are created with default values if they
+  # do not already exist.
+
+        if (fix_subfield($x,$loc999,'f',"$callno", at default999,"$callno")) {
+	    $change++;
+        }
+        $x->output({file=>">>$outfile",'format'=>"usmarc"});
+        $x->output({file=>">>$outtext2",'format'=>"ascii"}) if $change;
+        $x->output({file=>">>$outtext4",'format'=>"ascii"});
+	$updated++ if $change;
+    }
+
+  # Write the records with invalid or mismatched call numbers. In this
+  # example, they go into the same usmarc format file $outfile.
+
+    else {
+        $x->output({file=>">>$outfile",'format'=>"usmarc"});
+        $x->output({file=>">>$outtext3",'format'=>"ascii"});
+	$invalid++;
+    }
+    $x->deletemarc(); #empty the object for reading in another
+    $totalcount++;
+}
+
+  # We write all the records to the output file in MARC format. The ascii
+  # output in $outtext3 gives the librarian both a list of records
+  # requiring manual call number assignment/resolution and all the Title,
+  # Author, Publication and related data needed to assign location based
+  # on standard references. For checking, we write all the modified
+  # records to $outtext2.
+
+    print "\nprocessed $totalcount records\n";
+    print "$updated had call numbers which were changed\n";
+    print "$invalid had missing or invalid call numbers\n";
+

Added: packages/libmarc-perl/branches/upstream/current/t/MARCopt.pm
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/MARCopt.pm	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/MARCopt.pm	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,14 @@
+package MARCopt;
+# Inheritance test for test3.t only
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+$VERSION = '1.04';
+require Exporter;
+use MARC;
+ at ISA = qw( Exporter MARC );
+ at EXPORT= qw();
+ at EXPORT_OK= @MARC::EXPORT_OK;
+%EXPORT_TAGS = %MARC::EXPORT_TAGS;
+
+print "MARCopt inherits from MARC\n";
+1;

Added: packages/libmarc-perl/branches/upstream/current/t/badmarc.dat
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/badmarc.dat	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/badmarc.dat	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1 @@
+00901cam  2200241Ia 45e0001001300000003000600013005001700019008004100036040001800077090002100095049000900116100002900125245019000154260003800344300005400382500002200436500005900458500004000517500005300557510001500610740002200625994001200647ocm01047729 OCoLC19990808143752.0741021s1884    enkaf         000 1 eng d  aKSUcKSUdGZM  aPS1305b.A1 1884  aVODN1 aTwain, Mark,d1835-1910.14aThe adventures of Huckleberry Finn :b(Tom Sawyer's comrade) : scene, the Mississippi Valley : time, forty to fifty years ago /cby Mark Twain (Samuel Clemens) ; with 174 illustrations.  aLondon :bChatto & Windus,c1884.  axvi, 438 p., [1] leaf of plates :bill. ;c20 cm.  aFirst English ed.  aState B; gatherings saddle-stitched with wire staples.  aAdvertisements on p. [1]-32 at end.  aBound in red S cloth; stamped in black and gold.4 aBALc3414.01aHuckleberry Finn.  aE0bVOD01BADcmm  2200325Ka 45e0001001300000003000600013005001700019007000700036008004100043040001300084090001500097049000900112245004600121246001800167246003500185246002100220256002500241260004600266538003600312500002500348500006300373506003100436520046600467650004900933650004500982710002201027710001701049856006301066994001201129ocm40139019 OCoLC19990824212014.0cr mnu981020m19989999pau        c        eng d  aVODcVOD  aTR820b.A2  aVODN00aAccuNet/AP photo archiveh[computer file]30aPhoto archive3 aAssociated Press photo archive30aAP photo archive  aComputer image data.  aState College, Pa. :bAccuweather,c1998-  aMode of access: World Wide Web.  aTitle from homepage.  aPublished jointly by Accuweather and The Associated Press.  aSubscription based access.  a"The Photo Archive features state, regional and national photos from North America, as well as ... international photos all available moments after they move on the AP's spot picture system. An average of 800 photos a day feed into the Photo Archive, and remain there for a minimum of one year. Specially trained indexers select the best 200 or so photos each day to save for all time, while the remainder are eliminated from the Photo Archive after 12 months." 0aPhotojournalismxComputer network resources. 0aPhotographsxComputer network resources.2 aAssociated Press.2 aAccuweather.7 uhttp://ap.accuweather.com2httpzConnect to this resource.  aE0bVOD00901camADD  2200241Ia 45e0001001300000003000600013005001700019008004100036040001800077090002100095049000900116100002900125245019000154260003800344300005400382500002200436500005900458500004000517500005300557510001500610740002200625994001200647ocm01047729 OCoLC19990808143752.0741021s1884    enkaf         000 1 eng d  aKSUcKSUdGZM  aPS1305b.A1 1884  aVODN1 aTwain, Mark,d1835-1910.14aThe adventures of Huckleberry Finn :b(Tom Sawyer's comrade) : scene, the Mississippi Valley : time, forty to fifty years ago /cby Mark Twain (Samuel Clemens) ; with 174 illustrations.  aLondon :bChatto & Windus,c1884.  axvi, 438 p., [1] leaf of plates :bill. ;c20 cm.  aFirst English ed.  aState B; gatherings saddle-stitched with wire staples.  aAdvertisements on p. [1]-32 at end.  aBound in red S cloth; stamped in black and gold.4 aBALc3414.01aHuckleberry Finn.  aE0bVOD01467cmm  2200325Ka 45e0001001300000003000600013005001700019007000700036008004100043040001300084090001500097049000900112245004600121246001800167246003500185246002100220256002500241260004600266538003600312500002500348500006300373506003100436520046600467650004900933650004500982710002201027710001701049856006301066994001201129ocm40139019 OCoLC19990824212014.0cr mnu981020m19989999pau        c        eng d  aVODcVOD  aTR820b.A2  aVODN00aAccuNet/AP photo archiveh[computer file]30aPhoto archive3 aAssociated Press photo archive30aAP photo archive  aComputer image data.  aState College, Pa. :bAccuweather,c1998-  aMode of access: World Wide Web.  aTitle from homepage.  aPublished jointly by Accuweather and The Associated Press.  aSubscription based access.  a"The Photo Archive features state, regional and national photos from North America, as well as ... international photos all available moments after they move on the AP's spot picture system. An average of 800 photos a day feed into the Photo Archive, and remain there for a minimum of one year. Specially trained indexers select the best 200 or so photos each day to save for all time, while the remainder are eliminated from the Photo Archive after 12 months." 0aPhotojournalismxComputer network resources. 0aPhotographsxComputer network resources.2 aAssociated Press.2 aAccuweather.7 uhttp://ap.accuweather.com2httpzConnect to this resource.  aE0bVOD

Added: packages/libmarc-perl/branches/upstream/current/t/brkrtest.ref
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/brkrtest.ref	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/brkrtest.ref	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,156 @@
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000001\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0deng\d
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2\$aDeer-Doe, J.$q(Jane),$csaint,$d1355-1401,$cspirit.
+=245  10$aNew test record number 1 with ordinary data$h[large print] /$cby Jane Deer-Doe ; edited by Patty O'Furniture.
+=246  1\$aNew test record number one with ordinary data
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955-<1957>
+=300  \\$av. 1-<5> :$bill., maps, ports., charts ;$c cm.
+=440  \0$aTest record series ;$vno. 1
+=500  \\$aThis is a test of ordinary features like replacement of the mnemonics for currency and dollar signs and backslashes (backsolidus {bsol}) used for blanks in certain areas.
+=500  \\$aThis is a test for the conversion of curly braces; the opening curly brace ({lcub}) and the closing curly brace ({rcub}).
+=504  \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+=700  1\$aO'Furniture, Patty,$eed.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000002\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2\$aDeer-Doe, Jane,$d1957-
+=245  10$aNew test record number 2 with currently defined ANSEL characters (mostly diacritics) input with their real hexadecimal values$h[large print] /$cby Jane Deer-Doe
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300 p. :$bill., maps, ports., charts ;$c cm.
+=440  \0$aTest record series ;$vno. 2
+=500  \\$aThis is a test of diacritics like the uppercase Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro, the uppercase Icelandic thorn in {THORN}ann, the uppercase digraph AE in {AElig}gir, the uppercase digraph OE in {OElig}uvres, the soft sign in rech{softsign}, the middle dot in col{middot}lecci{acute}o, the musical flat in F{flat}, the patent mark in Frizbee{reg}, the plus or minus sign in {plusmn}54%, the uppercase O-hook in B{Ohorn}, the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah, the ayn in {mllhring}arab, the lowercase Polish l in W{lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K{ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola, the lowercase Icelandic thorn in {thorn}ann, the lowercase digraph ae in v{aelig}re, the lowercase digraph oe in c{oelig}ur, the lowercase hardsign in s{hardsign}ezd, the Turkish dotless i in masal{inodot}, the British pound sign in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase o-hook (with pseudo question mark) in S{hooka}{ohorn}, the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo question mark in c{hooka}ui, the grave accent in tr{grave}es, the acute accent in d{acute}esir{acute}ee, the circumflex in c{circ}ote, the tilde in ma{tilde}nana, the macron in T{macr}okyo, the breve in russki{breve}i, the dot above in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au, the caron (hachek) in {caron}crny, the circle above (angstrom) in {ring}arbok, the ligature first and second halves in d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki, the candrabindu (breve with dot above) in Ali{candra}iev, the cedilla in {cedil}ca va comme {cedil}ca, the right hook in viet{ogon}a, the dot below in te{dotb}da, the double dot below in {under}k{under}hu{dbldotb}tbah, the circle below in Sa{dotb}msk{ringb}rta, the double underscore in {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa, the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya (half circle below) in {breveb}humantu{caron}s, double tilde, first and second halves in {ldbltil}n{rdbltil}galan, high comma (centered) in g{commaa}eotermika
+=504  \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000003\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2\$aDeer-Doe, Jane,$d1957-
+=245  10$aNew test record number 3 with currently defined ANSEL characters (mostly diacritics) input with mnemonic strings$h[large print] /$cby Jane Deer-Doe
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300 p. :$bill., maps, ports., charts ;$c cm.
+=440  \0$aTest record series ;$vno. 3
+=500  \\$aThis is a test of diacritics like the uppercase Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro, the uppercase Icelandic thorn in {THORN}ann, the uppercase digraph AE in {AElig}gir, the uppercase digraph OE in {OElig}uvres, the soft sign in rech{softsign}, the middle dot in col{middot}lecci{acute}o, the musical flat in F{flat}, the patent mark in Frizbee{reg}, the plus or minus sign in {plusmn}54%, the uppercase O-hook in B{Ohorn}, the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah, the ayn in {mllhring}arab, the lowercase Polish l in W{lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K{ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola, the lowercase Icelandic thorn in {thorn}ann, the lowercase digraph ae in v{aelig}re, the lowercase digraph oe in c{oelig}ur, the lowercase hardsign in s{hardsign}ezd, the Turkish dotless i in masal{inodot}, the British pound sign in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase o-hook (with pseudo question mark) in S{hooka}{ohorn}, the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo question mark in c{hooka}ui, the grave accent in tr{grave}es, the acute accent in d{acute}esir{acute}ee, the circumflex in c{circ}ote, the tilde in ma{tilde}nana, the macron in T{macr}okyo, the breve in russki{breve}i, the dot above in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au, the caron (hachek) in {caron}crny, the circle above (angstrom) in {ring}arbok, the ligature first and second halves in d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki, the candrabindu (breve with dot above) in Ali{candra}iev, the cedilla in {cedil}ca va comme {cedil}ca, the right hook in viet{ogon}a, the dot below in te{dotb}da, the double dot below in {under}k{under}hu{dbldotb}tbah, the circle below in Sa{dotb}msk{ringb}rta, the double underscore in {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa, the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya (half circle below) in {breveb}humantu{caron}s, double tilde, first and second halves in {ldbltil}n{rdbltil}galan, high comma (centered) in g{commaa}eotermika
+=504  \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000004\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2\$aDeer-Doe, Jane,$d1957-
+=245  10$aNew test record number 4 with newly-defined diacritics$h[large print] /$cby Jane Deer-Doe
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300 p. :$bill., maps, ports., charts ;$c cm.
+=440  \0$aTest record series ;$vno. 4
+=500  \\$aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {lcub}text{rcub}, also included are new extended characters degree sign 98.6{deg}, small script l in 45{scriptl}, the phono copyright mark in {phono}1994, the copyright mark in {copy}1955, the musical sharp in concerto in F{sharp} major, the inverted question mark in {iquest}Que pas{acute}o?, and the inverted exclamation mark in {iexcl}Ay caramba!.
+=504  \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000005\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2\$aDeer-Doe, Jane,$d1957-
+=245  10$aNew test record number 5 for all diacritics$h[large print] /$cby Jane Deer-Doe
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300 p. :$bill., maps, ports., charts ;$c cm.
+=440  \0$aTest record series ;$vno. 5
+=500  \\$aThis is a test of diacritics like the uppercase Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro, the uppercase Icelandic thorn in {THORN}ann, the uppercase digraph AE in {AElig}gir, the uppercase digraph OE in {OElig}uvres, the soft sign in rech{softsign}, the middle dot in col{middot}lecci{acute}o, the musical flat in F{flat}, the patent mark in Frizbee{reg}, the plus or minus sign in {plusmn}54%, the uppercase O-hook in B{Ohorn}, the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah, the ayn in {mllhring}arab, the lowercase Polish l in W{lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K{ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola, the lowercase Icelandic thorn in {thorn}ann, the lowercase digraph ae in v{aelig}re, the lowercase digraph oe in c{oelig}ur, the lowercase hardsign in s{hardsign}ezd, the Turkish dotless i in masal{inodot}, the British pound sign in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase o-hook (with pseudo question mark) in S{hooka}{ohorn}, the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo question mark in c{hooka}ui, the grave accent in tr{grave}es, the acute accent in d{acute}esir{acute}ee, the circumflex in c{circ}ote, the tilde in ma{tilde}nana, the macron in T{macr}okyo, the breve in russki{breve}i, the dot above in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au, the caron (hachek) in {caron}crny, the circle above (angstrom) in {ring}arbok, the ligature first and second halves in d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki, the candrabindu (breve with dot above) in Ali{candra}iev, the cedilla in {cedil}ca va comme {cedil}ca, the right hook in viet{ogon}a, the dot below in te{dotb}da, the double dot below in {under}k{under}hu{dbldotb}tbah, the circle below in Sa{dotb}msk{ringb}rta, the double underscore in {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa, the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya (half circle below) in {breveb}humantu{caron}s, double tilde, first and second halves in {ldbltil}n{rdbltil}galan, high comma (centered) in g{commaa}eotermika
+=500  \\$aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {lcub}text{rcub}; also included are new extended characters degree sign 98.6{deg}, small script l in 45{scriptl}, the phono copyright mark in {scriptl}1994, the copyright mark in {phono}1955, the musical sharp in concerto in F{copy} major, the inverted question mark in {iquest}Que pas{acute}o?, and the inverted exclamation mark in {iexcl}Ay caramba!.
+=504  \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000006\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2\$aDeer-Doe, Jane,$d1957-
+=245  12$aA new ultimate test record for diacritics$h[large print] /$cby Jane Deer-Doe
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300 p. :$bill., maps, ports., charts ;$c cm.
+=440  \0$aTest record series ;$vno. 6
+=500  \\$aThis is a test of diacritics like the uppercase Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro, the uppercase Icelandic thorn in {THORN}ann, the uppercase digraph AE in {AElig}gir, the uppercase digraph OE in {OElig}uvres, the soft sign in rech{softsign}, the middle dot in col{middot}lecci{acute}o, the musical flat in F{flat}, the patent mark in Frizbee{reg}, the plus or minus sign in {plusmn}54%, the uppercase O-hook in B{Ohorn}, the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah, the ayn in {mllhring}arab, the lowercase Polish l in W{lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K{ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola, the lowercase Icelandic thorn in {thorn}ann, the lowercase digraph ae in v{aelig}re, the lowercase digraph oe in c{oelig}ur, the lowercase hardsign in s{hardsign}ezd, the Turkish dotless i in masal{inodot}, the British pound sign in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase o-hook (with pseudo question mark) in S{hooka}{ohorn}, the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo question mark in c{hooka}ui, the grave accent in tr{grave}es, the acute accent in d{acute}esir{acute}ee, the circumflex in c{circ}ote, the tilde in ma{tilde}nana, the macron in T{macr}okyo, the breve in russki{breve}i, the dot above in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au, the caron (hachek) in {caron}crny, the circle above (angstrom) in {ring}arbok, the ligature first and second halves in d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki, the candrabindu (breve with dot above) in Ali{candra}iev, the cedilla in {cedil}ca va comme {cedil}ca, the right hook in viet{ogon}a, the dot below in te{dotb}da, the double dot below in {under}k{under}hu{dbldotb}tbah, the circle below in Sa{dotb}msk{ringb}rta, the double underscore in {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa, the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya (half circle below) in {breveb}humantu{caron}s, double tilde, first and second halves in {ldbltil}n{rdbltil}galan, high comma (centered) in g{commaa}eotermika
+=500  \\$aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {lcub}text{rcub}, also included are new extended characters degree sign 98.6{deg}, small script l in 45{scriptl}, the phono copyright mark in {phono}1994, the copyright mark in {copy}1955, the musical sharp in concerto in F{sharp} major, the inverted question mark in {iquest}Que pas{acute}o?, and the inverted exclamation mark in {iexcl}Ay caramba!.
+=504  \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000007\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2\$aDeer-Doe, Jane,$d1957-
+=245  12$aA check of the processing of unrecognized mnemonic strings like {zilch} which might be encountered in the MARCMakr input file.
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300 p. :$bill., maps, ports., charts ;$c cm.
+=440  \0$aTest record series ;$vno. 7
+=500  \\$aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called ({bsol}).
+=504  \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+=856  2\$aftp.loc.gov$d{bsol}pub{bsol}marc
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000008\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=020  \\$a0777000008 :$c{dollar}35.99
+=020  \\$a0777000008 :$c{dollar}35.99
+=020  \\$z3777000008 (German ed.):$c{dollar}46.00
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2\$aDeer-Doe, Jane,$d1957-
+=245  12$aA check of the processing of the dollar sign and mnemonic strings used for real dollar signs (associated with prices).
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300 p. :$bill., maps, ports., charts ;$c cm.
+=440  \0$aTest record series ;$vno. 8
+=500  \\$aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called ({bsol}).
+

Added: packages/libmarc-perl/branches/upstream/current/t/makrbrkr.mrc
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/makrbrkr.mrc	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/makrbrkr.mrc	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1 @@
+01200nam  2200253 a 4500001001300000003000700013005001700020008004100037040001900078050002200097100005500119245011400174246005000288260005600338300005100394440003200445500017000477500011600647504007200763500002000835650002700855600003500882700002900917tes96000001 ViArRB19960221075055.7960221s1955    dcuabcdjdbkoqu001 0deng d  aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, J.q(Jane),csaint,d1355-1401,cspirit.10aNew test record number 1 with ordinary datah[large print] /cby Jane Deer-Doe ; edited by Patty O'Furniture.1 aNew test record number one with ordinary data  aWashington, DC :bLibrary of Congress,c1955-<1957>  av. 1-<5> :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 1  aThis is a test of ordinary features like replacement of the mnemonics for currency and dollar signs and backslashes (backsolidus \) used for blanks in certain areas.  aThis is a test for the conversion of curly braces; the opening curly brace ({) and the closing curly brace (}).  aIncludes Bibliographies, discographies, filmographies, and reviews.  aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.1 aO'Furniture, Patty,eed.02665nam  2200229 a 4500001001300000003000700013005001700020008004100037020001500078040001900093050002200112100002700134245016500161260005000326300004900376440003200425500182400457504007202281500002002353650002702373600003502400tes96000002 ViArRB19960221075055.7960221s1955    dcuabcdjdbkoqu001 0dspa d  a8472236579  aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-10aNew test record number 2 with currently defined ANSEL characters (mostly diacritics) input with their real hexadecimal valuesh[large print] /cby Jane Deer-Doe  aWashington, DC :bLibrary of Congress,c1955.  a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 2  aThis is a test of diacritics like the uppercase Polish L in ¡âodâz, the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro, the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir, the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª, the plus or minus sign in «54%, the uppercase O-hook in B¬, the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab, the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in K²benhavn, the lowercase d with crossbar in ³avola, the lowercase Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur, the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase u-hook in T½ D½c, the pseudo question mark in càui, the grave accent in tráes, the acute accent in dâesirâee, the circumflex in cãote, the tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek) in écrny, the circle above (angstrom) in êarbok, the ligature first and second halves in dëiìadëiìa, the high comma off center in rozdelíovac, the double acute in idîoszaki, the candrabindu (breve with dot above) in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña, the dot below in teòda, the double dot below in ököhuótbah, the circle below in Saòmskôrta, the double underscore in õGhulam, the left hook in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the upadhmaniya (half circle below) in ùhumantués, double tilde, first and second halves in únûgalan, high comma (centered) in gþeotermika  aIncludes Bibliographies, discographies, filmographies, and reviews.  aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.02652nam  2200229 a 4500001001300000003000700013005001700020008004100037020001500078040001900093050002200112100002700134245015200161260005000313300004900363440003200412500182400444504007202268500002002340650002702360600003502387tes96000003 ViArRB19960221075055.7960221s1955    dcuabcdjdbkoqu001 0dspa d  a8472236579  aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-10aNew test record number 3 with currently defined ANSEL characters (mostly diacritics) input with mnemonic stringsh[large print] /cby Jane Deer-Doe  aWashington, DC :bLibrary of Congress,c1955.  a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 3  aThis is a test of diacritics like the uppercase Polish L in ¡âodâz, the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro, the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir, the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª, the plus or minus sign in «54%, the uppercase O-hook in B¬, the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab, the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in K²benhavn, the lowercase d with crossbar in ³avola, the lowercase Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur, the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase u-hook in T½ D½c, the pseudo question mark in càui, the grave accent in tráes, the acute accent in dâesirâee, the circumflex in cãote, the tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek) in écrny, the circle above (angstrom) in êarbok, the ligature first and second halves in dëiìadëiìa, the high comma off center in rozdelíovac, the double acute in idîoszaki, the candrabindu (breve with dot above) in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña, the dot below in teòda, the double dot below in ököhuótbah, the circle below in Saòmskôrta, the double underscore in õGhulam, the left hook in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the upadhmaniya (half circle below) in ùhumantués, double tilde, first and second halves in únûgalan, high comma (centered) in gþeotermika  aIncludes Bibliographies, discographies, filmographies, and reviews.  aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.01276nam  2200229 a 4500001001300000003000700013005001700020008004100037020001500078040001900093050002200112100002700134245009400161260005000255300004900305440003200354500050600386504007200892500002000964650002700984600003501011tes96000004 ViArRB19960221075055.7960221s1955    dcuabcdjdbkoqu001 0dspa d  a8472236579  aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-10aNew test record number 4 with newly-defined diacriticsh[large print] /cby Jane Deer-Doe  aWashington, DC :bLibrary of Congress,c1955.  a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 4  aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {text}, also included are new extended characters degree sign 98.6À, small script l in 45Á, the phono copyright mark in Â1994, the copyright mark in Ã1955, the musical sharp in concerto in FÄ major, the inverted question mark in ÅQue pasâo?, and the inverted exclamation mark in ÆAy caramba!.  aIncludes Bibliographies, discographies, filmographies, and reviews.  aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.03101nam  2200241 a 4500001001300000003000700013005001700020008004100037020001500078040001900093050002200112100002700134245008300161260005000244300004900294440003200343500182400375500050602199504007202705500002002777650002702797600003502824tes96000005 ViArRB19960221075055.7960221s1955    dcuabcdjdbkoqu001 0dspa d  a8472236579  aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-10aNew test record number 5 for all diacriticsh[large print] /cby Jane Deer-Doe  aWashington, DC :bLibrary of Congress,c1955.  a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 5  aThis is a test of diacritics like the uppercase Polish L in ¡âodâz, the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro, the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir, the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª, the plus or minus sign in «54%, the uppercase O-hook in B¬, the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab, the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in K²benhavn, the lowercase d with crossbar in ³avola, the lowercase Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur, the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase u-hook in T½ D½c, the pseudo question mark in càui, the grave accent in tráes, the acute accent in dâesirâee, the circumflex in cãote, the tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek) in écrny, the circle above (angstrom) in êarbok, the ligature first and second halves in dëiìadëiìa, the high comma off center in rozdelíovac, the double acute in idîoszaki, the candrabindu (breve with dot above) in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña, the dot below in teòda, the double dot below in ököhuótbah, the circle below in Saòmskôrta, the double underscore in õGhulam, the left hook in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the upadhmaniya (half circle below) in ùhumantués, double tilde, first and second halves in únûgalan, high comma (centered) in gþeotermika  aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {text}; also included are new extended characters degree sign 98.6À, small script l in 45Á, the phono copyright mark in Á1994, the copyright mark in Â1955, the musical sharp in concerto in Fà major, the inverted question mark in ÅQue pasâo?, and the inverted exclamation mark in ÆAy caramba!.  aIncludes Bibliographies, discographies, filmographies, and reviews.  aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.03099nam  2200241 a 4500001001300000003000700013005001700020008004100037020001500078040001900093050002200112100002700134245008100161260005000242300004900292440003200341500182400373500050602197504007202703500002002775650002702795600003502822tes96000006 ViArRB19960221075055.7960221s1955    dcuabcdjdbkoqu001 0dspa d  a8472236579  aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-12aA new ultimate test record for diacriticsh[large print] /cby Jane Deer-Doe  aWashington, DC :bLibrary of Congress,c1955.  a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 6  aThis is a test of diacritics like the uppercase Polish L in ¡âodâz, the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro, the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir, the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª, the plus or minus sign in «54%, the uppercase O-hook in B¬, the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab, the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in K²benhavn, the lowercase d with crossbar in ³avola, the lowercase Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur, the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase u-hook in T½ D½c, the pseudo question mark in càui, the grave accent in tráes, the acute accent in dâesirâee, the circumflex in cãote, the tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek) in écrny, the circle above (angstrom) in êarbok, the ligature first and second halves in dëiìadëiìa, the high comma off center in rozdelíovac, the double acute in idîoszaki, the candrabindu (breve with dot above) in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña, the dot below in teòda, the double dot below in ököhuótbah, the circle below in Saòmskôrta, the double underscore in õGhulam, the left hook in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the upadhmaniya (half circle below) in ùhumantués, double tilde, first and second halves in únûgalan, high comma (centered) in gþeotermika  aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {text}, also included are new extended characters degree sign 98.6À, small script l in 45Á, the phono copyright mark in Â1994, the copyright mark in Ã1955, the musical sharp in concerto in FÄ major, the inverted question mark in ÅQue pasâo?, and the inverted exclamation mark in ÆAy caramba!.  aIncludes Bibliographies, discographies, filmographies, and reviews.  aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.00959nam  2200241 a 4500001001300000003000700013005001700020008004100037020001500078040001900093050002200112100002700134245013100161260005000292300004900342440003200391500011300423504007200536500002000608650002700628600003500655856002700690tes96000007 ViArRB19960221075055.7960221s1955    dcuabcdjdbkoqu001 0dspa d  a8472236579  aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-12aA check of the processing of unrecognized mnemonic strings like &zilch; which might be encountered in the MARCMakr input file.  aWashington, DC :bLibrary of Congress,c1955.  a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 7  aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called (\).  aIncludes Bibliographies, discographies, filmographies, and reviews.  aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.2 aftp.loc.govd\pub\marc00833nam  2200217 a 4500001001300000003000700013005001700020008004100037020001500078020002500093020002500118020003700143040001900180050002200199100002700221245012300248260005000371300004900421440003200470500011300502tes96000008 ViArRB19960221075055.7960221s1955    dcuabcdjdbkoqu001 0dspa d  a8472236579  a0777000008 :c$35.99  a0777000008 :c$35.99  z3777000008 (German ed.):c$46.00  aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-12aA check of the processing of the dollar sign and mnemonic strings used for real dollar signs (associated with prices).  aWashington, DC :bLibrary of Congress,c1955.  a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 8  aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called (\).
\ No newline at end of file

Added: packages/libmarc-perl/branches/upstream/current/t/makrtest.bad
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/makrtest.bad	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/makrtest.bad	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,69 @@
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000001\
+=003  ViArRB
+=005  199602210153555.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0deng\d
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2 $aDeer-Doe, J.$q(Jane),$csaint,$d1355-1401,$cspirit.
+=245  10$aNew test record number 1 with ordinary data$h[large print]
+ /$cby Jane Deer-Doe ; edited by Patty O'Furniture.
+=246  1\$aNew test record number one with ordinary data
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955-<1957>
+=300  \\$av. 1-<5>\:$bill., maps, ports., charts ;$c\cm.
+=440  \0$aTest record series ;$vno. 1
+=500  \\$aThis is a test of ordinary features like replacement of the
+ mnemonics for currency and dollar signs and backslashes (backsolidus {bsol})
+ used for blanks in certain areas.
+=500  \\$aThis is a test for the conversion of curly braces; the opening
+ curly brace ({lcub}) and the closing curly brace ({rcub}).
+=504  \\$aIncludes Bibliographies, discographies, filmographies,
+ and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+=700  1\$aO'Furniture, Patty,$eed.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000007\
+=003  ViArRB
+=005  19960221165955.9
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2 $aDeer-Doe, Jane,$d1957-
+=245  12$aA check of the processing of unrecognized mnemonic strings
+ like {zilch} which might be encountered in the MARCMakr input file.
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
+=440  \0$aTest record series ;$vno. 7
+=500  \\$aThis is a test of mnemonic conversion, like a real
+ backslash or back solidus, as it is sometimes called ({bsol}).
+=504  \\$aIncludes Bibliographies, discographies, filmographies,
+ and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+=856  2\$aftp.loc.gov$d{bsol}pub{bsol}marc
+
+=bad  00000nam\\2200000\a\4500
+=001  tes96000008\
+=003  ViArRB
+=005  19960221195511.9
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=020  \\$a0777000008 :$c{24}35.99
+=020  \\$a0777000008 :$c{curren}35.99
+=020  \\$z3777000008 (German ed.):$c{dollar}46.00
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2 $aDeer-Doe, Jane,$d1957-
+=245  12$aA check of the processing of the dollar sign and mnemonic strings
+ used for real dollar signs (associated with prices).
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
+=440  \0$aTest record series ;$vno. 8
+=500  \\$aThis is a test of mnemonic conversion, like a real
+ backslash or back solidus, as it is sometimes called ({bsol}).
+

Added: packages/libmarc-perl/branches/upstream/current/t/makrtest.src
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/makrtest.src	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/makrtest.src	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,329 @@
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000001\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0deng\d
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2 $aDeer-Doe, J.$q(Jane),$csaint,$d1355-1401,$cspirit.
+=245  10$aNew test record number 1 with ordinary data$h[large print]
+ /$cby Jane Deer-Doe ; edited by Patty O'Furniture.
+=246  1\$aNew test record number one with ordinary data
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955-<1957>
+=300  \\$av. 1-<5>\:$bill., maps, ports., charts ;$c\cm.
+=440  \0$aTest record series ;$vno. 1
+=500  \\$aThis is a test of ordinary features like replacement of the
+ mnemonics for currency and dollar signs and backslashes (backsolidus {bsol})
+ used for blanks in certain areas.
+=500  \\$aThis is a test for the conversion of curly braces; the opening
+ curly brace ({lcub}) and the closing curly brace ({rcub}).
+=504  \\$aIncludes Bibliographies, discographies, filmographies,
+ and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+=700  1\$aO'Furniture, Patty,$eed.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000002\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2 $aDeer-Doe, Jane,$d1957-
+=245  10$aNew test record number 2 with currently defined
+ ANSEL characters (mostly diacritics) input with their real hexadecimal
+ values$h[large print] /$cby Jane Deer-Doe
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
+=440  \0$aTest record series ;$vno. 2
+=500  \\$aThis is a test of diacritics like the uppercase Polish L in ¡âodâz,
+ the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro,
+ the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir,
+ the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot
+ in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª,
+ the plus or minus sign in «54%, the uppercase O-hook in B¬,
+ the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab,
+ the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in
+ K²benhavn, the lowercase d with crossbar in ³avola, the lowercase
+ Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase
+ digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless
+ i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur,
+ the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase
+ u-hook in T½ D½c, the pseudo question mark in càui, the grave accent
+ in tráes, the acute accent in dâesirâee, the circumflex in cãote, the
+ tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot
+ above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek)
+ in écrny, the circle above (angstrom) in êarbok, the ligature first and
+ second halves in dëiìadëiìa, the high comma off center in rozdelíovac,
+ the double acute in idîoszaki, the candrabindu (breve with dot above)
+ in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña,
+ the dot below in teòda, the double dot below in ököhuótbah, the circle
+ below in Saòmskôrta, the double underscore in õGhulam, the left hook
+ in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the
+ upadhmaniya (half circle below) in ùhumantués, double tilde, first and
+ second halves in únûgalan, high comma (centered) in gþeotermika
+=504  \\$aIncludes Bibliographies, discographies, filmographies,
+ and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000003 
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\  dcuabcdjdbkoqu001 0dspa d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050   4$aPQ1234$b.T39 1955
+=100  2 $aDeer-Doe, Jane,$d1957-
+=245  10$aNew test record number 3 with currently defined
+ ANSEL characters (mostly diacritics) input with mnemonic strings
+$h[large print] /$cby Jane Deer-Doe
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300 p. :$bill., maps, ports., charts ;$c cm.
+=440   0$aTest record series ;$vno. 3
+=500  \\$aThis is a test of diacritics like the uppercase
+ Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia
+ O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro,
+ the uppercase Icelandic thorn in {THORN}ann, the uppercase
+ digraph AE in {AElig}gir, the uppercase digraph OE in 
+{OElig}uvres, the soft sign in rech{softsign}, the middle
+ dot in col{middot}lecci{acute}o, the musical flat in F
+{flat}, the patent mark in Frizbee{reg}, the plus or minus
+ sign in {plusmn}54%, the uppercase O-hook in B{Ohorn},
+ the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah,
+ the ayn in {mllhring}arab, the lowercase Polish l in W
+{lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K
+{ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola,
+ the lowercase Icelandic thorn in {thorn}ann, the lowercase
+ digraph ae in v{aelig}re, the lowercase digraph oe in c
+{oelig}ur, the lowercase hardsign in s{hardsign}ezd, the
+ Turkish dotless i in masal{inodot}, the British pound sign
+ in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase
+ o-hook (with pseudo question mark) in S{hooka}{ohorn},
+ the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo
+ question mark in c{hooka}ui, the grave accent in tr{grave}es,
+ the acute accent in d{acute}esir{acute}ee, the circumflex
+ in c{circ}ote, the tilde in ma{tilde}nana, the macron in
+ T{macr}okyo, the breve in russki{breve}i, the dot above
+ in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au,
+ the caron (hachek) in {caron}crny, the circle above (angstrom)
+ in {ring}arbok, the ligature first and second halves in
+ d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center
+ in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki,
+ the candrabindu (breve with dot above) in Ali{candra}iev,
+ the cedilla in {cedil}ca va comme {cedil}ca, the right
+ hook in viet{ogon}a, the dot below in te{dotb}da, the double
+ dot below in {under}k{under}hu{dbldotb}tbah, the circle
+ below in Sa{dotb}msk{ringb}rta, the double underscore in
+ {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa,
+ the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya
+ (half circle below) in {breveb}humantu{caron}s, double
+ tilde, first and second halves in {ldbltil}n{rdbltil}galan,
+ high comma (centered) in g{commaa}eotermika
+=504  \\$aIncludes Bibliographies, discographies, filmographies,
+ and reviews.
+=500  \\$aIncludes index.
+=650   4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000004\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2 $aDeer-Doe, Jane,$d1957-
+=245  10$aNew test record number 4 with newly-defined diacritics
+$h[large print] /$cby Jane Deer-Doe
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
+=440  \0$aTest record series ;$vno. 4
+=500  \\$aThis field tests the 13 new USMARC characters
+ which include the spacing circumflex "^", the spacing underscore
+ in "file_name", the grave "`", the spacing tilde "~", and
+ the opening and closing curly brackets, {lcub}text{rcub},
+ also included are new extended characters degree sign 98.6
+{deg}, small script l in 45{scriptl}, the phono copyright
+ mark in {phono}1994, the copyright mark in {copy}1955,
+ the musical sharp in concerto in F{sharp} major, the inverted
+ question mark in {iquest}Que pas{acute}o?, and the inverted
+ exclamation mark in {iexcl}Ay caramba!.
+=504  \\$aIncludes Bibliographies, discographies, filmographies,
+ and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000005\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2 $aDeer-Doe, Jane,$d1957-
+=245  10$aNew test record number 5 for all diacritics$h[large print]
+ /$cby Jane Deer-Doe
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
+=440  \0$aTest record series ;$vno. 5
+=500  \\$aThis is a test of diacritics like the uppercase Polish L in ¡âodâz,
+ the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro,
+ the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir,
+ the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot
+ in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª,
+ the plus or minus sign in «54%, the uppercase O-hook in B¬,
+ the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab,
+ the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in
+ K²benhavn, the lowercase d with crossbar in ³avola, the lowercase
+ Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase
+ digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless
+ i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur,
+ the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase
+ u-hook in T½ D½c, the pseudo question mark in càui, the grave accent
+ in tráes, the acute accent in dâesirâee, the circumflex in cãote, the
+ tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot
+ above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek)
+ in écrny, the circle above (angstrom) in êarbok, the ligature first and
+ second halves in dëiìadëiìa, the high comma off center in rozdelíovac,
+ the double acute in idîoszaki, the candrabindu (breve with dot above)
+ in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña,
+ the dot below in teòda, the double dot below in ököhuótbah, the circle
+ below in Saòmskôrta, the double underscore in õGhulam, the left hook
+ in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the
+ upadhmaniya (half circle below) in ùhumantués, double tilde, first and
+ second halves in únûgalan, high comma (centered) in gþeotermika
+=500  \\$aThis field tests the 13 new USMARC characters which include the
+ spacing circumflex "^", the spacing underscore in "file_name", the
+ grave "`", the spacing tilde "~", and the opening and closing curly
+ brackets, {lcub}text{rcub}; also included are new extended characters
+ degree sign 98.6À, small script l in 45Á, the phono copyright mark in
+ Á1994, the copyright mark in Â1955, the musical sharp in concerto in
+ FÃ major, the inverted question mark in ÅQue pasâo?, and the inverted
+ exclamation mark in ÆAy caramba!.
+=504  \\$aIncludes Bibliographies, discographies, filmographies,
+ and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000006\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2 $aDeer-Doe, Jane,$d1957-
+=245  12$aA new ultimate test record for diacritics$h[large print]
+ /$cby Jane Deer-Doe
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
+=440  \0$aTest record series ;$vno. 6
+=500  \\$aThis is a test of diacritics like the uppercase
+ Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia
+ O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro,
+ the uppercase Icelandic thorn in {THORN}ann, the uppercase
+ digraph AE in {AElig}gir, the uppercase digraph OE in 
+{OElig}uvres, the soft sign in rech{softsign}, the middle
+ dot in col{middot}lecci{acute}o, the musical flat in F
+{flat}, the patent mark in Frizbee{reg}, the plus or minus
+ sign in {plusmn}54%, the uppercase O-hook in B{Ohorn},
+ the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah,
+ the ayn in {mllhring}arab, the lowercase Polish l in W
+{lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K
+{ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola,
+ the lowercase Icelandic thorn in {thorn}ann, the lowercase
+ digraph ae in v{aelig}re, the lowercase digraph oe in c
+{oelig}ur, the lowercase hardsign in s{hardsign}ezd, the
+ Turkish dotless i in masal{inodot}, the British pound sign
+ in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase
+ o-hook (with pseudo question mark) in S{hooka}{ohorn},
+ the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo
+ question mark in c{hooka}ui, the grave accent in tr{grave}es,
+ the acute accent in d{acute}esir{acute}ee, the circumflex
+ in c{circ}ote, the tilde in ma{tilde}nana, the macron in
+ T{macr}okyo, the breve in russki{breve}i, the dot above
+ in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au,
+ the caron (hachek) in {caron}crny, the circle above (angstrom)
+ in {ring}arbok, the ligature first and second halves in
+ d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center
+ in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki,
+ the candrabindu (breve with dot above) in Ali{candra}iev,
+ the cedilla in {cedil}ca va comme {cedil}ca, the right
+ hook in viet{ogon}a, the dot below in te{dotb}da, the double
+ dot below in {under}k{under}hu{dbldotb}tbah, the circle
+ below in Sa{dotb}msk{ringb}rta, the double underscore in
+ {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa,
+ the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya
+ (half circle below) in {breveb}humantu{caron}s, double
+ tilde, first and second halves in {ldbltil}n{rdbltil}galan,
+ high comma (centered) in g{commaa}eotermika
+=500  \\$aThis field tests the 13 new USMARC characters
+ which include the spacing circumflex "^", the spacing underscore
+ in "file_name", the grave "`", the spacing tilde "~", and
+ the opening and closing curly brackets, {lcub}text{rcub},
+ also included are new extended characters degree sign 98.6
+{deg}, small script l in 45{scriptl}, the phono copyright
+ mark in {phono}1994, the copyright mark in {copy}1955,
+ the musical sharp in concerto in F{sharp} major, the inverted
+ question mark in {iquest}Que pas{acute}o?, and the inverted
+ exclamation mark in {iexcl}Ay caramba!.
+=504  \\$aIncludes Bibliographies, discographies, filmographies,
+ and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000007\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2 $aDeer-Doe, Jane,$d1957-
+=245  12$aA check of the processing of unrecognized mnemonic strings
+ like {zilch} which might be encountered in the MARCMakr input file.
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
+=440  \0$aTest record series ;$vno. 7
+=500  \\$aThis is a test of mnemonic conversion, like a real
+ backslash or back solidus, as it is sometimes called ({bsol}).
+=504  \\$aIncludes Bibliographies, discographies, filmographies,
+ and reviews.
+=500  \\$aIncludes index.
+=650  \4$aTest record$xJuvenile.
+=600  14$aDoe, John,$d1955- $xBiography.
+=856  2\$aftp.loc.gov$d{bsol}pub{bsol}marc
+
+=LDR  00000nam\\2200000\a\4500
+=001  tes96000008\
+=003  ViArRB
+=005  19960221075055.7
+=008  960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
+=020  \\$a8472236579
+=020  \\$a0777000008 :$c{24}35.99
+=020  \\$a0777000008 :$c{curren}35.99
+=020  \\$z3777000008 (German ed.):$c{dollar}46.00
+=040  \\$aViArRB$cViArRB
+=050  \4$aPQ1234$b.T39 1955
+=100  2 $aDeer-Doe, Jane,$d1957-
+=245  12$aA check of the processing of the dollar sign and mnemonic strings
+ used for real dollar signs (associated with prices).
+=260  \\$aWashington, DC :$bLibrary of Congress,$c1955.
+=300  \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
+=440  \0$aTest record series ;$vno. 8
+=500  \\$aThis is a test of mnemonic conversion, like a real
+ backslash or back solidus, as it is sometimes called ({bsol}).
+

Added: packages/libmarc-perl/branches/upstream/current/t/marc.dat
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/marc.dat	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/marc.dat	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1 @@
+00901cam  2200241Ia 45e0001001300000003000600013005001700019008004100036040001800077090002100095049000900116100002900125245019000154260003800344300005400382500002200436500005900458500004000517500005300557510001500610740002200625994001200647ocm01047729 OCoLC19990808143752.0741021s1884    enkaf         000 1 eng d  aKSUcKSUdGZM  aPS1305b.A1 1884  aVODN1 aTwain, Mark,d1835-1910.14aThe adventures of Huckleberry Finn :b(Tom Sawyer's comrade) : scene, the Mississippi Valley : time, forty to fifty years ago /cby Mark Twain (Samuel Clemens) ; with 174 illustrations.  aLondon :bChatto & Windus,c1884.  axvi, 438 p., [1] leaf of plates :bill. ;c20 cm.  aFirst English ed.  aState B; gatherings saddle-stitched with wire staples.  aAdvertisements on p. [1]-32 at end.  aBound in red S cloth; stamped in black and gold.4 aBALc3414.01aHuckleberry Finn.  aE0bVOD01467cmm  2200325Ka 45e0001001300000003000600013005001700019007000700036008004100043040001300084090001500097049000900112245004600121246001800167246003500185246002100220256002500241260004600266538003600312500002500348500006300373506003100436520046600467650004900933650004500982710002201027710001701049856006301066994001201129ocm40139019 OCoLC19990824212014.0cr mnu981020m19989999pau        c        eng d  aVODcVOD  aTR820b.A2  aVODN00aAccuNet/AP photo archiveh[computer file]30aPhoto archive3 aAssociated Press photo archive30aAP photo archive  aComputer image data.  aState College, Pa. :bAccuweather,c1998-  aMode of access: World Wide Web.  aTitle from homepage.  aPublished jointly by Accuweather and The Associated Press.  aSubscription based access.  a"The Photo Archive features state, regional and national photos from North America, as well as ... international photos all available moments after they move on the AP's spot picture system. An average of 800 photos a day feed into the Photo Archive, and remain there for a minimum of one year. Specially trained indexers select the best 200 or so photos each day to save for all time, while the remainder are eliminated from the Photo Archive after 12 months." 0aPhotojournalismxComputer network resources. 0aPhotographsxComputer network resources.2 aAssociated Press.2 aAccuweather.7 uhttp://ap.accuweather.com2httpzConnect to this resource.  aE0bVOD
\ No newline at end of file

Added: packages/libmarc-perl/branches/upstream/current/t/marc4.dat
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/marc4.dat	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/marc4.dat	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1 @@
+00901cam  2200241Ia 45e0001001300000003000600013005001700019008004100036040001800077090002100095049000900116100002900125245019000154260003800344300005400382500002200436500005900458500004000517500005300557510001500610740002200625994001200647ocm01047729 OCoLC19990808143752.0741021s1884    enkaf         000 1 eng d  aKSUcKSUdGZM  aPS1305b.A1 1884  aVODN1 aTwain, Mark,d1835-1910.14aThe adventures of Huckleberry Finn :b(Tom Sawyer's comrade) : scene, the Mississippi Valley : time, forty to fifty years ago /hby Mark Twain (Samuel Clemens) ; with 174 illustrations.  aLondon :bChatto & Windus,c1884.  axvi, 438 p., [1] leaf of plates :bill. ;c20 cm.  aFirst English ed.  aState B; gatherings saddle-stitched with wire staples.  hAdvertisements on p. [1]-32 at end.  aBound in red S cloth; stamped in black and gold.4 aBALc3414.01aHuckleberry Finn.  aE0bVOD01467cmm  2200325Ka 45e0001001300000003000600013005001700019007000700036008004100043040001300084090001500097049000900112245004600121246001800167246003500185246002100220256002500241260004600266538003600312500002500348500006300373506003100436520046600467650004900933650004500982710002201027710001701049856006301066994001201129ocm40139019 OCoLC19990824212014.0cr mnu981020m19989999pau        c        eng d  aVODcVOD  aTR820b.A2  aVODN00aAccuNet/AP photo archiveh[computer file]30aPhoto archive3 aAssociated Press photo archive30aAP photo archive  aComputer image data.  aState College, Pa. :bAccuweather,c1998-  aMode of access: World Wide Web.  aTitle from homepage.  aPublished jointly by Accuweather and The Associated Press.  aSubscription based access.  a"The Photo Archive features state, regional and national photos from North America, as well as ... international photos all available moments after they move on the AP's spot picture system. An average of 800 photos a day feed into the Photo Archive, and remain there for a minimum of one year. Specially trained indexers select the best 200 or so photos each day to save for all time, while the remainder are eliminated from the Photo Archive after 12 months." 0aPhotojournalismxComputer network resources. 0aPhotographsxComputer network resources.2 aAssociated Press.2 aAccuweather.7 uhttp://ap.accuweather.com2httpzConnect to this resource.  aE0bVOD
\ No newline at end of file

Added: packages/libmarc-perl/branches/upstream/current/t/test1.t
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/test1.t	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/test1.t	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,473 @@
+#!/usr/bin/perl -w
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test1.t'
+
+use lib '.','./t';	# for inheritance and Win32 test
+
+######################### We start with some black magic to print on failure.
+
+BEGIN { $| = 1; print "1..187\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use MARC 1.03;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+#
+#Added tests should have an comment matching /# \d/
+#If so, the following will renumber all the tests
+#to match Perl's idea of test:
+#perl -pe 'BEGIN{$i=1};if (/# \d/){ $i++};s/# \d+/# $i/' test1.t > test1.t1
+#
+######################### End of test renumber.
+
+use strict;
+
+my $tc = 2;		# next test number
+
+sub is_ok {
+    my $result = shift;
+    printf (($result ? "" : "not ")."ok %d\n",$tc++);
+    return $result;
+}
+
+sub is_zero {
+    my $result = shift;
+    if (defined $result) {
+        return is_ok ($result == 0);
+    }
+    else {
+        printf ("not ok %d\n",$tc++);
+    }
+}
+
+sub is_bad {
+    my $result = shift;
+    printf (($result ? "not " : "")."ok %d\n",$tc++);
+    return (not $result);
+}
+
+sub filestring {
+    my $file = shift;
+    local $/ = undef;
+    unless (open(YY, $file)) {warn "Can't open file $file: $!\n"; return;}
+    binmode YY;
+    my $yy = <YY>;
+    unless (close YY) {warn "Can't close file $file: $!\n"; return;}
+    return $yy;
+}
+
+my $file = "marc.dat";
+my $file2 = "badmarc.dat";
+my $testdir = "t";
+if (-d $testdir) {
+    $file = "$testdir/$file";
+    $file2 = "$testdir/$file2";
+}
+unless (-e $file) {
+    die "No MARC sample file found\n";
+}
+unless (-e $file2) {
+    die "Missing bad sample file for MARC tests: $file2\n";
+}
+
+my $naptime = 0;	# pause between output pages
+if (@ARGV) {
+    $naptime = shift @ARGV;
+    unless ($naptime =~ /^[0-5]$/) {
+	die "Usage: perl test?.t [ page_delay (0..5) ]";
+    }
+}
+
+my $x;
+unlink 'output.txt', 'output.html', 'output.xml', 'output.isbd',
+       'output.urls', 'output2.html', 'output.mkr';
+
+   # Create the new MARC object. You can use any variable name you like...
+   # Read the MARC file into the MARC object.
+
+unless (is_ok ($x = MARC->new ($file))) {			# 2
+    printf "could not create MARC from $file\n";
+    exit 1;
+    # next test would die at runtime without $x
+}
+
+is_ok (2 == $x->marc_count);					# 3
+
+   #Output the MARC object to an ascii file
+is_ok ($x->output({file=>">output.txt",'format'=>"ASCII"}));	# 4
+
+   #Output the MARC object to an html file
+is_ok ($x->output({file=>">output.html",'format'=>"HTML"}));	# 5
+
+   #Try to output the MARC object to an xml file
+my $quiet = $^W;
+$^W = 0;
+is_bad ($x->output({file=>">output.xml",'format'=>"XML"}));	# 6
+$^W = $quiet;
+
+   #Output the MARC object to an url file
+is_ok ($x->output({file=>">output.urls",'format'=>"URLS"}));	# 7
+
+   #Output the MARC object to an isbd file
+is_ok ($x->output({file=>">output.isbd",'format'=>"ISBD"}));	# 8
+
+   #Output the MARC object to a marcmaker file
+is_ok ($x->output({file=>">output.mkr",'format'=>"marcmaker"}));	# 9
+
+   #Output the MARC object to an html file with titles
+is_ok ($x->output({file=>">output2.html", 
+                   'format'=>"HTML","245"=>"TITLE:"}));		# 10
+
+is_ok (-s 'output.txt');					# 11
+is_ok (-s 'output.html');					# 12
+is_bad (-e 'output.xml');					# 13
+is_ok (-s 'output.urls');					# 14
+
+   #Append the MARC object to an html file with titles
+is_ok ($x->output({file=>">>output2.html",
+                   'format'=>"HTML","245"=>"TITLE:"}));		# 15
+
+   #Append to an html file with titles incrementally
+is_ok ($x->output({file=>">output.html",'format'=>"HTML_START"}));	# 16
+is_ok ($x->output({file=>">>output.html",
+                   'format'=>"HTML_BODY","245"=>"TITLE:"}));		# 17
+is_ok ($x->output({file=>">>output.html",'format'=>"HTML_FOOTER"}));	# 18
+
+my ($y1, $y2, $yy);
+is_ok ($y1 = $x->output({'format'=>"HTML","245"=>"TITLE:"}));	# 19
+$y2 = "$y1$y1";
+is_ok ($yy = filestring ("output2.html"));			# 20
+is_ok ($yy eq $y2);						# 21
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok ($yy = filestring ("output.html"));			# 22
+is_ok ($y1 eq $yy);						# 23
+
+#Simple test of (un)?pack.*
+my $mldr = $x->ldr(1);
+my $rhldr = $x->unpack_ldr(1);
+is_ok('c' eq ${$rhldr}{RecStat});				# 24
+is_ok('a' eq ${$rhldr}{Type});				        # 25
+is_ok('m' eq ${$rhldr}{BLvl});				        # 26
+
+my $rhff  = $x->unpack_008(1);
+is_ok('741021' eq ${$rhff}{Entered});				# 27
+is_ok('s' eq ${$rhff}{DtSt});					# 28
+is_ok('1884' eq ${$rhff}{Date1});				# 29
+
+my ($m000) = $x->getvalue({field=>'000',record=>1});
+my ($m001) = $x->getvalue({field=>'001',record=>1});
+my ($m003) = $x->getvalue({field=>'003',record=>1});
+my ($m005) = $x->getvalue({field=>'005',record=>1});
+my ($m008) = $x->getvalue({field=>'008',record=>1});
+
+is_ok($m000 eq "00901cam  2200241Ia 45e0");			# 30
+is_ok($m001 eq "ocm01047729 ");					# 31
+is_ok($m003 eq "OCoLC");					# 32
+is_ok($m005 eq "19990808143752.0");				# 33
+is_ok($m008 eq "741021s1884    enkaf         000 1 eng d");	# 34
+
+is_ok($x->_pack_ldr($rhldr) eq $m000);				# 35
+is_ok($x->_pack_ldr($rhldr) eq $x->ldr(1));			# 36
+is_ok($x->_pack_008($m000,$rhff) eq $m008);			# 37
+
+$x->pack_ldr(1);
+is_ok($x->ldr(1) eq $mldr);                                     # 38
+$x->pack_008(1);
+my ($cmp008) = $x->getvalue({field=>'008',record=>1});
+is_ok($cmp008 eq $m008);                                        # 39
+
+my ($indi1) = $x->getvalue({field=>'245',record=>1,subfield=>'i1'});
+my ($indi2) = $x->getvalue({field=>'245',record=>1,subfield=>'i2'});
+my ($indi12) = $x->getvalue({field=>'245',record=>1,subfield=>'i12'});
+
+is_ok($indi1 eq "1");						# 40
+is_ok($indi2 eq "4");						# 41
+is_ok($indi12 eq "14");						# 42
+
+my ($m100a) = $x->getvalue({field=>'100',record=>1,subfield=>'a'});
+my ($m100d) = $x->getvalue({field=>'100',record=>1,subfield=>'d'});
+my ($m100e) = $x->getvalue({field=>'100',record=>1,subfield=>'e'});
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok($m100a eq "Twain, Mark,");				# 43
+is_ok($m100d eq "1835-1910.");					# 44
+is_bad(defined $m100e);						# 45
+
+my @ind12 = $x->getvalue({field=>'246',record=>2,subfield=>'i12'});
+is_ok(3 == scalar @ind12);					# 46
+is_ok($ind12[0] eq "30");					# 47
+is_ok($ind12[1] eq "3 ");					# 48
+is_ok($ind12[2] eq "30");					# 49
+
+my @m246a = $x->getvalue({field=>'246',record=>2,subfield=>'a'});
+is_ok(3 == scalar @m246a);					# 50
+is_ok($m246a[0] eq "Photo archive");				# 51
+is_ok($m246a[1] eq "Associated Press photo archive");		# 52
+is_ok($m246a[2] eq "AP photo archive");				# 53
+
+my @records=$x->searchmarc({field=>"245"});
+is_ok(2 == scalar @records);					# 54
+is_ok($records[0] == 1);					# 55
+is_ok($records[1] == 2);					# 56
+
+ at records=$x->searchmarc({field=>"245",subfield=>"a"});
+is_ok(2 == scalar @records);					# 57
+is_ok($records[0] == 1);					# 58
+is_ok($records[1] == 2);					# 59
+
+ at records=$x->searchmarc({field=>"245",subfield=>"b"});
+is_ok(1 == scalar @records);					# 60
+is_ok($records[0] == 1);					# 61
+
+ at records=$x->searchmarc({field=>"245",subfield=>"h"});
+is_ok(1 == scalar @records);					# 62
+is_ok($records[0] == 2);					# 63
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+ at records=$x->searchmarc({field=>"246",subfield=>"a"});
+is_ok(1 == scalar @records);					# 64
+is_ok($records[0] == 2);					# 65
+
+ at records=$x->searchmarc({field=>"245",regex=>"/huckleberry/i"});
+is_ok(1 == scalar @records);					# 66
+is_ok($records[0] == 1);					# 67
+
+ at records=$x->searchmarc({field=>"260",subfield=>"c",regex=>"/19../"});
+is_ok(1 == scalar @records);					# 68
+is_ok($records[0] == 2);					# 69
+
+ at records=$x->searchmarc({field=>"245",notregex=>"/huckleberry/i"});
+is_ok(1 == scalar @records);					# 70
+is_ok($records[0] == 2);					# 71
+
+ at records=$x->searchmarc({field=>"260",subfield=>"c",notregex=>"/19../"});
+is_ok(1 == scalar @records);					# 72
+is_ok($records[0] == 1);					# 73
+
+ at records=$x->searchmarc({field=>"900",subfield=>"c"});
+is_ok(0 == scalar @records);					# 74
+is_bad(defined $records[0]);					# 75
+
+ at records=$x->searchmarc({field=>"999"});
+is_ok(0 == scalar @records);					# 76
+is_bad(defined $records[0]);					# 77
+
+is_ok (-s 'output.isbd');					# 78
+is_ok (-s 'output.mkr');					# 79
+
+my $update246 = {field=>'246',record=>2,ordered=>'y'};
+my @u246 = $x->getupdate($update246);
+is_ok(21 ==  @u246);						# 80
+
+is_ok(1 == $x->searchmarc($update246));				# 81
+is_ok(3 == $x->deletemarc($update246));				# 82
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok($u246[0] eq "i1");					# 83
+is_ok($u246[1] eq "3");						# 84
+is_ok($u246[2] eq "i2");					# 85
+is_ok($u246[3] eq "0");						# 86
+is_ok($u246[4] eq "a");						# 87
+is_ok($u246[5] eq "Photo archive");				# 88
+is_ok($u246[6] eq "\036");					# 89
+
+is_ok($u246[7] eq "i1");					# 90
+is_ok($u246[8] eq "3");						# 91
+is_ok($u246[9] eq "i2");					# 92
+is_ok($u246[10] eq " ");					# 93
+is_ok($u246[11] eq "a");					# 94
+is_ok($u246[12] eq "Associated Press photo archive");		# 95
+is_ok($u246[13] eq "\036");					# 96
+
+is_ok($u246[14] eq "i1");					# 97
+is_ok($u246[15] eq "3");					# 98
+is_ok($u246[16] eq "i2");					# 99
+is_ok($u246[17] eq "0");					# 100
+is_ok($u246[18] eq "a");					# 101
+is_ok($u246[19] eq "AP photo archive");				# 102
+is_ok($u246[20] eq "\036");					# 103
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok ($y1 = $x->output({'format'=>"HTML_HEADER"}));		# 104
+my $header = "Content-type: text/html\015\012\015\012";
+is_ok ($y1 eq $header);						# 105
+
+is_ok ($y1 = $x->output({'format'=>"HTML_START"}));		# 106
+$header = "<html><body>";
+is_ok ($y1 eq $header);						# 107
+
+is_ok ($y1 = $x->output({'format'=>"HTML_START",'title'=>"Testme"}));	# 108
+$header = "<html><head><title>Testme</title></head>\n<body>";
+is_ok ($y1 eq $header);						# 109
+
+is_ok ($y1 = $x->output({'format'=>"HTML_FOOTER"}));		# 110
+$header = "\n</body></html>\n";
+is_ok ($y1 eq $header);						# 111
+
+is_ok(0 == $x->searchmarc($update246));				# 112
+ at records = $x->getupdate($update246);
+is_ok(0 == @records);						# 113
+
+    # prototype setupdate()
+ at records = ();
+foreach $y1 (@u246) {
+    unless ($y1 eq "\036") {
+	push @records, $y1;
+	next;
+    }
+    $x->addfield($update246, @records) || warn "not added\n";
+    @records = ();
+}
+
+ at u246 = $x->getupdate($update246);
+is_ok(21 == @u246);						# 114
+
+is_ok($u246[0] eq "i1");					# 115
+is_ok($u246[1] eq "3");						# 116
+is_ok($u246[2] eq "i2");					# 117
+is_ok($u246[3] eq "0");						# 118
+is_ok($u246[4] eq "a");						# 119
+is_ok($u246[5] eq "Photo archive");				# 120
+is_ok($u246[6] eq "\036");					# 121
+
+is_ok($u246[7] eq "i1");					# 122
+is_ok($u246[8] eq "3");						# 123
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok($u246[9] eq "i2");					# 124
+is_ok($u246[10] eq " ");					# 125
+is_ok($u246[11] eq "a");					# 126
+is_ok($u246[12] eq "Associated Press photo archive");		# 127
+is_ok($u246[13] eq "\036");					# 128
+
+is_ok($u246[14] eq "i1");					# 129
+is_ok($u246[15] eq "3");					# 130
+is_ok($u246[16] eq "i2");					# 131
+is_ok($u246[17] eq "0");					# 132
+is_ok($u246[18] eq "a");					# 133
+
+is_ok($u246[19] eq "AP photo archive");				# 134
+is_ok($u246[20] eq "\036");					# 135
+
+ at records = $x->searchmarc({field=>'900'});
+is_ok(0 == @records);						# 136
+ at records = $x->searchmarc({field=>'999'});
+is_ok(0 == @records);						# 137
+
+is_ok($x->addfield({record=>1, field=>"999", ordered=>"n", 
+                    i1=>"5", i2=>"3", value=>[c=>"wL70",
+		    d=>"AR Clinton PL",f=>"53525"]}));		# 138
+
+is_ok($x->addfield({record=>1, field=>"900", ordered=>"y", 
+                    i1=>"6", i2=>"7", value=>[z=>"part 1",
+		    z=>"part 2",z=>"part 3"]}));		# 139
+
+is_ok($x->addfield({record=>2, field=>"900", ordered=>"y", 
+                    i1=>"9", i2=>"8", value=>[z=>"part 4"]}));	# 140
+
+ at records = $x->searchmarc({field=>'900'});
+is_ok(2 == @records);						# 141
+ at records = $x->searchmarc({field=>'999'});
+is_ok(1 == @records);						# 142
+
+ at records = $x->getupdate({field=>'900',record=>1});
+is_ok(11 == @records);						# 143
+
+is_ok($records[0] eq "i1");					# 144
+is_ok($records[1] eq "6");					# 145
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok($records[2] eq "i2");					# 146
+is_ok($records[3] eq "7");					# 147
+is_ok($records[4] eq "z");					# 148
+is_ok($records[5] eq "part 1");					# 149
+is_ok($records[6] eq "z");					# 150
+is_ok($records[7] eq "part 2");					# 151
+is_ok($records[8] eq "z");					# 152
+is_ok($records[9] eq "part 3");					# 153
+is_ok($records[10] eq "\036");					# 154
+
+ at records = $x->getupdate({field=>'900',record=>2});
+is_ok(7 == @records);						# 155
+
+is_ok($records[0] eq "i1");					# 156
+is_ok($records[1] eq "9");					# 157
+is_ok($records[2] eq "i2");					# 158
+is_ok($records[3] eq "8");					# 159
+is_ok($records[4] eq "z");					# 160
+
+is_ok($records[5] eq "part 4");					# 161
+is_ok($records[6] eq "\036");					# 162
+
+ at records = $x->getupdate({field=>'999',record=>1});
+is_ok(11 == @records);						# 163
+
+is_ok($records[0] eq "i1");					# 164
+is_ok($records[1] eq "5");					# 165
+is_ok($records[2] eq "i2");					# 166
+is_ok($records[3] eq "3");					# 167
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok($records[4] eq "c");					# 168
+is_ok($records[5] eq "wL70");					# 169
+is_ok($records[6] eq "d");					# 170
+is_ok($records[7] eq "AR Clinton PL");				# 171
+is_ok($records[8] eq "f");					# 172
+is_ok($records[9] eq "53525");					# 173
+is_ok($records[10] eq "\036");					# 174
+
+ at records = $x->getupdate({field=>'999',record=>2});
+is_ok(0 == @records);						# 175
+
+ at records = $x->getupdate({field=>'001',record=>2});
+is_ok(2 == @records);						# 176
+is_ok($records[0] eq "ocm40139019 ");				# 177
+is_ok($records[1] eq "\036");					# 178
+
+is_ok(2 == $x->deletemarc());					# 179
+is_zero($x->marc_count);					# 180
+
+$MARC::TEST = 1;
+is_ok('0 but true' eq $x->openmarc({file=>$file2,
+				    'format'=>"usmarc"}));	# 181
+is_ok(-1 == $x->nextmarc(2));					# 182
+is_ok(1 == $x->marc_count);					# 183
+is_bad(defined $x->nextmarc(1));				# 184
+is_ok(1 == $x->nextmarc(2));					# 185
+is_ok(2 == $x->marc_count);					# 186
+is_ok($x->closemarc);						# 187

Added: packages/libmarc-perl/branches/upstream/current/t/test2.t
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/test2.t	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/test2.t	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,241 @@
+#!/usr/bin/perl -w
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test1.t'
+
+use lib '.','./t';	# for inheritance and Win32 test
+
+######################### We start with some black magic to print on failure.
+
+BEGIN { $| = 1; print "1..65\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use MARC 1.04;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+use strict;
+
+my $tc = 2;		# next test number
+
+use strict;
+use File::Compare;
+
+sub out_cmp {
+    my $outfile = shift;
+    my $reffile = shift;
+    if (-s $outfile && -s $reffile) {
+        return is_zero (compare($outfile, $reffile));
+    }
+    printf ("not ok %d\n",$tc++);
+}
+
+sub is_zero {
+    my $result = shift;
+    if (defined $result) {
+        return is_ok ($result == 0);
+    }
+    printf ("not ok %d\n",$tc++);
+}
+
+sub is_ok {
+    my $result = shift;
+    printf (($result ? "" : "not ")."ok %d\n",$tc++);
+    return $result;
+}
+
+sub is_bad {
+    my $result = shift;
+    printf (($result ? "not " : "")."ok %d\n",$tc++);
+    return (not $result);
+}
+
+my $file = "makrbrkr.mrc";
+my $file2 = "brkrtest.ref";
+my $file3 = "makrtest.src";
+my $file4 = "makrtest.bad";
+
+my $testdir = "t";
+if (-d $testdir) {
+    $file = "$testdir/$file";
+    $file2 = "$testdir/$file2";
+    $file3 = "$testdir/$file3";
+    $file4 = "$testdir/$file4";
+}
+unless (-e $file) {
+    die "Missing sample file for MARCMaker tests: $file\n";
+}
+unless (-e $file2) {
+    die "Missing results file for MARCBreaker tests: $file2\n";
+}
+unless (-e $file3) {
+    die "Missing source file for MARCMaker tests: $file3\n";
+}
+unless (-e $file4) {
+    die "Missing bad source file for MARCMaker tests: $file4\n";
+}
+
+my $naptime = 0;	# pause between output pages
+if (@ARGV) {
+    $naptime = shift @ARGV;
+    unless ($naptime =~ /^[0-5]$/) {
+	die "Usage: perl test?.t [ page_delay (0..5) ]";
+    }
+}
+
+my $x;
+unlink 'output.txt', 'output.html', 'output.xml', 'output.isbd',
+       'output.urls', 'output2.bkr', 'output.mkr', 'output.bkr';
+
+   # Create the new MARC object. You can use any variable name you like...
+   # Read the MARC file into the MARC object.
+
+unless (is_ok ($x = MARC->new($file3,"marcmaker"))) {		# 2
+    die "could not create MARC from $file3\n";
+    # next test would die at runtime without $x
+}
+
+$MARC::TEST = 1; # so outputs have known dates for 005
+is_ok (8 == $x->marc_count);					# 3
+
+   #Output the MARC object to a marcmaker file with nolinebreak
+is_ok ($x->output({file=>">output.bkr",'format'=>"marcmaker",
+	nolinebreak=>'y'}));					# 4
+out_cmp ("output.bkr", $file2);					# 5
+
+my $y;
+is_ok ($y = $x->output());					# 6
+
+   #Output the MARC object to an ascii file
+is_ok ($x->output({file=>">output.txt",'format'=>"ASCII"}));	# 7
+
+   #Output the MARC object to a marcmaker file
+is_ok ($x->output({file=>">output2.bkr",'format'=>"marcmaker"}));	# 8
+
+   #Output the MARC object to a marc file
+is_ok ($x->output({file=>">output.mkr",'format'=>"marc"}));	# 9
+
+out_cmp ("output.mkr", $file);					# 10
+
+$MARC::TEST = 0; #minimal impact
+$^W = 0;
+my ($m000) = $x->getvalue({record=>'1',field=>'000'});
+my ($m001) = $x->getvalue({record=>'1',field=>'001'});
+is_ok ($m000 eq "01200nam  2200253 a 4500");			# 11
+is_ok ($m001 eq "tes96000001 ");				# 12
+
+my ($m002) = $x->getvalue({record=>'1',field=>'002'});
+my ($m003) = $x->getvalue({record=>'1',field=>'003'});
+is_bad (defined $m002);						# 13
+is_ok ($m003 eq "ViArRB");					# 14
+
+my ($m004) = $x->getvalue({record=>'1',field=>'004'});
+my ($m005) = $x->getvalue({record=>'1',field=>'005'});
+is_bad (defined $m004);						# 15
+is_ok ($m005 eq "19960221075055.7");				# 16
+
+my ($m006) = $x->getvalue({record=>'1',field=>'006'});
+my ($m007) = $x->getvalue({record=>'1',field=>'007'});
+is_bad (defined $m006);						# 17
+is_bad (defined $m007);						# 18
+
+my ($m008) = $x->getvalue({record=>'1',field=>'008'});
+my ($m009) = $x->getvalue({record=>'1',field=>'009'});
+is_ok ($m008 eq "960221s1955    dcuabcdjdbkoqu001 0deng d");	# 19
+is_bad (defined $m009);						# 20
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+my ($m260a) = $x->getvalue({record=>'8',field=>'260',subfield=>'a'});
+my ($m260b) = $x->getvalue({record=>'8',field=>'260',subfield=>'b'});
+my ($m260c) = $x->getvalue({record=>'8',field=>'260',subfield=>'c'});
+is_ok ($m260a eq "Washington, DC :");				# 21
+is_ok ($m260b eq "Library of Congress,");			# 22
+is_ok ($m260c eq "1955.");					# 23
+
+my @m260 = $x->getvalue({record=>'8',field=>'260'});
+is_ok ($m260[0] eq "Washington, DC : Library of Congress, 1955. ");	# 24
+
+my ($m245i1) = $x->getvalue({record=>'8',field=>'245',subfield=>'i1'});
+my ($m245i2) = $x->getvalue({record=>'8',field=>'245',subfield=>'i2'});
+my ($m245i12) = $x->getvalue({record=>'8',field=>'245',subfield=>'i12'});
+is_ok ($m245i1 eq "1");						# 25
+is_ok ($m245i2 eq "2");						# 26
+is_ok ($m245i12 eq "12");					# 27
+
+is_ok (3 == $x->selectmarc(["1","7-8"]));			# 28
+is_ok (3 == $x->marc_count);					# 29
+
+my @records=$x->searchmarc({field=>"020"});
+is_ok(2 == scalar @records);					# 30
+is_ok($records[0] == 2);					# 31
+is_ok($records[1] == 3);					# 32
+
+ at records=$x->searchmarc({field=>"020",subfield=>"c"});
+is_ok(1 == scalar @records);					# 33
+is_ok($records[0] == 3);					# 34
+
+ at records = $x->getupdate({field=>'020',record=>2});
+is_ok(7 == @records);						# 35
+
+is_ok($records[0] eq "i1");					# 36
+is_ok($records[1] eq " ");					# 37
+is_ok($records[2] eq "i2");					# 38
+is_ok($records[3] eq " ");					# 39
+is_ok($records[4] eq "a");					# 40
+is_ok($records[5] eq "8472236579");				# 41
+is_ok($records[6] eq "\036");					# 42
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok(1 == $x->deletemarc({field=>'020',record=>2}));		# 43
+$records[6] = "c";
+$records[7] = "new data";
+is_ok($x->addfield({field=>'020',record=>2}, @records));	# 44
+
+ at records=$x->searchmarc({field=>"020",subfield=>"c"});
+is_ok(2 == scalar @records);					# 45
+is_ok($records[0] == 2);					# 46
+is_ok($records[1] == 3);					# 47
+
+ at records = $x->getvalue({record=>'2',field=>'020',delimiter=>'|'});
+is_ok(1 == scalar @records);					# 48
+is_ok($records[0] eq "|a8472236579|cnew data");			# 49
+
+is_ok(1 == $x->deletemarc({field=>'020',record=>2,subfield=>'c'}));	# 50
+ at records=$x->searchmarc({field=>"020",subfield=>"c"});
+is_ok(1 == scalar @records);					# 51
+is_ok($records[0] == 3);					# 52
+
+ at records = $x->getvalue({record=>'2',field=>'020',delimiter=>'|'});
+is_ok(1 == scalar @records);					# 53
+is_ok($records[0] eq "|a8472236579");				# 54
+
+is_ok(3 == $x->deletemarc());					# 55
+is_zero($x->marc_count);					# 56
+
+$MARC::TEST = 1;
+is_ok('0 but true' eq $x->openmarc({file=>$file4,
+				    'format'=>"marcmaker"}));	# 57
+is_ok(-2 == $x->nextmarc(4));					# 58
+is_ok(2 == $x->marc_count);					# 59
+is_ok($x->closemarc);						# 60
+is_ok(2 == $x->deletemarc());					# 61
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok(2 == $x->openmarc({file=>$file4, increment=>2,
+			 'format'=>"marcmaker"}));		# 62
+is_bad(defined $x->nextmarc(1));				# 63
+is_ok(2 == $x->marc_count);					# 64
+is_ok($x->closemarc);						# 65

Added: packages/libmarc-perl/branches/upstream/current/t/test3.t
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/test3.t	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/test3.t	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,255 @@
+#!/usr/bin/perl -w
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test1.t'
+
+use lib '.','./t';	# for inheritance and Win32 test
+
+######################### We start with some black magic to print on failure.
+
+BEGIN { $| = 1; print "1..79\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use MARCopt;		# check inheritance & export
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+use strict;
+
+my $tc = 2;		# next test number
+
+sub is_ok {
+    my $result = shift;
+    printf (($result ? "" : "not ")."ok %d\n",$tc++);
+    return $result;
+}
+
+sub is_zero {
+    my $result = shift;
+    if (defined $result) {
+        return is_ok ($result == 0);
+    }
+    else {
+        printf ("not ok %d\n",$tc++);
+    }
+}
+
+sub is_bad {
+    my $result = shift;
+    printf (($result ? "not " : "")."ok %d\n",$tc++);
+    return (not $result);
+}
+
+sub filestring {
+    my $file = shift;
+    local $/ = undef;
+    unless (open(YY, $file)) {warn "Can't open file $file: $!\n"; return;}
+    binmode YY;
+    my $yy = <YY>;
+    unless (close YY) {warn "Can't close file $file: $!\n"; return;}
+    return $yy;
+}
+
+my $file = "marc.dat";
+my $testfile = "t/marc.dat";
+if (-e $testfile) {
+    $file = $testfile;
+}
+unless (-e $file) {
+    die "No MARC sample file found\n";
+}
+
+my $naptime = 0;	# pause between output pages
+if (@ARGV) {
+    $naptime = shift @ARGV;
+    unless ($naptime =~ /^[0-5]$/) {
+	die "Usage: perl test?.t [ page_delay (0..5) ]";
+    }
+}
+
+my $x;
+unlink 'output.txt', 'output.html', 'output.xml', 'output.isbd',
+       'output.urls', 'output2.html', 'output.mkr';
+
+   # Create the new MARCopt object. You can use any variable name you like...
+   # Read the MARC file into the MARCopt object.
+
+unless (is_ok ($x = MARCopt->new ($file))) {			# 2
+    printf "could not create MARCopt from $file\n";
+    exit 1;
+    # next test would die at runtime without $x
+}
+
+is_ok (2 == $x->marc_count);					# 3
+
+   #Output the MARCopt object to an ascii file
+is_ok ($x->output({file=>">output.txt",'format'=>"ASCII"}));	# 4
+
+   #Output the MARCopt object to an html file
+is_ok ($x->output({file=>">output.html",'format'=>"HTML"}));	# 5
+
+   #Try to output the MARCopt object to an xml file
+my $quiet = $^W;
+$^W = 0;
+is_bad ($x->output({file=>">output.xml",'format'=>"XML"}));	# 6
+$^W = $quiet;
+
+   #Output the MARCopt object to an url file
+is_ok ($x->output({file=>">output.urls",'format'=>"URLS"}));	# 7
+
+   #Output the MARCopt object to an isbd file
+is_ok ($x->output({file=>">output.isbd",'format'=>"ISBD"}));	# 8
+
+   #Output the MARCopt object to a marcmaker file
+is_ok ($x->output({file=>">output.mkr",'format'=>"marcmaker"}));	# 9
+
+   #Output the MARCopt object to an html file with titles
+is_ok ($x->output({file=>">output2.html", 
+                   'format'=>"HTML","245"=>"TITLE:"}));		# 10
+
+is_ok (-s 'output.txt');					# 11
+is_ok (-s 'output.html');					# 12
+is_bad (-e 'output.xml');					# 13
+is_ok (-s 'output.urls');					# 14
+
+   #Append the MARCopt object to an html file with titles
+is_ok ($x->output({file=>">>output2.html",
+                   'format'=>"HTML","245"=>"TITLE:"}));		# 15
+
+   #Append to an html file with titles incrementally
+is_ok ($x->output({file=>">output.html",'format'=>"HTML_START"}));	# 16
+is_ok ($x->output({file=>">>output.html",
+                   'format'=>"HTML_BODY","245"=>"TITLE:"}));		# 17
+is_ok ($x->output({file=>">>output.html",'format'=>"HTML_FOOTER"}));	# 18
+
+my ($y1, $y2, $yy);
+is_ok ($y1 = $x->output({'format'=>"HTML","245"=>"TITLE:"}));	# 19
+$y2 = "$y1$y1";
+is_ok ($yy = filestring ("output2.html"));			# 20
+is_ok ($yy eq $y2);						# 21
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok ($yy = filestring ("output.html"));			# 22
+is_ok ($y1 eq $yy);						# 23
+
+#Simple test of (un)?pack.*
+my $rhldr = $x->unpack_ldr(1);
+is_ok('c' eq ${$rhldr}{RecStat});				# 24
+is_ok('a' eq ${$rhldr}{Type});					# 25
+is_ok('m' eq ${$rhldr}{BLvl});				        # 26
+
+my $rhff  = $x->unpack_008(1);
+is_ok('741021' eq ${$rhff}{Entered});				# 27
+is_ok('s' eq ${$rhff}{DtSt});					# 28
+is_ok('1884' eq ${$rhff}{Date1});				# 29
+
+my ($m000) = $x->getvalue({field=>'000',record=>1});
+my ($m001) = $x->getvalue({field=>'001',record=>1});
+my ($m003) = $x->getvalue({field=>'003',record=>1});
+my ($m005) = $x->getvalue({field=>'005',record=>1});
+my ($m008) = $x->getvalue({field=>'008',record=>1});
+
+is_ok($m000 eq "00901cam  2200241Ia 45e0");			# 30
+is_ok($m001 eq "ocm01047729 ");					# 31
+is_ok($m003 eq "OCoLC");					# 32
+is_ok($m005 eq "19990808143752.0");				# 33
+is_ok($m008 eq "741021s1884    enkaf         000 1 eng d");	# 34
+
+is_ok($x->_pack_ldr($rhldr) eq $m000);				# 35
+is_ok($x->_pack_ldr($rhldr) eq $x->ldr(1));			# 36
+is_ok($x->_pack_008($m000,$rhff) eq $m008);			# 37
+
+my ($indi1) = $x->getvalue({field=>'245',record=>1,subfield=>'i1'});
+my ($indi2) = $x->getvalue({field=>'245',record=>1,subfield=>'i2'});
+my ($indi12) = $x->getvalue({field=>'245',record=>1,subfield=>'i12'});
+
+is_ok($indi1 eq "1");						# 38
+is_ok($indi2 eq "4");						# 39
+is_ok($indi12 eq "14");						# 40
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+my ($m100a) = $x->getvalue({field=>'100',record=>1,subfield=>'a'});
+my ($m100d) = $x->getvalue({field=>'100',record=>1,subfield=>'d'});
+my ($m100e) = $x->getvalue({field=>'100',record=>1,subfield=>'e'});
+
+is_ok($m100a eq "Twain, Mark,");				# 41
+is_ok($m100d eq "1835-1910.");					# 42
+is_bad(defined $m100e);						# 43
+
+my @ind12 = $x->getvalue({field=>'246',record=>2,subfield=>'i12'});
+is_ok(3 == scalar @ind12);					# 44
+is_ok($ind12[0] eq "30");					# 45
+is_ok($ind12[1] eq "3 ");					# 46
+is_ok($ind12[2] eq "30");					# 47
+
+my @m246a = $x->getvalue({field=>'246',record=>2,subfield=>'a'});
+is_ok(3 == scalar @m246a);					# 48
+is_ok($m246a[0] eq "Photo archive");				# 49
+is_ok($m246a[1] eq "Associated Press photo archive");		# 50
+is_ok($m246a[2] eq "AP photo archive");				# 51
+
+my @records=$x->searchmarc({field=>"245"});
+is_ok(2 == scalar @records);					# 52
+is_ok($records[0] == 1);					# 53
+is_ok($records[1] == 2);					# 54
+
+ at records=$x->searchmarc({field=>"245",subfield=>"a"});
+is_ok(2 == scalar @records);					# 55
+is_ok($records[0] == 1);					# 56
+is_ok($records[1] == 2);					# 57
+
+ at records=$x->searchmarc({field=>"245",subfield=>"b"});
+is_ok(1 == scalar @records);					# 58
+is_ok($records[0] == 1);					# 59
+
+ at records=$x->searchmarc({field=>"245",subfield=>"h"});
+is_ok(1 == scalar @records);					# 60
+is_ok($records[0] == 2);					# 61
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+ at records=$x->searchmarc({field=>"246",subfield=>"a"});
+is_ok(1 == scalar @records);					# 62
+is_ok($records[0] == 2);					# 63
+
+ at records=$x->searchmarc({field=>"245",regex=>"/huckleberry/i"});
+is_ok(1 == scalar @records);					# 64
+is_ok($records[0] == 1);					# 65
+
+ at records=$x->searchmarc({field=>"260",subfield=>"c",regex=>"/19../"});
+is_ok(1 == scalar @records);					# 66
+is_ok($records[0] == 2);					# 67
+
+ at records=$x->searchmarc({field=>"245",notregex=>"/huckleberry/i"});
+is_ok(1 == scalar @records);					# 68
+is_ok($records[0] == 2);					# 69
+
+ at records=$x->searchmarc({field=>"260",subfield=>"c",notregex=>"/19../"});
+is_ok(1 == scalar @records);					# 70
+is_ok($records[0] == 1);					# 71
+
+ at records=$x->searchmarc({field=>"900",subfield=>"c"});
+is_ok(0 == scalar @records);					# 72
+is_bad(defined $records[0]);					# 73
+
+ at records=$x->searchmarc({field=>"999"});
+is_ok(0 == scalar @records);					# 74
+is_bad(defined $records[0]);					# 75
+
+is_ok (-s 'output.isbd');					# 76
+is_ok (-s 'output.mkr');					# 77
+
+is_ok ($y1 = $x->output({'format'=>"HTML_HEADER"}));		# 78
+is_ok ($y1 eq "Content-type: text/html\015\012\015\012");	# 79

Added: packages/libmarc-perl/branches/upstream/current/t/test4.t
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/test4.t	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/test4.t	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,355 @@
+#!/usr/bin/perl -w
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test1.t'
+
+use lib '.','./t';	# for inheritance and Win32 test
+
+######################### We start with some black magic to print on failure.
+
+BEGIN { $| = 1; print "1..116\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use MARC 1.03;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+#
+#Added tests should have an comment matching /# \d/
+#If so, the following will renumber all the tests
+#to match Perl's idea of test:
+#perl -pi.bak -e 'BEGIN{$i=1};if (/# \d/){ $i++};s/# \d+/# $i/' test4.t
+#
+######################### End of test renumber.
+
+use strict;
+
+my $tc = 2;		# next test number
+my $WCB = 0;
+
+sub is_ok {
+    my $result = shift;
+    printf (($result ? "" : "not ")."ok %d\n",$tc++);
+    return $result;
+}
+
+sub is_zero {
+    my $result = shift;
+    if (defined $result) {
+        return is_ok ($result == 0);
+    }
+    else {
+        printf ("not ok %d\n",$tc++);
+    }
+}
+
+sub is_bad {
+    my $result = shift;
+    printf (($result ? "not " : "")."ok %d\n",$tc++);
+    return (not $result);
+}
+
+sub filestring {
+    my $file = shift;
+    local $/ = undef;
+    unless (open(YY, $file)) {warn "Can't open file $file: $!\n"; return;}
+    binmode YY;
+    my $yy = <YY>;
+    unless (close YY) {warn "Can't close file $file: $!\n"; return;}
+    return $yy;
+}
+
+sub array_eq_str {
+    my ($ra1,$ra2)=@_;
+    my @a1= @$ra1;
+    my @a2= @$ra2;
+    return 0 unless (scalar(@a1) == scalar(@a2));
+    for my $i (0..scalar(@a1)-1) {
+	print "WCB: a1 = $a1[$i]...\n" if $WCB;
+	print "WCB: a2 = $a2[$i]...\n" if $WCB;
+	return 0 unless ($a1[$i] eq $a2[$i]);
+    }
+    return 1;
+}
+sub printarr {
+    my @b=@_;
+    print "(",(join ", ",grep {s/^/'/;s/$/'/} @b),")";
+}
+
+my $file = "marc.dat";
+my $testfile = "t/marc.dat";
+if (-e $testfile) {
+    $file = $testfile;
+}
+unless (-e $file) {
+    die "No MARC sample file found\n";
+}
+
+my $naptime = 0;	# pause between output pages
+if (@ARGV) {
+    $naptime = shift @ARGV;
+    unless ($naptime =~ /^[0-5]$/) {
+	die "Usage: perl test?.t [ page_delay (0..5) ]";
+    }
+}
+
+my $x;
+unlink 'output4.txt','output4.mkr','output4a.txt';
+
+   # Create the new MARC object. You can use any variable name you like...
+   # Read the MARC file into the MARC object.
+
+unless (is_ok ($x = MARC->new ($file))) {			# 2
+    printf "could not create MARC from $file\n";
+    exit 1;
+    # next test would die at runtime without $x
+}
+
+   #Output the MARC object to an ascii file
+is_ok ($x->output({file=>">output4.txt",'format'=>"ASCII"}));	# 3
+
+   #Output the MARC object to a marcmaker file
+is_ok ($x->output({file=>">output4.mkr",'format'=>"marcmaker"}));	# 4
+
+is_ok (-s 'output4.txt');					# 5
+is_ok (-s 'output4.mkr');					# 6
+my @a1 = ('1',2,'b');
+my @a2 = (1,2,'b');
+my @b1 = ('1',2);
+my @b2 = ('1',2,'c');
+is_ok ( array_eq_str(\@a1,\@a2) );                            # 7
+is_bad( array_eq_str(\@a1,\@b1) );                            # 8
+is_bad( array_eq_str(\@a1,\@b2) );                            # 9
+
+
+delete $x->[1]{500};
+
+for (@{$x->[1]{array}}) {
+    $x->add_map(1,$_) if $_->[0] eq '500';
+}
+
+is_ok(${$x->[1]{500}{'a'}[0]} eq 'First English ed.'); # 10
+${$x->[1]{500}{'a'}[0]} ="boo";
+is_ok(${$x->[1]{500}{'a'}[0]} eq 'boo'); # 11
+my @new500=(500,'x','y',a=>"foo",b=>"bar");
+$x->add_map(1,[@new500]);       
+
+is_ok(  array_eq_str($x->[1]{500}{field}[4],\@new500) );                            # 12
+$x->rebuild_map(1,500);       
+my @add008 = ('008',"abcde");
+$x->add_map(1,[@add008]);       
+
+is_ok( array_eq_str($x->[1]{'008'}{field}[1],\@add008) );                            # 13
+#delete $x->[1]{'008'};
+$x->rebuild_map(1,'008');      
+my @m008 = ('008', '741021s1884    enkaf         000 1 eng d'); 
+is_ok( array_eq_str($x->[1]{'008'}{field}[0],\@m008) );                            # 14
+
+is_ok( !defined($x->[1]{'008'}{field}[1]));                                         # 15
+
+my @m5000 = (500, ' ', ' ', a=> 'boo');
+is_ok( array_eq_str($x->[1]{'500'}{field}[0],\@m5000) );                            # 16
+
+my @m5001 = (500, ' ', ' ', a=>'State B; gatherings saddle-stitched with wire staples.');
+is_ok( array_eq_str($x->[1]{'500'}{field}[1],\@m5001) );                            # 17
+
+my @m5002 = (500, ' ', ' ', a=> 'Advertisements on p. [1]-32 at end.');
+is_ok( array_eq_str($x->[1]{'500'}{field}[2],\@m5002) );                            # 18
+
+my @m5003 = (500, ' ', ' ', a=> 'Bound in red S cloth; stamped in black and gold.');
+is_ok( array_eq_str($x->[1]{'500'}{field}[3],\@m5003) );                            # 19
+
+is_ok( $x->deletefirst({field=>'500',record=>1}) );    # 20
+$x->updatefirst({field=>'247',record=>1, rebuild_map =>0},
+		 ('xxx',1," ", a =>"Photo marchive"));
+
+$x->updatefirst({field=>'500',record=>1, rebuild_map =>0},
+		 ('xxx',1," ", a =>"First English Fed."));
+
+is_ok( $x->updatefirst({field=>'500',subfield=>"h",record=>1, rebuild_map =>0},
+		 ('xxx',1," ", a =>"First English Fed.",h=>"foobar,the fed")) );    # 21
+is_ok( $x->updatefirst({field=>'500',subfield=>"k",record=>1, rebuild_map =>0},
+		 ('xxx',1," ", a =>"First English Fed.",k=>"koobar,the fed")) );    # 22
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+## is_ok($m008 eq "741021s1884    enkaf         000 1 eng d");
+
+my ($m100a) = $x->getvalue({field=>'100',record=>1,subfield=>'a'});
+my ($m100d) = $x->getvalue({field=>'100',record=>1,subfield=>'d'});
+my ($m100e) = $x->getvalue({field=>'100',record=>1,subfield=>'e'});
+
+is_ok($m100a eq "Twain, Mark,");				# 23
+is_ok($m100d eq "1835-1910.");					# 24
+is_bad(defined $m100e);						# 25
+
+my @m246a = $x->getvalue({field=>'246',record=>2,subfield=>'a'});
+is_ok(3 == scalar @m246a);					# 26
+is_ok($m246a[0] eq "Photo archive");				# 27
+is_ok($m246a[1] eq "Associated Press photo archive");		# 28
+is_ok($m246a[2] eq "AP photo archive");				# 29
+
+is_ok ($x->output({file=>">output4a.txt",'format'=>"ASCII"}));	# 30
+
+my $update246 = {field=>'246',record=>2,ordered=>'y'};
+my @u246 = $x->getupdate($update246);
+is_ok(21 ==  @u246);						# 31
+
+
+is_ok($u246[0] eq "i1");					# 32
+is_ok($u246[1] eq "3");						# 33
+is_ok($u246[2] eq "i2");					# 34
+is_ok($u246[3] eq "0");						# 35
+is_ok($u246[4] eq "a");						# 36
+is_ok($u246[5] eq "Photo archive");				# 37
+is_ok($u246[6] eq "\036");					# 38
+
+
+is_ok($u246[7] eq "i1");					# 39
+is_ok($u246[8] eq "3");						# 40
+is_ok($u246[9] eq "i2");					# 41
+is_ok($u246[10] eq " ");					# 42
+is_ok($u246[11] eq "a");					# 43
+is_ok($u246[12] eq "Associated Press photo archive");		# 44
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok($u246[13] eq "\036");					# 45
+is_ok($u246[14] eq "i1");					# 46
+is_ok($u246[15] eq "3");					# 47
+is_ok($u246[16] eq "i2");					# 48
+is_ok($u246[17] eq "0");					# 49
+is_ok($u246[18] eq "a");					# 50
+is_ok($u246[19] eq "AP photo archive");				# 51
+is_ok($u246[20] eq "\036");					# 52
+
+is_ok(3 == $x->deletemarc($update246));				# 53
+my @records = ();
+foreach my $y1 (@u246) {
+    unless ($y1 eq "\036") {
+	push @records, $y1;
+	next;
+    }
+    $x->addfield($update246, @records) || warn "not added\n";
+    @records = ();
+}
+
+ at u246 = $x->getupdate($update246);
+is_ok(21 == @u246);						# 54
+
+is_ok($u246[0] eq "i1");					# 55
+is_ok($u246[1] eq "3");						# 56
+is_ok($u246[2] eq "i2");					# 57
+is_ok($u246[3] eq "0");						# 58
+is_ok($u246[4] eq "a");						# 59
+is_ok($u246[5] eq "Photo archive");				# 60
+is_ok($u246[6] eq "\036");					# 61
+
+is_ok($u246[7] eq "i1");					# 62
+is_ok($u246[8] eq "3");						# 63
+is_ok($u246[9] eq "i2");					# 64
+is_ok($u246[10] eq " ");					# 65
+is_ok($u246[11] eq "a");					# 66
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok($u246[12] eq "Associated Press photo archive");		# 67
+is_ok($u246[13] eq "\036");					# 68
+
+is_ok($u246[14] eq "i1");					# 69
+is_ok($u246[15] eq "3");					# 70
+is_ok($u246[16] eq "i2");					# 71
+is_ok($u246[17] eq "0");					# 72
+is_ok($u246[18] eq "a");					# 73
+
+is_ok($u246[19] eq "AP photo archive");				# 74
+is_ok($u246[20] eq "\036");					# 75
+
+
+is_ok($x->addfield({record=>1, field=>"999", ordered=>"n", 
+                    i1=>"5", i2=>"3", value=>[c=>"wL70",
+		    d=>"AR Clinton PL",f=>"53525"]}));		# 76
+
+is_ok($x->addfield({record=>1, field=>"900", ordered=>"y", 
+                    i1=>"6", i2=>"7", value=>[z=>"part 1",
+		    z=>"part 2",z=>"part 3"]}));		# 77
+
+is_ok($x->addfield({record=>2, field=>"900", ordered=>"y", 
+                    i1=>"9", i2=>"8", value=>[z=>"part 4"]}));	# 78
+
+ at records = $x->searchmarc({field=>'900'});
+is_ok(2 == @records);						# 79
+ at records = $x->searchmarc({field=>'999'});
+is_ok(1 == @records);						# 80
+
+ at records = $x->getupdate({field=>'900',record=>1});
+is_ok(11 == @records);						# 81
+
+is_ok($records[0] eq "i1");					# 82
+is_ok($records[1] eq "6");					# 83
+is_ok($records[2] eq "i2");					# 84
+is_ok($records[3] eq "7");					# 85
+is_ok($records[4] eq "z");					# 86
+is_ok($records[5] eq "part 1");					# 87
+is_ok($records[6] eq "z");					# 88
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok($records[7] eq "part 2");					# 89
+is_ok($records[8] eq "z");					# 90
+is_ok($records[9] eq "part 3");					# 91
+is_ok($records[10] eq "\036");					# 92
+
+ at records = $x->getupdate({field=>'900',record=>2});
+is_ok(7 == @records);						# 93
+
+is_ok($records[0] eq "i1");					# 94
+is_ok($records[1] eq "9");					# 95
+is_ok($records[2] eq "i2");					# 96
+is_ok($records[3] eq "8");					# 97
+is_ok($records[4] eq "z");					# 98
+
+is_ok($records[5] eq "part 4");					# 99
+is_ok($records[6] eq "\036");					# 100
+
+ at records = $x->getupdate({field=>'999',record=>1});
+is_ok(11 == @records);						# 101
+
+is_ok($records[0] eq "i1");					# 102
+is_ok($records[1] eq "5");					# 103
+is_ok($records[2] eq "i2");					# 104
+is_ok($records[3] eq "3");					# 105
+is_ok($records[4] eq "c");					# 106
+is_ok($records[5] eq "wL70");					# 107
+is_ok($records[6] eq "d");					# 108
+is_ok($records[7] eq "AR Clinton PL");				# 109
+is_ok($records[8] eq "f");					# 110
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok($records[9] eq "53525");					# 111
+is_ok($records[10] eq "\036");					# 112
+
+ at records = $x->getupdate({field=>'999',record=>2});
+is_ok(0 == @records);						# 113
+
+ at records = $x->getupdate({field=>'001',record=>2});
+is_ok(2 == @records);						# 114
+is_ok($records[0] eq "ocm40139019 ");				# 115
+is_ok($records[1] eq "\036");					# 116
+

Added: packages/libmarc-perl/branches/upstream/current/t/test5.t
===================================================================
--- packages/libmarc-perl/branches/upstream/current/t/test5.t	2006-02-25 20:43:09 UTC (rev 2192)
+++ packages/libmarc-perl/branches/upstream/current/t/test5.t	2006-02-25 20:44:00 UTC (rev 2193)
@@ -0,0 +1,433 @@
+#!/usr/bin/perl -w
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test1.t'
+
+use lib  '.','./t';	# for inheritance and Win32 test
+
+######################### We start with some black magic to print on failure.
+
+BEGIN { $| = 1; print "1..109\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use MARC 1.07;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+#
+#Added tests should have an comment matching /# \d/
+#If so, the following will renumber all the tests
+#to match Perl's idea of test:
+#perl -pi.bak -e 'BEGIN{$i=1};next if /^#/;if (/# \d/){ $i++};s/# \d+/# $i/' test5.t
+#
+######################### End of test renumber.
+
+use strict;
+
+my $tc = 2;		# next test number
+
+sub is_ok {
+    my $result = shift;
+    printf (($result ? "" : "not ")."ok %d\n",$tc++);
+    return $result;
+}
+
+sub is_zero {
+    my $result = shift;
+    if (defined $result) {
+        return is_ok ($result == 0);
+    }
+    else {
+        printf ("not ok %d\n",$tc++);
+    }
+}
+
+sub is_bad {
+    my $result = shift;
+    printf (($result ? "not " : "")."ok %d\n",$tc++);
+    return (not $result);
+}
+
+sub filestring {
+    my $file = shift;
+    local $/ = undef;
+    unless (open(YY, $file)) {warn "Can't open file $file: $!\n"; return;}
+    binmode YY;
+    my $yy = <YY>;
+    unless (close YY) {warn "Can't close file $file: $!\n"; return;}
+    return $yy;
+}
+
+sub array_eq_str {
+    my ($ra1,$ra2)=@_;
+    my @a1= @$ra1;
+    my @a2= @$ra2;
+    return 0 unless (scalar(@a1) == scalar(@a2));
+    for my $i (0..scalar(@a1)-1) {
+	return 0 unless ($a1[$i] eq $a2[$i]);
+    }
+    return 1;
+}
+sub printarr {
+    my @b=@_;
+    print "(",(join ", ",grep {s/^/'/;s/$/'/} @b),")";
+}
+
+my $file = "marc4.dat";
+my $testfile = "t/marc4.dat";
+if (-e $testfile) {
+    $file = $testfile;
+}
+unless (-e $file) {
+    die "No MARC sample file found\n";
+}
+
+my $naptime = 0;	# pause between output pages
+if (@ARGV) {
+    $naptime = shift @ARGV;
+    unless ($naptime =~ /^[0-5]$/) {
+	die "Usage: perl test?.t [ page_delay (0..5) ]";
+    }
+}
+
+my $x;
+unlink 'output4.txt','output4.mkr';
+
+   # Create the new MARC object. You can use any variable name you like...
+   # Read the MARC file into the MARC object.
+
+unless (is_ok ($x = MARC->new ($file))) {			# 2
+    printf "could not create MARC from $file\n";
+    exit 1;
+    # next test would die at runtime without $x
+}
+
+   #Output the MARC object to an ascii file
+is_ok ($x->output({file=>">output4.txt",'format'=>"ASCII"}));	# 3
+
+   #Output the MARC object to a marcmaker file
+is_ok ($x->output({file=>">output4.mkr",'format'=>"marcmaker"}));	# 4
+
+is_ok (-s 'output4.txt');					# 5
+is_ok (-s 'output4.mkr');					# 6
+my @a1 = ('1',2,'b');
+my @a2 = (1,2,'b');
+my @b1 = ('1',2);
+my @b2 = ('1',2,'c');
+is_ok ( array_eq_str(\@a1,\@a2) );                            # 7
+is_bad( array_eq_str(\@a1,\@b1) );                            # 8
+is_bad( array_eq_str(\@a1,\@b2) );                            # 9
+
+# I have found updatefirst/deletefirst functionality very tricky to
+# implement.  And this is the second time I have implemented it. There
+# are several semantics that can go either way.  These tests are
+# intended to cover all semantic choices and data dependencies,
+# providing reasonable evidence that any straightforward
+# implementation is correct.
+
+# Note to implementors. You should maintain a couple of obvious
+# invariants by construction. Don't change any but the current record
+# and don't change any but the current field (and subfield if it
+# exists). Not hard to do, but someone has to say it....  If you need
+# to violate the subfield constraint (possible if you put extra
+# information in the field to reflect workflow) do it in updatehook().
+
+## 9. Tests are for "all significant variations", which we 
+# split by function: deletion or update
+# Given deletion the variations are:
+# da. tag < or > 10,                  (tags 1 090)
+# db. 0,1, or more  matches                 (tags 2 11 3 49 500)
+# dc. subfield spec or not                  (tags 5 245)  
+# dd. indicator or not in the subfield spec (tag > 10)
+# de. last subfield or not                  (tags 3 049)
+# df. match in the first field or not.      (tags 500 subfield c and a)
+
+# Given update the variations are:
+# ua. to be tag < or > 10,                  (tags 1 3 5 8)
+# ub. 0,1, or more  matches                 (tags 2 11 3 49 500)
+# uc. subfield spec or not                  (tags 4   
+# ud. indicator or not in the subfield spec
+# uf. match in the first field or not.      (tags 500 subfield c and a)
+
+# This gives an upper bound of 2*3*2*2*2*2 + 2*3*2*2*2 = 96+48 = 148
+# tests. (There is some collapse possible, so we may get away with
+# (much) less.) (Currently we have 16 deletes and 14 updates. Better...)
+
+
+## 9. What needs to be tested.
+# We must check that only the affected fields and subfields are 
+# touched. Therefore we need to check, e.g. the 008 field when
+# we are munging the 245's. From the structure of current code
+# this is provably correct, but subclasses my override this...
+
+my ($m008) = $x->getvalue({field=>'008',record=>1,delimeter=>"\c_"});
+
+# Deletion.
+#da1.db3 not currently tested. Check with a repeat 006 sometime.
+#da1.db1.dc1
+#da1.db1.dc2
+#da1.db2.dc1
+#da1.db2.dc2
+
+#da2.db1.dc1.dd1
+#da2.db1.dc1.dd2
+#da2.db1.dc2
+
+#da2.db2.dc1.dd1
+#da2.db2.dc1.dd2.de1
+#da2.db2.dc1.dd2.de2
+#da2.db2.dc2
+#da2.db3.dc1.dd1
+#da2.db3.dc1.dd2
+#da2.db3.dc1.dd2.de1
+#da2.db3.dc1.dd2.de2.df1
+#da2.db3.dc1.dd2.de2.df2
+
+# Update.
+#ua1.ub3 not currently tested. Check with a repeat 006 sometime.
+#ua1.ub1.uc1
+#ua1.ub1.uc2
+#ua1.ub2.uc1
+#ua1.ub2.uc2
+
+#ua2.ub1.uc1.ud1
+#ua2.ub1.uc1.ud2
+#ua2.ub1.uc2
+
+#ua2.ub2.uc1.ud1
+#ua2.ub2.uc1.ud2
+#ua2.ub2.uc2
+#ua2.ub3.uc1.ud1
+#ua2.ub3.uc1.ud2.uf1
+#ua2.ub3.uc1.ud2.uf2
+
+my %o=();
+for (qw(001 002 005 049 090 245 247 500)) {
+    my @tmp = $x->getupdate({record=>1,field=>$_});
+    $o{$_}=\@tmp;
+}
+
+my $templc1d1 = {record=>1,field=>245,subfield=>'i1'};
+my $templc1d2 = {record=>1,field=>245,subfield=>'a'};
+my $templc2    = {record=>1,field=>245};
+my $subfieldf1  = 'a';
+my $subfieldf2  = 'c';
+my $fieldf  = 500;
+
+#F u a1.b1.c2    002 a
+my $ftempl = {record=>1,field=>'002'};
+my $templ  = {record=>1,field=>'002'};
+$templ->{subfield}= 'a';
+undef $@;
+eval{$x->updatefirst($templ,('002',"x","y", a =>"zz"));};
+is_ok( $@ =~/Cannot update subfields of control fields/);  # 10
+my @new =$x->getupdate($ftempl);
+my $ranew = \@new;
+
+my ($indi1) = $x->getvalue({field=>'245',record=>1,subfield=>'i1'});
+my ($indi2) = $x->getvalue({field=>'245',record=>1,subfield=>'i2'});
+
+is_ok($indi1 eq "1");						# 11
+is_ok($indi2 eq "4");						# 12
+
+my @m245 = $x->getvalue({field=>'245',record=>1,subfield=>'a',delimiter=>"\c_"});
+my @m247 = $x->getvalue({field=>'245',record=>1,subfield=>'a',delimiter=>"\c_"});
+my @m500 = $x->getvalue({field=>'245',record=>1,subfield=>'a',delimiter=>"\c_"});
+
+$x->updatefirst({field=>'245',record=>1,subfield => 'a'}, ('245','a','b', a=>'foo'));    
+
+($indi1) = $x->getvalue({field=>'245',record=>1,subfield=>'i1'});
+($indi2) = $x->getvalue({field=>'245',record=>1,subfield=>'i2'});
+
+is_ok($indi1 eq "1");						# 13
+is_ok($indi2 eq "4");						# 14
+my ($m245_a) = $x->getvalue({field=>'245',record=>1,subfield=>'a'});
+
+$x->deletefirst({field=>'500',record=>1});    
+$x->updatefirst({field=>'247',record=>1},
+		 (i1=>1,i2=>" ", a =>"Photo marchive"));        
+
+$x->updatefirst({field=>'500',record=>1},
+		 (i1=>1,i2=>" ", a =>"First English Fed."));    
+
+is_ok($m008 eq "741021s1884    enkaf         000 1 eng d");	# 15
+
+
+
+my ($m100a) = $x->getvalue({field=>'100',record=>1,subfield=>'a'});
+my ($m100d) = $x->getvalue({field=>'100',record=>1,subfield=>'d'});
+my ($m100e) = $x->getvalue({field=>'100',record=>1,subfield=>'e'});
+
+is_ok($m100a eq "Twain, Mark,");				# 16
+is_ok($m100d eq "1835-1910.");					# 17
+is_bad(defined $m100e);						# 18
+
+my @m246a = $x->getvalue({field=>'246',record=>2,subfield=>'a'});
+is_ok(3 == scalar @m246a);					# 19
+is_ok($m246a[0] eq "Photo archive");				# 20
+is_ok($m246a[1] eq "Associated Press photo archive");		# 21
+is_ok($m246a[2] eq "AP photo archive");				# 22
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+my $update246 = {field=>'246',record=>2,ordered=>'y'};
+my @u246 = $x->getupdate($update246);
+is_ok(21 ==  @u246);						# 23
+
+
+is_ok($u246[0] eq "i1");					# 24
+is_ok($u246[1] eq "3");						# 25
+is_ok($u246[2] eq "i2");					# 26
+is_ok($u246[3] eq "0");						# 27
+is_ok($u246[4] eq "a");						# 28
+is_ok($u246[5] eq "Photo archive");				# 29
+is_ok($u246[6] eq "\036");					# 30
+
+
+is_ok($u246[7] eq "i1");					# 31
+is_ok($u246[8] eq "3");						# 32
+is_ok($u246[9] eq "i2");					# 33
+is_ok($u246[10] eq " ");					# 34
+is_ok($u246[11] eq "a");					# 35
+is_ok($u246[12] eq "Associated Press photo archive");		# 36
+is_ok($u246[13] eq "\036");					# 37
+
+is_ok($u246[14] eq "i1");					# 38
+is_ok($u246[15] eq "3");					# 39
+is_ok($u246[16] eq "i2");					# 40
+is_ok($u246[17] eq "0");					# 41
+is_ok($u246[18] eq "a");					# 42
+is_ok($u246[19] eq "AP photo archive");				# 43
+is_ok($u246[20] eq "\036");					# 44
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok(3 == $x->deletemarc($update246));				# 45
+my @records = ();
+foreach my $y1 (@u246) {
+    unless ($y1 eq "\036") {
+	push @records, $y1;
+	next;
+    }
+    $x->addfield($update246, @records) || warn "not added\n";
+    @records = ();
+}
+
+ at u246 = $x->getupdate($update246);
+is_ok(21 == @u246);						# 46
+
+is_ok($u246[0] eq "i1");					# 47
+is_ok($u246[1] eq "3");						# 48
+is_ok($u246[2] eq "i2");					# 49
+is_ok($u246[3] eq "0");						# 50
+is_ok($u246[4] eq "a");						# 51
+is_ok($u246[5] eq "Photo archive");				# 52
+is_ok($u246[6] eq "\036");					# 53
+
+is_ok($u246[7] eq "i1");					# 54
+is_ok($u246[8] eq "3");						# 55
+is_ok($u246[9] eq "i2");					# 56
+is_ok($u246[10] eq " ");					# 57
+is_ok($u246[11] eq "a");					# 58
+is_ok($u246[12] eq "Associated Press photo archive");		# 59
+is_ok($u246[13] eq "\036");					# 60
+
+is_ok($u246[14] eq "i1");					# 61
+is_ok($u246[15] eq "3");					# 62
+is_ok($u246[16] eq "i2");					# 63
+is_ok($u246[17] eq "0");					# 64
+is_ok($u246[18] eq "a");					# 65
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok($u246[19] eq "AP photo archive");				# 66
+is_ok($u246[20] eq "\036");					# 67
+
+
+is_ok($x->addfield({record=>1, field=>"999", ordered=>"n", 
+                    i1=>"5", i2=>"3", value=>[c=>"wL70",
+		    d=>"AR Clinton PL",f=>"53525"]}));		# 68
+
+is_ok($x->addfield({record=>1, field=>"900", ordered=>"y", 
+                    i1=>"6", i2=>"7", value=>[z=>"part 1",
+		    z=>"part 2",z=>"part 3"]}));		# 69
+
+is_ok($x->addfield({record=>2, field=>"900", ordered=>"y", 
+                    i1=>"9", i2=>"8", value=>[z=>"part 4"]}));	# 70
+
+ at records = $x->searchmarc({field=>'900'});
+is_ok(2 == @records);						# 71
+ at records = $x->searchmarc({field=>'999'});
+is_ok(1 == @records);						# 72
+
+ at records = $x->getupdate({field=>'900',record=>1});
+is_ok(11 == @records);						# 73
+
+is_ok($records[0] eq "i1");					# 74
+is_ok($records[1] eq "6");					# 75
+is_ok($records[2] eq "i2");					# 76
+is_ok($records[3] eq "7");					# 77
+is_ok($records[4] eq "z");					# 78
+is_ok($records[5] eq "part 1");					# 79
+is_ok($records[6] eq "z");					# 80
+is_ok($records[7] eq "part 2");					# 81
+is_ok($records[8] eq "z");					# 82
+is_ok($records[9] eq "part 3");					# 83
+is_ok($records[10] eq "\036");					# 84
+
+ at records = $x->getupdate({field=>'900',record=>2});
+is_ok(7 == @records);						# 85
+
+is_ok($records[0] eq "i1");					# 86
+is_ok($records[1] eq "9");					# 87
+
+if ($naptime) {
+    print "++++ page break\n";
+    sleep $naptime;
+}
+
+is_ok($records[2] eq "i2");					# 88
+is_ok($records[3] eq "8");					# 89
+is_ok($records[4] eq "z");					# 90
+
+is_ok($records[5] eq "part 4");					# 91
+is_ok($records[6] eq "\036");					# 92
+
+ at records = $x->getupdate({field=>'999',record=>1});
+is_ok(11 == @records);						# 93
+
+is_ok($records[0] eq "i1");					# 94
+is_ok($records[1] eq "5");					# 95
+is_ok($records[2] eq "i2");					# 96
+is_ok($records[3] eq "3");					# 97
+is_ok($records[4] eq "c");					# 98
+is_ok($records[5] eq "wL70");					# 99
+is_ok($records[6] eq "d");					# 100
+is_ok($records[7] eq "AR Clinton PL");				# 101
+is_ok($records[8] eq "f");					# 102
+is_ok($records[9] eq "53525");					# 103
+is_ok($records[10] eq "\036");					# 104
+
+is_ok($MARC::VERSION == $MARC::Rec::VERSION);			# 105
+
+ at records = $x->getupdate({field=>'999',record=>2});
+is_ok(0 == @records);						# 106
+
+ at records = $x->getupdate({field=>'001',record=>2});
+is_ok(2 == @records);						# 107
+is_ok($records[0] eq "ocm40139019 ");				# 108
+is_ok($records[1] eq "\036");					# 109
+my $string_rec = $x->[1]->as_string();
+my $tmp_rec=$x->[0]{proto_rec}->copy_struct();
+$tmp_rec->from_string($string_rec);
+1;# for debug
+




More information about the Pkg-perl-cvs-commits mailing list