Codebase list libmarc-perl / 3de2411
[svn-inject] Installing original source of libmarc-perl Gregor Herrmann 18 years ago
24 changed file(s) with 7647 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
+276
-0
Changes less more
0 0.3 Mon Aug 23 19:39:00 1999
1
2 0.4 Sun Sep 5 13:49:00 1999
3
4 0.5 Sun Sep 5 19:45:00 1999
5
6 0.6 Mon Sep 6 18:17:00 1999
7 - consolidate into single file
8
9 -------------------------------------------------------------
10 Revision history for Perl extension MARC.
11
12 0.01 Tue Sep 7 10:48:10 1999
13 - original version; created by h2xs 1.18
14 - linux command: h2xs -A -X -n MARC
15
16 0.61 Tue Sep 7 12:56:23 CDT 1999
17 - convert version 0.6 into CPAN format (lots of little changes)
18
19 0.62 Fri Sep 10 05:18:00 1999
20 - revised datastructure to hash of tags plus non-tag elements
21 like 'array' which serve as structured views into data
22
23 0.63 Sun Sep 12 20:38:00 1999
24 - permit incremental processing to reduce memory footprint
25
26 0.65 Fri Sep 17 08:07:42 1999
27 - add openmarc,nextmarc,closemarc,deletemarc
28
29 0.7 Sun Sep 21 07:15:00 1999
30 - major upgrade: revise new for incremental reads and tag maps
31 - add selectmarc,searchmarc, createrecord, _joinfield, addfield
32 - add error processing and use Carp
33 - add header/body/footer outputs
34 - revise documentation
35
36 0.71 Wed Sep 22 15:50:31 1999
37 - compute @tags once in _marc2html, fix $outputall detection
38 - add Win32 test and install
39 - t/test1.t uses new output file spec, tests append & $var
40
41 0.72 Fri Sep 24 07:42:00 1999
42 - add getvalue
43 - add doc example: xml_header, xml_body, xml_footer
44 - add doc example: createrecord, addfield
45
46 0.80 Sun Oct 3 17:14:00 1999
47 - add isbd and unimarc
48
49 0.81 Mon Oct 4 22:25:17 CDT 1999
50 - update CPAN doc files: Changes, README, Makefile.PL
51 - add isbd to t/test1.t
52
53 0.82 Wed Oct 6 13:30:22 CDT 1999
54 - Win32 Makefile.PL improvements including automatic html install
55 - Added single quotes to hash keys in MARC.pm and t/test1.t to
56 eliminate nuisance warnings from Perl 5.004.
57
58 0.83 Mon Oct 11 22:22:00 EST 1999
59 - Updated MARC.pm line 108 to store scalar references instead of
60 scalars. This will hopefully cut down on duplication of data in
61 the MARC object.
62 - Also, updated the getvalue(), searchmarc() and addfield() methods to
63 reflect the change in the way subfield data is stored.
64 - Added line 220 to return '0 but true' instead of 0 when no records
65 were read in. This will allow for statements like
66 $x->openmarc("test.mrc") || die;
67
68 0.84 Tue Oct 12 22:07:18 CDT 1999
69 - more Win32 Makefile.PL tweaks after TPJ technical review
70 - add binmode for marc file read/write
71 - unspecified 'increment' defaults to 0
72 - fix repeated subfield in field bug in addfield
73
74 0.85 Wed Oct 13 21:19:00 EST 1999
75 - modified addfield to push scalar references instead of scalars when
76 adding subfield data to the $x->[record]{field}{subfield} data member
77 on line 859.
78 - updated closemarc to return 1, to allow constructs like
79 $x->closemarc() || die;
80
81 0.9 Sun Oct 17 19:48:00 EST 1999
82 - modified deletemarc() to support deleting specified fields and
83 subfields
84 - modified addfield() to support adding fields in tag order
85
86 0.91 Tue Oct 19 18:01:43 CDT 1999
87 - add demo addlocal.pl, microlif.001, and directory eg
88 - closemarc() returns results of close()
89 - filter '\r' and '\cZ' from binary input stream
90 - fix "delete all records" bug
91
92 0.911 Wed Oct 20 21:49:02 CDT 1999 <Birthisel>
93 - add "exists" tests to getvalue()
94 - use scalar $callno in addlocal.pl
95
96 0.92 Sat Oct 23 00:00:00 CDT 1999 <Lane>
97 - initialize loop counter in getvalue() to avoid warnings
98 - add methods for manipulating "000" and "008" fields:
99 unpack_ldr, bib_format, unpack_008
100 - add internal subroutines supporting those methods:
101 _unpack_ldr, _bib_format, _unpack_008,
102 - add internal update subroutines:
103 _pack_ldr, _pack_008
104
105 0.93 Wed Oct 27 21:30:17 CDT 1999 <Birthisel>
106 - deprecate length(), use marc_count() instead
107 - new: bless earlier so _readxxx can use methods
108 - add error checks to file open/close, use binmode
109 - add lineterm for _readmarcmaker and default to DOS
110 - always store header in $record->{'000'} tag position
111 - fix bugs in 'i12' subfield structure
112 - add usmarc_default, ustext_default, MARCMaker charset encode/decode
113 - use createrecord, addfield in _readmarcmaker
114 - fix fieldnotvalue in searchmarc
115 - extensive changes to getvalue to cover '000' tag and indicators
116 - use getvalue in unpack_008
117 - return undef instead of die in _unpack_008
118 - allow lineterm option in output, 'format' defaults to 'marc',
119 lineterm to '\n' except MARCMaker (CRLF)
120 - add nolinebreak option for MARCBreaker output
121 - 'html_header' outputs "Content-type...", 'html_start' does "<body>"
122 - _writemarc also updates '000' size data in structure
123 - warnings off in addfield
124 - update copyright
125 - add test2.t and test3.t plus supporting files: makrbrkr.mrc,
126 brkrtest.ref, makrtest.src
127 - add filestring and out_cmp test utilities, MARCopt.pm stub
128 - add MARCMaker/Breaker, getvalue, and searchmarc tests
129
130 0.94 Thu Oct 28 20:23:57 CDT 1999 <Birthisel>
131 - added numerous "exists" tests for hash queries
132 - add 'title' parameter to html_start
133 - extra error checking: addfield
134 - new getupdate() method
135 - add tests for searchmarc, deletemarc, addfield, getupdate,
136 html_xxx formats
137 - fix test3.t to use MARCopt everywhere
138
139 0.95 Tue Nov 02 20:49:09 CST 1999 <Birthisel>
140 - clean up the Win32 "make clean" implementation in Makefile.PL
141 - add tests for selectmarc
142 - add 'title' option for URLs output
143 - terminate addfield if $subfield_id eq "\036" from getupdate()
144 - pod updates: SYNOPSIS, Option Template, various typos
145 - add updaterecord()
146 - template extensions for deletemarc(), searchmarc(), getvalue()
147 - add eg/fixlocal.pl demo and eq/specials.001
148
149 0.95d Wed Nov 03 17:00:01 EST 1999 <Lane>
150 - Removed FF_ prefix from @LDR_FIELDS. Left package globals for
151 fixed fields and leaders as globals: this should facilitate
152 anybody who wants to subclass for MFHL, community, records.
153 - Added pack_008 and pack_ldr. Added get_hash_008 and
154 get_hash_ldr for future tied interface. Fixed bugs.
155 (FF_ prefixes in hash keys.)
156 - Added and updated docs for the new functions.
157 - Added comment on how to renumber tests.
158 - Added tests of pack_008 and pack_ldr. Fixed some test bugs
159 with FF_ prefixes and non-existent functions.
160
161 0.96 Wed Nov 3 23:04:31 CST 1999 <Birthisel>
162 - fix typos in pod2man and pod2html output
163 - fix test3.t like test1.t
164
165 0.97 Fri Nov 5 17:44:15 CST 1999 <Birthisel>
166 - replace '%$' construct (4 places) which designates pseudo-hash
167 in 5.005 and fails in 5.004. Detected by CPAN-Testers
168 - Add tests for deletemarc() subfield to t/test2.t
169
170 0.98 Fri Nov 12 21:13:39 CST 1999 <Birthisel>
171 - fix addfield reorder bug (new tag > existing)
172 - improved eg/addlocal.pl and added eg/uclocal.pl
173 - moved binmode from _readmarc* to openmarc() and new() to get around
174 unwanted seek on binmode in Win32 5.00402.
175
176 0.99 Sun Nov 14 21:59:00 EST 1999 <Summers>
177 - created MARC::XML subclass to handle MARC<->XML conversions
178 - moved _marc2xml() from MARC.pm into MARC::XML
179
180 0.991 Sun Nov 21 18:49:00 EST 1999 <Summers>
181 - removed MARC::XML specific pod from MARC.pm and added to MARC::XML
182
183 1.00 Mon Nov 22 22:22:32 CST 1999 <Birthisel>
184 - add warnings for unsupported output formats
185 - return undef for output failure, test in place of XML
186
187 1.01 Sun Dec 05 23:14:15 CST 1999 <Birthisel>
188 - add invalid size checks to _readmarc()
189 - add header check to _readmarcmaker()
190 - delete length() method and CORE::length() overrides
191 - add $TEST; replace carp with mycarp
192
193 1.02u Mon Dec 20 06:52:00 EST 1999 <Lane>
194 - added *map* series; supports a data-index view of marc.
195 - added deletefirst and updatefirst to support ties
196 - added getmatch and insertpos to support update or insert
197 of subfields.
198 - added getfields/updatefields for fine-grained access to
199 the {array} structures. Allows "in-place" update of fields.
200 - changed add_fields to use add_map. Lets subclasses have a
201 policy of how they want their indices to look.
202 - changed _readmarc and _readmarcmaker to use add_map. Good
203 for testing.
204 - Added simple tests for *first and *map* series as test4.t
205 More complex and complete tests are in MARC::Tie.
206 - Added docs for *map*, getmatch,*fields*,getmatch and insertpos.
207
208 1.03 Mon Jan 17 15:21:54 CST 2000 <Birthisel>
209 - Use fill char "|" for "none" in eg/addlocal.pl
210 - integrate "102u" changes into CPAN format
211 - fix bug in addfield where add_map not called if ($tag<10)
212
213 1.04 Mon Jan 24 22:31:26 CST 2000 <Birthisel>
214 - oops, had to fix the Win32 5.00402 binmode again (c.f 0.98)
215 - added quotes to 'rebuild_map' used as hash key (5.004 warnings)
216 - add docs for "keys" in hash returned by 'unpack_ldr'
217 - add xml format error messages
218
219 1.05 Sat Jan 29 22:59:03 EST 2000 <Lane>
220 - Removed unnecessary quotes in various potentially tainted variables.
221 - Removed bad references to FF_* in docs.
222 - Updatefields() no longer assumes that fields with the same tag are
223 contiguous (e.g. cjk).
224 - Getfields() no longer assumes that fields with the same tag are
225 contiguous (again, cjk).
226 - Docs updated to reflect the relaxed assumption.
227 - Extensive quoting of keys for a more warning-free experience.
228
229 Sun Jan 30 14:34:02 EST 2000 <Lane>
230 - Created add_005s(), _make_005().
231 - Inserted add_005s into output so now we are correctly datestamped.
232 - Docs added for 005 functionality.
233
234 Mon Jan 31 12:55:52 EST 2000 <Lane>
235 - Fixed $args->{'record'} complaint if $args does not exist.
236 - Now we return "19960221075055.7" when in $TEST mode for 005.
237 - Fixed and updated test2.t and test files makrbrkr.mrc and
238 makrtest.src. (now have all canonical 005's; makrtest had a
239 17 digit time, not 16 in the first record).
240
241 1.06 Sun Feb 27 22:00:00 EST 2000 <Lane>
242 - Added getfirstvalue to avoid dependency on index for Ties.
243 - Added from_string and as_string; mainly for Tie
244 but also has promise for searchmarc. Added option to rebuild map.
245 - Created MARC::Rec and started moving functions to it.
246
247 Thu Mar 9 22:00:00 EST 2000 <Lane>
248 - Finished the bulk of ::Rec-ising.
249 - Normalised {records}-{record} handling and %params creation
250 (_records and _params).
251 - Updated searchmarc and deletemarc to more idiomatic Perl; fixed bugs.
252 (Deletemarc was not updating {$tag}{$field}{subfield} information
253 correctly; it does now since it uses rebuild_map).
254 - Fixed one potential problem in _urls (looked at indicators when it
255 should have only been looking at subfields).
256
257 Sat Mar 11 22:00:00 EST 2000 <Lane>
258 - Checked that a subclass of MARC(:Btrieve) works even in the presence
259 of MARC::Rec dependencies.
260 - Tested Tie::MARC and Tie::MARC::Btrieve against 1.06
261 - Fixed bugs. All tests pass.
262 - Updated Docs to reflect pervasive MARC::Rec presence and (few)
263 additional functions.
264
265 Sun Mar 12 14:39:27 EST 2000 <Lane>
266 - Configured shipping script for MARC.
267 - Fixed numbering in test5.t. All tests pass.
268 - Added option to read from a string for MARC::Rec. (nextmarc())
269
270 1.07 Sun Apr 23 16:41:46 CDT 2000A <Birthisel>
271 - convert all usage to $MARC::TEST, $MARC::DEBUG. Clean up other
272 "use vars" variables only needed in one package. Sync $VERSION.
273 - Perl 5.6.0 warns on "join (//,", use "join (''," instead.
274 - fixes to $naptime and $testfile in t/test5.t
275 - openmarc did not set 'handle' and 'format' for MARC::Rec
+24
-0
MANIFEST less more
0 Changes
1 MANIFEST
2 MARC.pm
3 Makefile.PL
4 README
5 README.txt
6 t/test1.t
7 t/test2.t
8 t/test3.t
9 t/test4.t
10 t/test5.t
11 t/badmarc.dat
12 t/marc.dat
13 t/marc4.dat
14 t/MARCopt.pm
15 t/makrbrkr.mrc
16 t/makrtest.src
17 t/makrtest.bad
18 t/brkrtest.ref
19 eg/uclocal.pl
20 eg/addlocal.pl
21 eg/fixlocal.pl
22 eg/microlif.001
23 eg/specials.001
+4066
-0
MARC.pm less more
0 package MARC;
1
2 use Carp;
3 use strict;
4 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG $TEST);
5
6 $VERSION = '1.07';
7 $MARC::DEBUG = 0;
8 $MARC::TEST = 0;
9
10 require Exporter;
11 require 5.004;
12
13 @ISA = qw(Exporter);
14 @EXPORT= qw();
15 @EXPORT_OK= qw();
16
17 #### Not using these yet
18
19 #### %EXPORT_TAGS = (USTEXT => [qw( marc2ustext )]);
20 #### Exporter::export_ok_tags('USTEXT');
21 #### $EXPORT_TAGS{ALL} = \@EXPORT_OK;
22
23
24 # Preloaded methods go here.
25
26 sub mycarp { # rec
27 Carp::carp (@_) unless $MARC::TEST;
28 }
29
30 ####################################################################
31 # This is the constructor method that creates the MARC object. It #
32 # will call the appropriate read using the file and format #
33 # parameters that are passed. #
34 ####################################################################
35 sub new { # rec
36 my $proto = shift;
37 my $class = ref($proto) || $proto;
38 my $file = shift;
39 my $marc = [];
40 my $totalrecord;
41 $marc->[0]{'increment'}=-1; #store the default increment in the object
42 my $proto_rec;
43 # print STDERR "foo\n";
44 {
45 # We are going to look for related classes in Perl's
46 # symbol table. This is a little tricky.
47 # Shoot me.
48
49 no strict 'refs';
50 # Next, we set up a symbolic reference.
51 my $g = $ {$class.'::Rec::VERSION'}; # space for emacs.
52 # That was a sample of Perl reflection. Yup, what Smalltalk
53 # does with Class and MetaClass, Perl does with strings.
54 # Not much structure, but also not much fuss.
55
56 my $rec_class = $class."::Rec" if $g;
57 # Now we will use the related Rec class if it exists.
58 $rec_class ||= "MARC::Rec";
59
60 $proto_rec = $rec_class->new();
61 }
62
63 $marc->[0]{'proto_rec'}=$proto_rec; # Used for future manipulations.
64 bless ($marc, $class);
65 # bless early so _readxxx can use methods
66 #if file isn't defined then just return the empty MARC object
67 if ($file) {
68 unless (-e $file) {mycarp "File $file doesn't exist"; return}
69 #if the file doesn't exist return an error
70 my $format = shift || "usmarc";
71 # $format defaults to USMARC if undefined
72 open(*file, $file) or mycarp "Open Error: $file, $!";
73 binmode *file;
74 $marc->[0]{'handle'}=\*file;
75 $proto_rec->{'handle'} = $marc->[0]{'handle'};
76 $proto_rec->{'format'} = lc $format;
77 if ($format =~ /usmarc$/io) {
78 $marc->[0]{'format'}='usmarc';
79 $totalrecord = _readmarc($marc);
80 close *file or mycarp "Close Error: $file, $!";
81 }
82 elsif ($format =~ /unimarc$/io) {
83 $marc->[0]{'format'}='unimarc';
84 $totalrecord = _readmarc($marc);
85 close *file or mycarp "Close Error: $file, $!";
86 }
87 elsif ($format =~ /marcmaker$/io) {
88 $marc->[0]{'lineterm'}="\015\012"; # MS-DOS default for MARCMaker
89 $totalrecord = _readmarcmaker($marc);
90 close *file or mycarp "Close Error: $file, $!";
91 }
92 elsif ($format =~ /xml/oi) {
93 mycarp "XML formats are now handled by MARC::XML";
94 return;
95 }
96 else {
97 mycarp "I don't recognize format $format";
98 return;
99 }
100 }
101 print "read in $totalrecord records\n" if $MARC::DEBUG;
102 return $marc;
103 }
104 ####################################################################
105
106 # clone returns a new MARC object with copies of the data.
107 # Admin information remains linked to original.
108
109 ####################################################################
110
111 sub clone {
112 my $marc = shift;
113 my $class = shift || ref $marc;
114 my $ans = $marc->new;
115 bless $ans, $class;
116 $ans->[0] = $marc->[0];
117 foreach my $i (1..$#$marc) {
118 my $rec = $marc->[$i];
119
120 my $newrec = $rec->clone();
121 bless $newrec, $class."::Rec";
122 push @$ans, $newrec;
123 }
124 return $ans;
125 }
126
127 ###################################################################
128 # _readmarc() reads in a MARC file into the $marc object #
129 ###################################################################
130 sub _readmarc { # also rec
131 my $marc = shift;
132 my $handle = $marc->[0]{'handle'};
133 my $proto_rec = $marc->[0]{'proto_rec'};
134 my $increment = $marc->[0]{'increment'}; #pick out increment from the object
135 my $recordcount = 0;
136
137 while ($increment==-1 || $recordcount<$increment) {
138 my ($rec,$status)=$proto_rec->_readmarc();
139 last unless $status;
140 if ($status == -1) {
141 mycarp "Invalid record, size does not match leader";
142 return unless $recordcount; # undef if first
143 return -$recordcount; # if some are valid
144 }
145 if ($status == -2) {
146 mycarp "Invalid record, leader size not numeric";
147 return unless $recordcount; # undef if first
148 return -$recordcount; # if some are valid
149 }
150 push @$marc, $rec;
151 $recordcount++;
152 } #end processing this record
153 return $recordcount;
154 }
155
156 ###################################################################
157 # readmarcmaker() reads a marcmaker file into the MARC object #
158 ###################################################################
159 sub _readmarcmaker { # rec
160 my $marc = shift;
161 my $handle = $marc->[0]{'handle'};
162 my $proto_rec = $marc->[0]{'proto_rec'};
163 my $increment = $marc->[0]{'increment'}; #pick out increment from the object
164 unless (exists $marc->[0]{'makerchar'}) {
165 $marc->[0]{'makerchar'} = usmarc_default(); # hash ref
166 $proto_rec->{'makerchar'} = $marc->[0]{'makerchar'};
167 }
168 my $recordcount = 0;
169
170 while ($increment==-1 or $recordcount<$increment) {
171 my ($rec,$status) = $proto_rec->_readmarcmaker();
172 last unless $status;
173 if ($status == -1) {
174 mycarp 'Invalid record, prefix "=LDR " not found';
175 return unless $recordcount; # undef if first
176 return -$recordcount; # if some are valid
177 }
178 push @$marc, $rec;
179 $recordcount++;
180 } #end reading this record
181 return $recordcount;
182 }
183
184 sub _maker2char { # rec
185 return MARC::Rec::_maker2char(@_);
186 }
187
188 sub usmarc_default { # rec
189 return MARC::Rec::usmarc_default(@_);
190 }
191
192 ####################################################################
193 # marc_count() returns the number of records in a #
194 # particular MARC object #
195 ####################################################################
196 sub marc_count {
197 my $marc=shift;
198 return $#$marc;
199 }
200
201 ####################################################################
202 # openmarc() is a method for reading in a MARC file. It takes #
203 # several parameters: file (name of the marc file) ; format, ie. #
204 # usmarc ; and increment which defines how many records to read in #
205 ####################################################################
206 sub openmarc {
207 my $marc=shift;
208 my $params=shift;
209 my $file=$params->{'file'};
210 if (not(-e $file)) {mycarp "File \"$file\" doesn't exist"; return}
211 $marc->[0]{'format'}=$params->{'format'}; #store format in object
212 my $totalrecord;
213 $marc->[0]{'increment'}=$params->{'increment'} || 0;
214 #store increment in the object, default is 0
215 unless ($marc->[0]{'format'}) {$marc->[0]{'format'}="usmarc"}; #default to usmarc
216 open(*file, $file) or mycarp "Open Error: $file, $!";
217 binmode *file;
218 $marc->[0]{'handle'}=\*file; #store filehandle in object
219 my $proto_rec = $marc->[0]{'proto_rec'};
220 $proto_rec->{'handle'} = $marc->[0]{'handle'};
221 $proto_rec->{'format'} = lc $marc->[0]{'format'};
222 if ($marc->[0]{'format'} =~ /usmarc/oi) {
223 $totalrecord = _readmarc($marc);
224 }
225 elsif ($marc->[0]{'format'} =~ /marcmaker/oi) {
226 if (exists $params->{'charset'}) {
227 $marc->[0]{makerchar} = $params->{'charset'}; # hash ref
228 }
229 else {
230 unless (exists $marc->[0]{'makerchar'}) {
231 $marc->[0]{makerchar} = usmarc_default(); # hash ref
232 }
233 }
234 $marc->[0]{'lineterm'} = $params->{'lineterm'} || "\015\012";
235 $totalrecord = _readmarcmaker($marc);
236 }
237 else {
238 close *file;
239 if ($params->{'format'} =~ /xml/oi) {
240 mycarp "XML formats are now handled by MARC::XML";
241 }
242 else {
243 mycarp "Unrecognized format $marc->[0]{'format'}";
244 }
245 return;
246 }
247 print "read in $totalrecord records\n" if $MARC::DEBUG;
248 if ($totalrecord==0) {$totalrecord="0 but true"}
249 return $totalrecord;
250 }
251
252 ####################################################################
253 # closemarc() will close a file-handle that was opened with #
254 # openmarc() #
255 ####################################################################
256 sub closemarc {
257 my $marc = shift;
258 $marc->[0]{'increment'}=0;
259 if (not($marc->[0]{'handle'})) {
260 mycarp "There isn't a MARC file to close";
261 return;
262 }
263 my $ok = close $marc->[0]{'handle'};
264 $marc->[0]{'handle'}=undef;
265 return $ok;
266 }
267
268 ####################################################################
269 # nextmarc() will read in more records from a file that has #
270 # already been opened with openmarc(). the increment can be #
271 # adjusted if necessary by passing a new value as a parameter. the #
272 # new records will be APPENDED to the MARC object #
273 ####################################################################
274 sub nextmarc {
275 my $marc=shift;
276 my $increment=shift;
277 my $totalrecord;
278 if (not($marc->[0]{'handle'})) {
279 mycarp "There isn't a MARC file open";
280 return;
281 }
282 if ($increment) {$marc->[0]{'increment'}=$increment}
283 if ($marc->[0]{'format'} =~ /usmarc/oi) {
284 $totalrecord = _readmarc($marc);
285 }
286 elsif ($marc->[0]{'format'} =~ /marcmaker/oi) {
287 $totalrecord = _readmarcmaker($marc);
288 }
289 else {return}
290 return $totalrecord;
291 }
292
293 ####################################################################
294
295 # add_map() takes a recnum and a ref to a field in ($tag,
296 # $i1,$i2,a=>"bar",...) or ($tag, $field) formats and will append to
297 # the various indices that we have hanging off that record. It is
298 # intended for use in creating records de novo and as a component for
299 # rebuild_map(). It carefully does not copy subfield values or entire
300 # fields, maintaining some reference relationships. What this means
301 # for indices created with add_map that you can directly edit
302 # subfield values in $marc->[recnum]{array} and the index will adjust
303 # automatically. Vice-versa, if you edit subfield values in
304 # $marc->{recnum}{tag}{subfield_code} the fields in
305 # $marc->[recnum]{array} will adjust. If you change structural
306 # information in the array with such an index, you must rebuild the
307 # part of the index related to the current tag (and possibly the old
308 # tag if you change the tag).
309
310 ####################################################################
311
312 sub add_map { # rec
313 my $marc=shift;
314 my $recnum = shift;
315 my $rafield = shift;
316 $marc->[$recnum]->add_map($rafield);
317 }
318
319 ####################################################################
320
321 # rebuild_map() takes a recnum and a tag and will synchronize the
322 # index with all elements in the [recnum]{array} with that tag.
323
324 ####################################################################
325 sub rebuild_map { # rec
326 my $marc=shift;
327 my $recnum = shift;
328 my $tag = shift;
329 return undef if $tag eq '000'; #currently ldr is different...
330 $marc->[$recnum]->rebuild_map($tag);
331 }
332
333 ####################################################################
334
335 # rebuild_map_all() takes a recnum and will synchronize the
336 # index with all elements in the [recnum]{array}
337
338 ####################################################################
339 sub rebuild_map_all { # rec
340 my $marc=shift;
341 my $recnum = shift;
342 $marc->[$recnum]->rebuild_map_all();
343 }
344
345 ####################################################################
346 # deletemarc() will delete entire records, specific fields, as #
347 # well as specific subfields depending on what parameters are #
348 # passed to it #
349 ####################################################################
350 sub deletemarc {
351 my $marc=shift;
352 my $template=shift;
353
354 my $params = _params($template,@_);
355
356 my @delrecords= _records($marc,$params);
357 my %delrecords= map {$_=>1} @delrecords;
358 #if records parameter not passed set to all records in MARC object
359 my $field=$params->{field};
360 my $subfield=$params->{subfield};
361
362 my $deletecount=0;
363 my @keepers = grep {!$delrecords{$_}} (0..$#$marc);
364
365 #delete entire records
366 if (not($field) and not($subfield)) {
367 my $class = ref $marc;
368 my @newmarc = @$marc[@keepers]; # array slice, look it up.
369 @$marc=@newmarc;
370 bless $marc,$class;
371 return @delrecords;
372 }
373
374 #delete fields and/or subfields. deletefirst takes care of the details.
375 # This may be slow. If so write a loop using deletesubfield, etc.
376
377 foreach my $i (1..$#$marc) {
378 next unless $delrecords{$i};
379 my $rec=$marc->[$i];
380 my @newfields =();
381 while (1) {
382 my $has_subfield = $rec->deletefirst($template);
383 last unless $has_subfield;
384 $deletecount++;
385 }
386 $rec->rebuild_map($field);
387 }
388 return $deletecount;
389 }
390
391 ####################################################################
392 # selectmarc() performs the opposite function of deletemarc(). It #
393 # will select specified elements of a MARC object and return them #
394 # as a MARC object. So if you wanted to select records 1-10 and 15 #
395 # of a MARC object you could say $x=$x->selectmarc(["1-10","15"]); #
396 ####################################################################
397 sub selectmarc {
398 my $marc=shift;
399 my $selarray=shift;
400
401 my @keepers=(0); # so we have admin information.
402 foreach my $selelement (@$selarray) {
403 if ($selelement=~/(\d+)-(\d+)/) {
404 push @keepers,($1..$2);
405 } else {
406 push @keepers, $selelement;
407 }
408 }
409 if (not($selarray)) {@{$selarray}= (1..$#$marc)}
410 my $class = ref $marc;
411 my @newmarc = @$marc[@keepers]; # array slice, look it up.
412 @$marc=@newmarc;
413 bless $marc,$class;
414 return scalar(@keepers) -1; # minus off the $marc->[0]
415 }
416
417 ####################################################################
418 # searchmarc() is method for searching a MARC object for specific #
419 # values. It will return an array which contains the record #
420 # numbers that matched. #
421 ####################################################################
422 sub searchmarc {
423 my $marc=shift;
424 my $template=shift;
425 return unless (ref($template) eq "HASH");
426 my $params = _params($template,@_);
427
428 my $field=$params->{field} || return;
429 my $subfield=$params->{subfield};
430 my $regex=$params->{regex};
431 my $notregex=$params->{notregex};
432 my @results;
433 my $searchtype;
434
435 #determine the type of search
436 if ($field and not($subfield) and not($regex) and not($notregex)) {
437 $searchtype="fieldpresence"}
438 elsif ($field and $subfield and not($regex) and not($notregex)) {
439 $searchtype="subfieldpresence"}
440 elsif ($field and not($subfield) and $regex) {
441 $searchtype="fieldvalue"}
442 elsif ($field and $subfield and $regex) {
443 $searchtype="subfieldvalue"}
444 elsif ($field and not($subfield) and $notregex) {
445 $searchtype="fieldnotvalue"}
446 elsif ($field and $subfield and $notregex) {
447 $searchtype="subfieldnotvalue"}
448
449 #do the search by cycling through each record
450 for (my $i=1; $i<=$#$marc; $i++) {
451
452 my $flag=0;
453 if ($searchtype eq "fieldpresence") {
454 next unless exists $marc->[$i]{$field};
455 push(@results,$i);
456 }
457 elsif ($searchtype eq "subfieldpresence") {
458 next unless exists $marc->[$i]{$field};
459 next unless exists $marc->[$i]{$field}{$subfield};
460 push(@results,$i);
461 }
462 elsif ($searchtype eq "fieldvalue") {
463 next unless exists $marc->[$i]{$field};
464 next unless exists $marc->[$i]{$field}{field};
465 my $x=$marc->[$i]{$field}{field};
466 foreach my $y (@$x) {
467 my $z=_joinfield($y,$field);
468 if (eval qq("$z" =~ $regex)) {$flag=1}
469 }
470 if ($flag) {push (@results,$i)}
471 }
472 elsif ($searchtype eq "subfieldvalue") {
473 next unless exists $marc->[$i]{$field};
474 next unless exists $marc->[$i]{$field}{$subfield};
475 my $x=$marc->[$i]{$field}{$subfield};
476 foreach my $y (@$x) {
477 if (eval qq("$$y" =~ $regex)) {$flag=1}
478 }
479 if ($flag) {push (@results,$i)}
480 }
481 elsif ($searchtype eq "fieldnotvalue" ) {
482 next unless exists $marc->[$i]{$field};
483 next unless exists $marc->[$i]{$field}{field};
484 my $x=$marc->[$i]{$field}{field};
485 if (not($x)) {push(@results,$i); next}
486 foreach my $y (@$x) {
487 my $z=_joinfield($y,$field);
488 if (eval qq("$z" =~ $notregex)) {$flag=1}
489 }
490 if (not($flag)) {push (@results,$i)}
491 }
492 elsif ($searchtype eq "subfieldnotvalue") {
493 next unless exists $marc->[$i]{$field};
494 next unless exists $marc->[$i]{$field}{$subfield};
495 my $x=$marc->[$i]{$field}{$subfield};
496 if (not($x)) {push (@results,$i); next}
497 foreach my $y (@$x) {
498 if (eval qq("$$y" =~ $notregex)) {$flag=1}
499 }
500 if (not($flag)) {push (@results,$i)}
501 }
502 }
503 return @results;
504 }
505
506 ####################################################################
507
508 # getfirstvalue() will return the first value of a field or subfield
509 # or indicator or i12 in a particular record found in the MARC
510 # object. It does not depend on the index being up to date.
511
512 ####################################################################
513 sub getfirstvalue { # rec
514 my $marc= shift;
515 my $template=shift;
516 return unless (ref($template) eq "HASH");
517 my $record = $template->{record};
518 if (not($record)) {mycarp "You must specify a record"; return}
519 if ($record > $#{$marc}) {mycarp "Invalid record specified"; return}
520 my $marcrec = $marc->[$record];
521 return $marcrec->getfirstvalue($template);
522
523 }
524
525 ####################################################################
526 # getvalue() will return the value of a field or subfield in a #
527 # particular record found in the MARC object #
528 ####################################################################
529 sub getvalue { # rec
530 my $marc = shift;
531 my $template=shift;
532 return unless (ref($template) eq "HASH");
533 my $params = _params($template,@_);
534 my $record = $params->{record};
535 if (not($record)) {mycarp "You must specify a record"; return}
536 if ($record > $#{$marc}) {mycarp "Invalid record specified"; return}
537
538 return $marc->[$record]->getvalue($params);
539 }
540
541 ####################################################################
542 #Returns LDR at $record. #
543 ####################################################################
544 sub ldr { # rec
545 my ($self,$record)=@_;
546 return $self->[$record]->ldr();
547 }
548
549
550 ####################################################################
551 #Takes a record number and returns a hash of fields. #
552 #Needed to determine the format (BOOK, VIS, etc) of #
553 #the record. #
554 #Folk also like to know what Ctrl, Desc etc are. #
555 ####################################################################
556 sub unpack_ldr { # rec
557 my ($self,$record) = @_;
558 return $self->[$record]->unpack_ldr();
559 }
560
561
562 sub _unpack_ldr { # rec
563 my ($self,$ldr)=@_;
564 return $self->[0]{proto_rec}->unpack_ldr($ldr);
565 }
566
567
568 ####################################################################
569 #Takes a record number. #
570 #Returns the unpacked ldr as a ref to hash from the ref in $self. #
571 #Does not overwrite hash from ldr. #
572 ####################################################################
573 sub get_hash_ldr { # rec
574 my ($self,$record)=@_;
575 return $self->[$record]->get_hash_ldr();
576 }
577
578 ####################################################################
579 # Takes a record number and updates the corresponding ldr if there
580 # is a hashed form. Returns undef unless there is a hash. Else
581 # returns $ldr.
582 ####################################################################
583 sub pack_ldr { # rec
584 my ($self,$record)=@_;
585 return $self->[$record]->pack_ldr();
586 }
587
588 ####################################################################
589 #Takes a ref to hash version of the LDR and returns a string #
590 # version #
591 ####################################################################
592 sub _pack_ldr { # rec
593 my ($self,$rhldr) = @_;
594 return $self->[0]{proto_rec}->_pack_ldr($rhldr);
595 }
596
597 ####################################################################
598 #Takes a string record number. #
599 #Returns a the format necessary to pack/unpack 008 fields correctly#
600 ####################################################################
601 sub bib_format { # rec
602 my ($self,$record)=@_;
603 return $self->[$record]->bib_format();
604 }
605
606 sub _bib_format { # rec
607 my ($self,$ldr)=@_;
608 return $self->[0]{proto_rec}->_bib_format($ldr);
609 }
610
611 ####################################################################
612 #Takes a record number. #
613 #Returns the unpacked 008 as a ref to hash. Installs ref in $self. #
614 ####################################################################
615 sub unpack_008 { # rec
616 my ($self,$record) = @_;
617 return $self->[$record]->unpack_008();
618 }
619
620 sub _unpack_008 { # rec
621 my ($self,$ff_string,$bib_format) = @_;
622 return $self->[0]{proto_rec}->_unpack_008($ff_string,$bib_format);
623 }
624
625 ####################################################################
626 #Takes a record number. #
627 #Returns the unpacked 008 as a ref to hash from the ref in $self. #
628 #Does not overwrite hash from 008 field. #
629 ####################################################################
630 sub get_hash_008 { # rec
631 my ($self,$record)=@_;
632 return $self->[$record]->get_hash_008();
633 }
634
635 ####################################################################
636 #Takes a record number. Flushes hashes to 008 and ldr. #
637 #Updates the 008 field from an installed fixed field hash.
638 #Returns undef unless there is a hash, else returns the 008 field #
639 ####################################################################
640 sub pack_008 { # rec
641 my ($self,$record) = @_;
642 return $self->[$record]->pack_008();
643 }
644
645 ####################################################################
646 #Takes LDR and ref to hash of unpacked 008 #
647 #Returns string version of 008 *without* newlines. #
648 ####################################################################
649 sub _pack_008 { # rec
650 my ($self,$ldr,$rhff) = @_;
651 return $self->[0]{proto_rec}->_pack_008($ldr,$rhff);
652 }
653
654 ####################################################################
655 # _joinfield() is an internal subroutine for creating a string out #
656 # of an array of subfields. It takes an optional delimiter #
657 # parameter which will print out subfields if defined #
658 ####################################################################
659 sub _joinfield { # rec
660 return MARC::Rec->_joinfield(@_);
661 }
662
663 ####################################################################
664
665 # _make_005 is a function: it returns the time formatted for the 005
666 # field.
667
668 ####################################################################
669 sub _make_005 {
670 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
671 # 1. Official specs for 005 are at
672 # lcweb.loc.gov/marc/bibliographic/ecbdcntr.html
673 # They refer to X3.30 ansi; a copy of that would be of interest.
674 # 2. Checked out some examples for existing practice.
675 $year += 1900;
676 $mon++; #$mon is counted from 1 when talking to humans.
677 return "19960221075055.7" if $MARC::TEST;
678 return sprintf("%0.4d%0.2d%0.2d%0.2d%0.2d%0.2d.0",$year,$mon,$mday,$hour,$min,$sec);
679 }
680
681 ####################################################################
682
683 # add_005s takes a template and adds current 005s to the elements of
684 # $marc mentioned in $template->{records}
685
686 ####################################################################
687 sub add_005s {
688 my $marc=shift;
689 my $args = shift;
690 my @records;
691 @records= (1..$#$marc);
692 if ($args && $args->{'records'} ) {
693 @records =@{$args->{'records'}};
694 }
695
696 my $time = MARC::_make_005() ;
697 foreach my $i (@records) {
698 $marc->[$i]->add_005($time);
699 }
700 }
701
702 ####################################################################
703 # output() will call the appropriate output method using the marc #
704 # object and desired format parameters. #
705 ####################################################################
706 sub output {
707 my $marc=shift;
708 my $args=shift;
709 my $output = "";
710 my $newline = $args->{'lineterm'} || "\n";
711
712 $marc->add_005s($args) if ($args->{'file'} or $args->{'add_005s'});
713
714 unless (exists $args->{'format'}) {
715 # everything to string
716 $args->{'format'} = "marc";
717 $args->{'lineterm'} = $newline;
718 }
719 if ($args->{'format'} =~ /marc$/oi) {
720 $output = _writemarc($marc,$args);
721 }
722 elsif ($args->{'format'} =~ /marcmaker$/oi) {
723 $output = _marcmaker($marc,$args);
724 }
725 elsif ($args->{'format'} =~ /ascii$/oi) {
726 $output = _marc2ascii($marc,$args);
727 }
728 elsif ($args->{'format'} =~ /html$/oi) {
729 $output .= "<html><body>";
730 $output .= _marc2html($marc,$args);
731 $output .="$newline</body></html>$newline";
732 }
733 elsif ($args->{'format'} =~ /html_header$/oi) {
734 $output = "Content-type: text/html\015\012\015\012";
735 }
736 elsif ($args->{'format'} =~ /html_start$/oi) {
737 if ($args->{'title'}) {
738 $output = "<html><head><title>$args->{'title'}</title></head>";
739 $output .= "$newline<body>";
740 }
741 else {
742 $output = "<html><body>";
743 }
744 }
745 elsif ($args->{'format'} =~ /html_body$/oi) {
746 $output =_marc2html($marc,$args);
747 }
748 elsif ($args->{'format'} =~ /html_footer$/oi) {
749 $output = "$newline</body></html>$newline";
750 }
751 elsif ($args->{'format'} =~ /urls$/oi) {
752 my $title = $args->{'title'} || "Untitled URLs";
753 $output .= "<html><head><title>$title</title></head>$newline<body>$newline";
754 $output .= _urls($marc,$args);
755 $output .="</body></html>";
756 }
757 elsif ($args->{'format'} =~ /isbd$/oi) {
758 $output = _isbd($marc,$args);
759 }
760 elsif ($args->{'format'} =~ /xml/oi) {
761 mycarp "XML formats are now handled by MARC::XML" if ($^W);
762 return;
763 }
764 if ($args->{'file'}) {
765 if ($args->{'file'} !~ /^>/) {
766 mycarp "Don't forget to use > or >> with output file name";
767 return;
768 }
769 open (OUT, "$args->{file}") || mycarp "Couldn't open file: $!";
770 #above quote is bad if {file} is tainted. Is probably unecessary.dgl.
771 binmode OUT;
772 print OUT $output;
773 close OUT || mycarp "Couldn't close file: $!";
774 return 1;
775 }
776 #if no filename was specified return the output so it can be grabbed
777 else {
778 return $output;
779 }
780 }
781
782 ####################################################################
783 # _records unpacks it hashref arg or defaults to the entire list
784 ####################################################################
785 sub _records {
786 my ($marc,$args)=@_;
787 my $trecs =[];
788 my @records = ();
789 $trecs= [$args->{record}] if exists($args->{record});
790 $trecs= $args->{records} if $args->{records};
791
792 @records = @$trecs if @$trecs;
793 @records = (1..$#$marc) unless @$trecs;
794
795 return @records;
796 }
797
798 ####################################################################
799
800 # params takes a hashref and does a one level deep copy of it.
801 # It uses the rest of the args to override elements of the hashref.
802 # Returns a hashref so that caller does'nt have to worry about
803 # crypto-context.
804
805 ####################################################################
806
807 sub _params {
808 return MARC::Rec::_params(@_);
809 }
810
811 ####################################################################
812 # _writemarc() takes a MARC object as its input and returns the #
813 # the USMARC equivalent of the object as a string #
814 ####################################################################
815 sub _writemarc { #rec
816 my $marc=shift;
817 my $args=shift;
818 #Read in each individual MARC record in the file
819 my @records = _records($marc,$args);
820
821 my $marcrecord="";
822 foreach my $i (@records) {
823 my $record = $marc->[$i];
824 $marcrecord .= $record->_writemarc($args);
825 }
826 return $marcrecord;
827 }
828
829
830 ####################################################################
831 # _marc2ascii() takes a MARC object as its input and returns the #
832 # ASCII equivalent of the object (field names, indicators, field #
833 # values and line-breaks) #
834 ####################################################################
835 sub _marc2ascii { # rec
836 my $marc=shift;
837 my $args=shift;
838 my @records = _records($marc,$args);
839 $args->{'lineterm'} ||= "\n";
840 my $output = "";
841 for my $i (@records) { #cycle through each record
842 my $record=$marc->[$i];
843 $output .= $record->_marc2ascii($args);
844 }
845 return $output;
846 }
847
848 ####################################################################
849 # _marcmaker() takes a MARC object as its input and converts it #
850 # into MARCMaker format, which is returned as a string #
851 ####################################################################
852 sub _marcmaker { # rec
853 my @output = ();
854 my $marc=shift;
855 my $args=shift;
856 $args->{'proto_rec'} = $marc->[0]{'proto_rec'};
857 my @records = _records($marc,$args);
858
859 local $^W = 0; # no warnings
860 my $breaker = "";
861 for my $i (@records) { #cycle through each record
862 my $record=$marc->[$i];
863 $breaker .= $record->_marcmaker($args);
864 }
865 return $breaker;
866 }
867
868 sub _char2maker { # rec
869 return MARC::Rec::_char2maker(@_);
870 }
871
872 sub ustext_default { # rec
873 return MARC::Rec::ustext_default(@_);
874 }
875
876 ####################################################################
877 # _marc2html takes a MARC object as its input and converts it into #
878 # HTML. It is possible to specify which field you want to output #
879 # as well as field labels to be used instead of the MARC codes. #
880 # The HTML is returned as a string #
881 ####################################################################
882 sub _marc2html {
883 my $marc = shift;
884 my $args = shift;
885 my $newline = $args->{'lineterm'} || "\n";
886
887 my @records = _records($marc,$args);
888 my $output = "";
889 foreach my $i (@records) {
890 my $marcrec=$marc->[$i];
891 $output.= $marcrec->_marc2html($args);
892 }
893 return $output;
894 }
895
896
897 ####################################################################
898 # _urls() takes a MARC object as its input, and then extracts the #
899 # control# (MARC 001) and URLs (MARC 856) and outputs them as #
900 # hypertext links in an HTML page. This could then be used with a #
901 # link checker to determine what URLs are broken. #
902 ####################################################################
903 sub _urls { # rec
904 my $marc = shift;
905 my $args = shift;
906
907 my $output = "";
908 my @records = _records($marc,$args);
909
910 local $^W = 0; # no warnings
911 foreach my $i (@records) {
912 my $marcrec=$marc->[$i];
913 $output .= $marcrec->_urls($args);
914 }
915 return $output;
916 }
917
918 ####################################################################
919 # isbd() attempts to create a quasi ISBD output format #
920 ####################################################################
921 sub _isbd { # rec
922 my $marc=shift;
923 my $args=shift;
924 my $newline = $args->{'lineterm'} || "\n";
925 my @records = _records($marc,$args);
926 my $output ="";
927 for my $i (@records) { #cycle through each record
928 my $record=$marc->[$i];
929 $output .= $record->_isbd($args);
930 }
931 return $output;
932 }
933
934 ####################################################################
935 # createrecord() appends a new record to the MARC object #
936 # and initializes the '000' field #
937 ####################################################################
938 sub createrecord { # rec
939 my $marc=shift;
940 local $^W = 0; # no warnings
941 my $params=shift;
942 my $leader=$params->{'leader'} || "00000nam 2200000 a 4500";
943 #default leader see MARC documentation http://lcweb.loc.gov/marc
944 my $number=$#$marc + 1;
945 my $marcrec = $marc->[0]{'proto_rec'}->createrecord($leader);
946 push @$marc, $marcrec;
947 return $number;
948 }
949
950 ####################################################################
951 # addfield() appends/inserts a new field into an existing record #
952 ####################################################################
953
954 sub addfield {
955 my $marc=shift;
956 my $params=shift;
957 local $^W = 0; # no warnings
958 my $record=$params->{'record'};
959 unless ($record) {mycarp "You must specify a record"; return}
960 if ($record > $#{$marc}) {mycarp "Invalid record specified"; return}
961 my $field = $params->{'field'};
962 unless ($field) {mycarp "You must specify a field"; return}
963 unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return}
964
965 my $i1=$params->{'i1'};
966 $i1 = ' ' unless (defined $i1);
967 my $i2=$params->{'i2'};
968 $i2 = ' ' unless (defined $i2);
969 my @value=$params->{'value'} || @_;
970 if (ref($params->{'value'}) eq "ARRAY") { @value = @{$params->{'value'}}; }
971 unless (defined $value[0]) {mycarp "No value specified"; return}
972
973 if ($field >= 10) {
974 if ($value[0] eq 'i1') {
975 shift @value;
976 $i1 = shift @value;
977 }
978 unless (1 == length($i1)) {
979 mycarp "invalid \'i1\' specified";
980 return;
981 }
982 if ($value[0] eq 'i2') {
983 shift @value;
984 $i2 = shift @value;
985 }
986 unless (1 == length($i2)) {
987 mycarp "invalid \'i2\' specified";
988 return;
989 }
990 }
991
992 my $ordered=$params->{'ordered'} || "y";
993 my $insertorder = $#{$marc->[$record]{array}} + 1;
994 #if necessary figure out the insert order to preserve tag order
995 if ($ordered=~/y/i) {
996 for (my $i=0; $i<=$#{$marc->[$record]{array}}; $i++) {
997 if ($marc->[$record]{array}[$i][0] > $field) {
998 $insertorder=$i;
999 last;
1000 }
1001 if ($insertorder==0) {$insertorder=1}
1002 }
1003 }
1004 my @field;
1005 if ($field<10) {
1006 push (@field, $field, $value[0]);
1007 if ($ordered=~/y/i) {
1008 splice @{$marc->[$record]{array}},$insertorder,0,\@field;
1009 }
1010 else {
1011 push (@{$marc->[$record]{array}},\@field);
1012 }
1013 }
1014 else {
1015 push (@field, $field, $i1, $i2);
1016 my ($sub_id, $subfield);
1017 while ($sub_id = shift @value) {
1018 last if ($sub_id eq "\036");
1019 $subfield = shift @value;
1020 push (@field, $sub_id, $subfield);
1021 }
1022 if ($ordered=~/y/i) {
1023 splice @{$marc->[$record]{array}},$insertorder,0,\@field;
1024 }
1025 else {
1026 push (@{$marc->[$record]{array}},\@field);
1027 }
1028 }
1029 $marc->add_map($record,\@field);
1030 }
1031
1032 ####################################################################
1033
1034 # getfields() takes a template and returns an array of fieldrefs from
1035 # $marc->[$recnum]{'array'} including all with the appropriate tag
1036 # and having the property that they are a contiguous group. (So may
1037 # include fields with other tags.)
1038
1039 ####################################################################
1040 sub getfields { # rec
1041 my $marc=shift;
1042 my $params=shift;
1043 my $record=$params->{'record'};
1044 unless ($record) {mycarp "You must specify a record"; return}
1045 if ($record > $#{$marc}) {mycarp "Invalid record specified"; return}
1046 return $marc->[$record]->getfields($params);
1047
1048 }
1049
1050 ####################################################################
1051 # getupdate() returns an array of key,value pairs formatted to #
1052 # pass to addfield(). For repeated tags, a "\036" element is used #
1053 # to delimit data for separate addfield() commands #
1054 ####################################################################
1055 sub getupdate {
1056 my @output;
1057 my $marc=shift;
1058 my $params=shift;
1059 my $record=$params->{'record'};
1060 unless ($record) {mycarp "You must specify a record"; return}
1061 if ($record > $#{$marc}) {mycarp "Invalid record specified"; return}
1062 my $field = $params->{'field'};
1063 unless ($field) {mycarp "You must specify a field"; return}
1064 unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return}
1065
1066 foreach my $fields (@{$marc->[$record]{array}}) { #cycle each field
1067 next unless ($field eq $fields->[0]);
1068 if ($field<10) {
1069 push @output,$fields->[1];
1070 }
1071 else {
1072 push @output,'i1',$fields->[1],'i2',$fields->[2];
1073 my @subfields = @{$fields}[3..$#{$fields}];
1074 while (@subfields) { #cycle through subfields incl. refs
1075 my $subfield = shift @subfields;
1076 last unless defined $subfield;
1077 if (ref($subfield) eq "ARRAY") {
1078 foreach my $subsub (@{$subfield}) {
1079 push @output, $subsub;
1080 }
1081 }
1082 else {
1083 push @output, $subfield;
1084 }
1085 } #finish cycling through subfields
1086 } #finish tag test < 10
1087 push @output,"\036";
1088 }
1089 return @output;
1090 }
1091 ####################################################################
1092
1093 # deletefirst() takes a template and a boolean $do_rebuild_map to
1094 # rebuild the map. It deletes the field data for a first match, using
1095 # the template and leaves the rest alone. If the template has a
1096 # subfield element it deletes based on the subfield information in the
1097 # template. If the last subfield of a field is deleted, deletefirst()
1098 # also deletes the field. It complains about attempts to delete
1099 # indicators. If there is no match, it does nothing. Deletefirst also
1100 # rebuilds the map if $do_rebuild_map. Deletefirst returns the number
1101 # of matches deleted (that would be 0 or 1), or undef if it feels
1102 # grumpy (i.e. carps).
1103
1104 ####################################################################
1105
1106 sub deletefirst { # rec
1107 my $marc = shift || return;
1108 my $template = shift;
1109 my $recnum = $template->{'record'};
1110 if (!$recnum) {mycarp "Need a record to confine my destructive tendencies"; return undef}
1111 return $marc->[$recnum]->deletefirst($template);
1112 }
1113
1114 ####################################################################
1115
1116 # field_is_empty takes a ref to an array formatted like
1117 # an element of $marc->[$recnum]{array}. It returns 1 if there are
1118 # no "significant" elements of the array (e.g. nothing but indicators
1119 # if $tag>10), else 0. Override this if you want to delete fields
1120 # that have "insignificant" subfields inside deletefirst.
1121
1122 ####################################################################
1123 sub field_is_empty { # rec
1124 my ($marc,$rfield) = @_;
1125 return $marc->[0]{proto_rec}->field_is_empty($rfield);
1126 }
1127
1128 ####################################################################
1129
1130 # field_updatehook takes a ref to an array formatted like
1131 # $marc->[$recnum]{'array'}. It is there so that
1132 # subclasses can override it to do something before calling
1133 # addfield(), e.g. store field-specific information in the affected
1134 # field or log information in an external file/database. One notes that
1135 # since this is a method, it can ignore its arguments and log global
1136 # information about $marc, e.g. order information in $marc->[$rnum]{'array'}
1137
1138 ####################################################################
1139
1140 sub field_updatehook { # rec
1141 my ($marc,$rfield)=@_;
1142 $marc->[0]{'proto_rec'}->field_updatehook($rfield);
1143 }
1144
1145 ####################################################################
1146
1147 # updatefirst() takes a template, a request to rebuild the index, and
1148 # an array from $marc->[recnum]{array}. It replaces/creates the field
1149 # data for a first match, using the template, and leaves the rest
1150 # alone. If the template has a subfield element, (this includes
1151 # indicators) it ignores all other information in the array and only
1152 # updates/creates based on the subfield information in the array. If
1153 # the template has no subfield information then indicators are left
1154 # untouched unless a new field needs to be created, in which case they
1155 # are left blank.
1156
1157 ####################################################################
1158
1159 sub updatefirst { # rec
1160 my $marc = shift || return;
1161 my $template = shift;
1162 return unless (ref($template) eq "HASH");
1163 return unless (@_);
1164 return if (defined $template->{'value'});
1165
1166 my $recnum = $template->{'record'};
1167 if (!$recnum) {mycarp "Need a record to confine my changing needs."; return undef}
1168 return $marc->[$recnum]->updatefirst($template,@_);
1169 }
1170
1171 ####################################################################
1172
1173 # updatefields() takes a template which specifies recnum, a
1174 # $do_rebuild_map and a field (needs the field in case $rafields->[0]
1175 # is empty). It also takes a ref to an array of fieldrefs formatted
1176 # like the output of getfields(), and replaces/creates the field
1177 # data. It assumes that it should remove the fields with the first tag
1178 # in the fieldrefs. It calls rebuild_map() if $do_rebuild_map.
1179
1180 ####################################################################
1181 sub updatefields { # rec
1182 my $marc = shift || return;
1183 my $template = shift;
1184
1185 my $rafieldrefs = shift;
1186 my $recnum = $template->{'record'};
1187 return $marc->[$recnum]->updatefields($template,$rafieldrefs);
1188 }
1189
1190 ####################################################################
1191
1192 # getmatch() takes a subfield code (can be an indicator) and a fieldref
1193 # Returns 0 or a ref to the value to be updated.
1194
1195 ####################################################################
1196 sub getmatch { # rec
1197 my $marc = shift || return;
1198 return $marc->[0]{proto_rec}->getmatch(@_);
1199 }
1200
1201 ####################################################################
1202
1203 # deletesubfield() takes a subfield code (can not be an indicator) and a
1204 # fieldref. Deletes the subfield code and its value in the fieldref at
1205 # the first match on subfield code. Assumes there is an exact
1206 # subfield match in $fieldref.
1207
1208 ####################################################################
1209 sub deletesubfield { # rec
1210 my $marc = shift || return;
1211 return $marc->[0]{proto_rec}->deletesubfield(@_);
1212 }
1213
1214 ####################################################################
1215
1216 # insertpos() takes a subfield code (can not be an indicator), a
1217 # value, and a fieldref. Updates the fieldref with the first
1218 # place that the fieldref can match. Assumes there is no exact
1219 # subfield match in $fieldref.
1220
1221 ####################################################################
1222 sub insertpos { # rec
1223 my $marc = shift || return;
1224 return $marc->[0]{proto_rec}->insertpos(@_);
1225 }
1226
1227
1228 ####################################################################
1229 # updaterecord() takes an array of key/value pairs, formatted like #
1230 # the output of getupdate(), and replaces/creates the field data. #
1231 # For repeated tags, a "\036" element is used to delimit data into #
1232 # separate addfield() commands. #
1233 ####################################################################
1234 sub updaterecord {
1235 my $marc = shift || return;
1236 my $template = shift;
1237 return unless (ref($template) eq "HASH");
1238 return unless (@_);
1239 return if (defined $template->{'value'});
1240 my $count = 0;
1241 my @records = ();
1242 unless ($marc->deletemarc($template)) {mycarp "not deleted\n"; return;}
1243 foreach my $y1 (@_) {
1244 unless ($y1 eq "\036") {
1245 push @records, $y1;
1246 next;
1247 }
1248 unless ($marc->addfield($template, @records)) {
1249 mycarp "not added\n";
1250 return;
1251 }
1252 @records = ();
1253 $count++;
1254 }
1255 return $count;
1256 }
1257
1258 ####################################################################
1259 # _offset is an internal subroutine used by writemarc to offset #
1260 # number ie. making "34" into "00034". #
1261 ####################################################################
1262 sub _offset{
1263 return MARC::Rec::_offset(@_);
1264 }
1265
1266 ####################################################################
1267
1268 # MARC::Rec is responsible for the methods and representation of
1269 # a single MARC record. Its protocol is very close to that of MARC:
1270 # in fact, most MARC methods have been moved here without the record
1271 # number and re-implemented in standard form by delegation.
1272
1273 ####################################################################
1274
1275 package MARC::Rec;
1276 use Carp;
1277 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS
1278 @LDR_FIELDS $LDR_TEMPLATE %FF_FIELDS %FF_TEMPLATE
1279 );
1280
1281 $VERSION = $MARC::VERSION;
1282
1283 @ISA = qw(Exporter);
1284 @EXPORT= qw();
1285 @EXPORT_OK= qw();
1286
1287 #### Not using these yet
1288
1289 #### %EXPORT_TAGS = (USTEXT => [qw( marc2ustext )]);
1290 #### Exporter::export_ok_tags('USTEXT');
1291 #### $EXPORT_TAGS{ALL} = \@EXPORT_OK;
1292
1293 # gotta know where to find leader information....
1294
1295 @LDR_FIELDS = qw(rec_len RecStat Type BLvl Ctrl Undefldr base_addr
1296 ELvl Desc ln_rec len_len_field len_start_char len_impl Undef2ldr);
1297
1298 $LDR_TEMPLATE = "a5aaaaa3a5aaaaaaa";
1299
1300 #...And the 008 field has a special place in Librarians' hearts.
1301 %FF_FIELDS = (
1302 BOOKS =>
1303 [qw(Entered DtSt Date1 Date2 Ctry Ills Audn Form Cont
1304 GPub Conf Fest Indx Undef1 Fict Biog Lang MRec Srce)],
1305 COMPUTER_FILES =>
1306 [qw(Entered DtSt Date1 Date2 Ctry Undef1 Audn Undef2
1307 File Undef3 GPub Undef4 Lang MRec Srce)],
1308 MAPS =>
1309 [qw(Entered DtSt Date1 Date2 Ctry Relf Proj Prme CrTp
1310 Undef1 GPub Undef2 Indx Undef3 SpFm Lang MRec Srce)],
1311 MUSIC =>
1312 [qw(Entered DtSt Date1 Date2 Ctry Comp FMus Undef1 Audn
1313 Form AccM LTxt Undef2 Lang MRec Srce)],
1314 SERIALS =>
1315 [qw(Entered DtSt Date1 Date2 Ctry Freq Regl ISSN SrTp
1316 Orig Form EntW Cont GPub Conf Undef1 Alph S_L Lang MRec Srce)],
1317 VIS =>
1318 [qw(Entered DtSt Date1 Date2 Ctry Time Undef1
1319 Audn AccM GPub Undef2 TMat Tech Lang MRec Srce)],
1320 MIX =>
1321 [qw(Entered DtSt Date1 Date2
1322 Ctry Undef1 Form Undef2 Lang MRec Srce)]
1323 );
1324
1325 %FF_TEMPLATE = (
1326 BOOKS => "a6a1a4a4a3a4a1a1a4a1a1a1a1a1a1a1a3a1a1",
1327 COMPUTER_FILES => "a6a1a4a4a3a4a1a3a1a1a1a6a3a1a1",
1328 MAPS => "a6a1a4a4a3a4a2a1a1a2a1a2a1a1a2a3a1a1",
1329 MUSIC => "a6a1a4a4a3a2a1a1a1a1a6a2a3a3a1a1",
1330 SERIALS => "a6a1a4a4a3a1a1a1a1a1a1a1a3a1a1a3a1a1a3a1a1",
1331 VIS => "a6a1a4a4a3a3a1a1a5a1a4a1a1a3a1a1",
1332 MIX => "a6a1a4a4a3a5a1a11a3a1a1"
1333 );
1334
1335 # Preloaded methods go here.
1336 ####################################################################
1337 # _offset is an internal subroutine used by writemarc to offset #
1338 # number ie. making "34" into "00034". #
1339 ####################################################################
1340 sub _offset{
1341 my $value=shift;
1342 my $digits=shift;
1343 print "DEBUG: _offset value = $value, digits = $digits\n" if $MARC::DEBUG;
1344 my $x=length($value);
1345 $x=$digits-$x;
1346 $x="0"x$x."$value";
1347 }
1348
1349 sub mycarp { # rec
1350 Carp::carp (@_) unless $MARC::TEST;
1351 }
1352
1353 ####################################################################
1354
1355 # This is the constructor method that creates the MARC::Rec object. It
1356 # sets up references and gets out. Any file it knows about will be an
1357 # already opened filehandle: do error checking and binmode on the file
1358 # outside MARC::Rec.
1359
1360 ####################################################################
1361 sub new { # rec
1362 my $proto = shift;
1363 my $class = ref($proto) || $proto;
1364 my $filehandle = shift;
1365 my $marcrec = {};
1366 bless ($marcrec, $class);
1367 my $format = shift || "usmarc";
1368
1369 $marcrec->{'handle'} ||= \*filehandle;
1370 $marcrec->{'format'}=$format;
1371 $marcrec->{'lineterm'}="\015\012" if $format eq 'marcmaker';
1372 # MS-DOS default for MARCMaker
1373 return $marcrec;
1374 }
1375
1376 ####################################################################
1377
1378 # Copy_struct returns a copy of the marcrec ($proto) without
1379 # {array} and map information. The copy shares references to
1380 # {handle} by design.
1381
1382 ####################################################################
1383 sub copy_struct {
1384 my $proto = shift;
1385 my $class = ref($proto);
1386 my $newrec;
1387 for (keys %$proto) {
1388 $newrec->{$_} = $proto->{$_} if /^(handle|format|proto_rec)$/;
1389 }
1390 return bless $newrec,$class;
1391 }
1392
1393 ####################################################################
1394
1395 # clone returns a new MARC::Rec object with copies of the data.
1396 # Admin information remains linked to original.
1397
1398 ####################################################################
1399 sub clone {
1400 my $marcrec=shift;
1401 my $ldr = $marcrec->ldr();
1402 my $ans = $marcrec->createrecord($ldr);
1403 for (@{$marcrec->{array}}) {
1404 next if $_->[0] eq '000';
1405 my @field = @$_;
1406 my $rfield = \@field;
1407 push @{$ans->{array}}, $rfield;
1408 $ans->add_map($rfield);
1409 }
1410 return $ans;
1411 }
1412
1413 ####################################################################
1414
1415 # field_is_empty takes a ref to an array formatted like
1416 # an element of $marc->[$recnum]{array}. It returns 1 if there are
1417 # no "significant" elements of the array (e.g. nothing but indicators
1418 # if $tag>10), else 0. Override this if you want to delete fields
1419 # that have "insignificant" subfields inside deletefirst.
1420
1421 ####################################################################
1422 sub field_is_empty { # rec
1423 my ($marcrec,$rfield) = @_;
1424
1425 my $tag = $rfield->[0];
1426 my @field = @$rfield;
1427 return 1 if ($tag > 10 and !defined($field[3]));
1428 return 1 if ($tag < 10 and !defined($field[1]) );
1429 return 0;
1430 }
1431
1432 ####################################################################
1433
1434 # field_updatehook echos the version in MARC without the recordnum.
1435
1436 ####################################################################
1437 sub field_updatehook { # rec
1438 # nothing. Subclass may want to handle this.
1439 }
1440
1441
1442 ####################################################################
1443
1444 # getfields() takes a template and returns an array of fieldrefs from
1445 # $marc->[$recnum]{'array'} including all with the appropriate tag
1446 # and having the property that they are a contiguous group. (So may
1447 # include fields with other tags.)
1448
1449 ####################################################################
1450 sub getfields { # rec
1451
1452 my $marcrec=shift;
1453 my $params=shift;
1454
1455 my $field = $params->{'field'};
1456 unless ($field) {mycarp "You must specify a field"; return}
1457 unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return}
1458
1459 my @ans=();
1460 my $first = undef;
1461 my $last = $first;
1462 my $pos = 0;
1463 for (@{$marcrec->{'array'}}) {
1464 $first = $pos if ($_->[0] eq $field && !defined($first)) ;
1465 $last = $pos if $_->[0] eq $field;
1466 $pos++;
1467 }
1468 return () unless defined($first);
1469 return @{$marcrec->{'array'}}[$first..$last]; # array slice. Look it up.
1470 }
1471
1472 ####################################################################
1473
1474 # deletefirst() takes a template and a boolean $do_rebuild_map to
1475 # rebuild the map. It deletes the field data for a first match, using
1476 # the template and leaves the rest alone. If the template has a
1477 # subfield element it deletes based on the subfield information in the
1478 # template. If the last subfield of a field is deleted, deletefirst()
1479 # also deletes the field. It complains about attempts to delete
1480 # indicators. If there is no match, it does nothing. Deletefirst also
1481 # rebuilds the map if $do_rebuild_map. Deletefirst returns the number
1482 # of matches deleted (that would be 0 or 1), or undef if it feels
1483 # grumpy (i.e. carps).
1484
1485 ####################################################################
1486
1487 sub deletefirst { # rec
1488 my $marcrec = shift || return;
1489 my $template = shift;
1490 return unless (ref($template) eq "HASH");
1491 return if (defined $template->{'value'});
1492
1493 my $field = $template->{'field'};
1494
1495 my $subfield = $template->{'subfield'};
1496 my $do_rebuild_map = $template->{'rebuild_map'};
1497 if (defined($subfield) and $subfield =~/^i[12]$/) {mycarp "Cannot delete indicators"; return undef}
1498 #I know that $marc->{$field}{field} is this information
1499 #But I don't want to depend on the map being up-to-date allways.
1500
1501 my @fieldrefs = $marcrec->getfields($template); #helps with cjk.
1502
1503 return 0 unless scalar(@fieldrefs);
1504
1505 if ($field and not($subfield)) {
1506 shift @fieldrefs;
1507 $marcrec->updatefields($template,\@fieldrefs);
1508 $marcrec->rebuild_map($field) if $do_rebuild_map;
1509 return 1;
1510 }
1511
1512
1513 #Linear search for the field where deletion happens and the position
1514 #in that field.
1515 my $rvictim=0;
1516 my $fieldnum = 0;
1517 foreach my $fieldref (@fieldrefs) {
1518 if ($marcrec->getmatch($subfield,$fieldref)){
1519 $rvictim=$fieldref;
1520 last;
1521 }
1522 $fieldnum++;
1523 }
1524 if (!$rvictim) {
1525 $marcrec->rebuild_map($field) if $do_rebuild_map;
1526 return 0;
1527 }
1528
1529 #Now we know that we have a field and subfield with a match.
1530 #Find the first one and kill it. Kill the enclosing field
1531 #if it is the last one.
1532 $marcrec->deletesubfield($subfield,$rvictim);
1533 $marcrec->field_updatehook($rvictim);
1534 if ($marcrec->field_is_empty($rvictim)) {
1535 splice @fieldrefs,$fieldnum,1;
1536 $marcrec->updatefields($template,\@fieldrefs);
1537 }
1538 #here we don't need to directly touch $marc->{array}
1539 # since we are not changing its structure.
1540 $marcrec->rebuild_map($field) if $do_rebuild_map;
1541 return 1;
1542 }
1543
1544 sub _params {
1545 my $template =shift;
1546 return {} unless ref $template eq 'HASH';
1547 my %params = %$template;
1548 %params = (%params,@_);
1549 return \%params;
1550 }
1551
1552 ####################################################################
1553 # _writemarc() takes a MARC object as its input and returns the #
1554 # the USMARC equivalent of the object as a string #
1555 ####################################################################
1556 sub _writemarc { # rec
1557 my $marcrec=shift;
1558 my $args=shift;
1559 my (@record, $fieldbase, $fielddata, $fieldlength, $fieldposition,
1560 $marcrecord, $recordlength);
1561
1562 my $record = $marcrec;
1563 #Reset variables
1564 my $position=0; my $directory=""; my $fieldstream="";
1565 my $leader=$record->{'000'}[1];
1566 foreach my $field (@{$record->{'array'}}) {
1567 my $tag = $field->[0];
1568 if ($tag eq '000') {next}; #don't output the directory!
1569 my $fielddata="";
1570 if ($tag < 10) {
1571 $fielddata=$field->[1];
1572 }
1573 else {
1574 $fielddata.=$field->[1].$field->[2]; #add on indicators
1575 my @subfields=@{$field}[3..$#{$field}];
1576 while (@subfields) {
1577 $fielddata.="\037".shift(@subfields); #shift off subfield delimiter
1578 $fielddata.=shift(@subfields); #shift off subfield value
1579 }
1580 }
1581 $fielddata.="\036";
1582 $fieldlength=_offset(length($fielddata),4);
1583 $fieldposition=_offset($position,5);
1584 $directory.=$tag.$fieldlength.$fieldposition;
1585 $position+=$fieldlength;
1586 $fieldstream.=$fielddata;
1587 }
1588 $directory.="\036";
1589 $fieldstream.="\035";
1590 $fieldbase=24+length($directory);
1591 $fieldbase=_offset($fieldbase,5);
1592 $recordlength=24+length($directory)+length($fieldstream);
1593 $recordlength=_offset($recordlength,5);
1594 $leader=~s/^.{5}(.{7}).{5}(.{7})/$recordlength$1$fieldbase$2/;
1595
1596 $marcrecord ="$leader$directory$fieldstream";
1597
1598 $record->{'000'}[1] = $leader; # save recomputed version
1599 return $marcrecord;
1600 }
1601
1602 ####################################################################
1603 # _marc2ascii() takes a MARC object as its input and returns the #
1604 # ASCII equivalent of the object (field names, indicators, field #
1605 # values and line-breaks) #
1606 ####################################################################
1607 sub _marc2ascii {
1608
1609 my $marcrec=shift;
1610 my $args=shift;
1611 my $newline = $args->{'lineterm'} || "\n";
1612 my $output = "";
1613 my $record=$marcrec;
1614 foreach my $fields (@{$record->{'array'}}) { #cycle each field
1615 my $tag=$fields->[0];
1616 print "ASCII: tag = $tag\n" if $MARC::DEBUG;
1617 if ($tag<10) {
1618 $output.="$fields->[0] $fields->[1]";
1619 }
1620 else {
1621 $output.="$tag $fields->[1]$fields->[2] ";
1622 my @subfields = @{$fields}[3..$#{$fields}];
1623 while (@subfields) { #cycle through subfields
1624 $output .= "\$".shift(@subfields).shift(@subfields);
1625 } #finish cycling through subfields
1626 } #finish tag test < 10
1627 $output .= $newline; #put a newline at the end of the field
1628 }
1629 $output.=$newline; #put an extra newline to separate records
1630 return $output;
1631 }
1632
1633 ####################################################################
1634 # _marcmaker() takes a MARC object as its input and converts it #
1635 # into MARCMaker format, which is returned as a string #
1636 ####################################################################
1637 sub _marcmaker { # rec
1638 my @output = ();
1639 my $marcrec=shift;
1640 my $args=shift;
1641 my $proto_rec=$args->{'proto_rec'};
1642 unless (exists $args->{'charset'}) {
1643 unless (exists $proto_rec->{'brkrchar'}) {
1644 $proto_rec->{'brkrchar'} = ustext_default(); # hash ref
1645 }
1646 $args->{'charset'} = $proto_rec->{'brkrchar'};
1647 $proto_rec->{'charset'} = $proto_rec->{'brkrchar'};
1648 }
1649 local $^W = 0; # no warnings
1650
1651 my $record=$marcrec;
1652 foreach my $fields (@{$record->{'array'}}) { #cycle each field
1653 my $tag=$fields->[0];
1654 print "OUT: tag = $tag\n" if $MARC::DEBUG;
1655 if ($tag eq '000') {
1656 my $value=$fields->[1];
1657 $value=~s/ /\\/go;
1658 push @output, "=LDR $value";
1659 }
1660 elsif ($tag<10) {
1661 my $value = _char2maker($fields->[1], $args->{'charset'});
1662 $value=~s/ /\\/go;
1663 push @output, "=$tag $value";
1664 }
1665 else {
1666 my $indicator1=$fields->[1];
1667 $indicator1=~s/ /\\/;
1668 my $indicator2=$fields->[2];
1669 $indicator2=~s/ /\\/;
1670 my $output="=$tag $indicator1$indicator2";
1671 my @subfields = @{$fields}[3..$#{$fields}];
1672 while (@subfields) { #cycle through subfields
1673 my $subfield_id = shift(@subfields);
1674 my $subfield = _char2maker( shift(@subfields),
1675 $args->{'charset'} );
1676 $output .= "\$$subfield_id$subfield";
1677 } #finish cycling through subfields
1678 push @output, $output;
1679 } #finish tag test < 10
1680 }
1681 push @output,""; #put an extra blank line to separate records
1682
1683 my $newline = $args->{'lineterm'} || "\015\012";
1684 if ($args->{'nolinebreak'}) {
1685 my $breaker1 = join ($newline, @output) . $newline;
1686 return $breaker1;
1687 }
1688 # linebreak on by default
1689 my @output2 = ();
1690 foreach my $outline (@output) {
1691 if (length($outline) < 66) {
1692 push @output2, $outline;
1693 next;
1694 }
1695 else {
1696 my @words = split (/\s{1,1}/, $outline);
1697 my $outline2 = shift @words;
1698 foreach my $word (@words) {
1699 if (length($outline2) + length($word) < 66) {
1700 $outline2 .= " $word";
1701 }
1702 else {
1703 push @output2, $outline2;
1704 $outline2 = " $word";
1705 }
1706 }
1707 push @output2, $outline2;
1708 }
1709 }
1710 my $breaker = join ($newline, @output2);
1711 return $breaker;
1712 }
1713
1714 sub _char2maker {
1715 my @marc_string = split (//, shift);
1716 my $charmap = shift;
1717 my $maker_string = join ('', map { ${$charmap}{$_} } @marc_string);
1718 while ($maker_string =~ s/(&)([^ ]{1,7}?)(;)/{$2}/o) {}
1719 return $maker_string;
1720 }
1721
1722 sub ustext_default {
1723 my @hexchar = (0x00..0x1a,0x1c,0x7f..0x8c,0x8f..0xa0,0xaf,0xbb,
1724 0xbe,0xbf,0xc7..0xdf,0xfc,0xfd,0xff);
1725 my %outchar = map {chr($_), sprintf ("{%2.2X}",int $_)} @hexchar;
1726
1727 my @ascchar = map {chr($_)} (0x20..0x23,0x25..0x7a,0x7c,0x7e);
1728 foreach my $asc (@ascchar) { $outchar{$asc} = $asc; }
1729
1730 $outchar{chr(0x1b)} = '{esc}'; # escape
1731 $outchar{chr(0x24)} = '{dollar}'; # dollar sign
1732 $outchar{chr(0x5c)} = '{bsol}'; # back slash (reverse solidus)
1733 $outchar{chr(0x7b)} = '{lcub}'; # opening curly brace
1734 $outchar{chr(0x7d)} = '{rcub}'; # closing curly brace
1735 $outchar{chr(0x8d)} = '{joiner}'; # zero width joiner
1736 $outchar{chr(0x8e)} = '{nonjoin}'; # zero width non-joiner
1737 $outchar{chr(0xa1)} = '{Lstrok}'; # latin capital letter l with stroke
1738 $outchar{chr(0xa2)} = '{Ostrok}'; # latin capital letter o with stroke
1739 $outchar{chr(0xa3)} = '{Dstrok}'; # latin capital letter d with stroke
1740 $outchar{chr(0xa4)} = '{THORN}'; # latin capital letter thorn (icelandic)
1741 $outchar{chr(0xa5)} = '{AElig}'; # latin capital letter AE
1742 $outchar{chr(0xa6)} = '{OElig}'; # latin capital letter OE
1743 $outchar{chr(0xa7)} = '{softsign}'; # modifier letter soft sign
1744 $outchar{chr(0xa8)} = '{middot}'; # middle dot
1745 $outchar{chr(0xa9)} = '{flat}'; # musical flat sign
1746 $outchar{chr(0xaa)} = '{reg}'; # registered sign
1747 $outchar{chr(0xab)} = '{plusmn}'; # plus-minus sign
1748 $outchar{chr(0xac)} = '{Ohorn}'; # latin capital letter o with horn
1749 $outchar{chr(0xad)} = '{Uhorn}'; # latin capital letter u with horn
1750 $outchar{chr(0xae)} = '{mlrhring}'; # modifier letter right half ring (alif)
1751 $outchar{chr(0xb0)} = '{mllhring}'; # modifier letter left half ring (ayn)
1752 $outchar{chr(0xb1)} = '{lstrok}'; # latin small letter l with stroke
1753 $outchar{chr(0xb2)} = '{ostrok}'; # latin small letter o with stroke
1754 $outchar{chr(0xb3)} = '{dstrok}'; # latin small letter d with stroke
1755 $outchar{chr(0xb4)} = '{thorn}'; # latin small letter thorn (icelandic)
1756 $outchar{chr(0xb5)} = '{aelig}'; # latin small letter ae
1757 $outchar{chr(0xb6)} = '{oelig}'; # latin small letter oe
1758 $outchar{chr(0xb7)} = '{hardsign}'; # modifier letter hard sign
1759 $outchar{chr(0xb8)} = '{inodot}'; # latin small letter dotless i
1760 $outchar{chr(0xb9)} = '{pound}'; # pound sign
1761 $outchar{chr(0xba)} = '{eth}'; # latin small letter eth
1762 $outchar{chr(0xbc)} = '{ohorn}'; # latin small letter o with horn
1763 $outchar{chr(0xbd)} = '{uhorn}'; # latin small letter u with horn
1764 $outchar{chr(0xc0)} = '{deg}'; # degree sign
1765 $outchar{chr(0xc1)} = '{scriptl}'; # latin small letter script l
1766 $outchar{chr(0xc2)} = '{phono}'; # sound recording copyright
1767 $outchar{chr(0xc3)} = '{copy}'; # copyright sign
1768 $outchar{chr(0xc4)} = '{sharp}'; # sharp
1769 $outchar{chr(0xc5)} = '{iquest}'; # inverted question mark
1770 $outchar{chr(0xc6)} = '{iexcl}'; # inverted exclamation mark
1771 $outchar{chr(0xe0)} = '{hooka}'; # combining hook above
1772 $outchar{chr(0xe1)} = '{grave}'; # combining grave
1773 $outchar{chr(0xe2)} = '{acute}'; # combining acute
1774 $outchar{chr(0xe3)} = '{circ}'; # combining circumflex
1775 $outchar{chr(0xe4)} = '{tilde}'; # combining tilde
1776 $outchar{chr(0xe5)} = '{macr}'; # combining macron
1777 $outchar{chr(0xe6)} = '{breve}'; # combining breve
1778 $outchar{chr(0xe7)} = '{dot}'; # combining dot above
1779 $outchar{chr(0xe8)} = '{uml}'; # combining diaeresis (umlaut)
1780 $outchar{chr(0xe9)} = '{caron}'; # combining hacek
1781 $outchar{chr(0xea)} = '{ring}'; # combining ring above
1782 $outchar{chr(0xeb)} = '{llig}'; # combining ligature left half
1783 $outchar{chr(0xec)} = '{rlig}'; # combining ligature right half
1784 $outchar{chr(0xed)} = '{rcommaa}'; # combining comma above right
1785 $outchar{chr(0xee)} = '{dblac}'; # combining double acute
1786 $outchar{chr(0xef)} = '{candra}'; # combining candrabindu
1787 $outchar{chr(0xf0)} = '{cedil}'; # combining cedilla
1788 $outchar{chr(0xf1)} = '{ogon}'; # combining ogonek
1789 $outchar{chr(0xf2)} = '{dotb}'; # combining dot below
1790 $outchar{chr(0xf3)} = '{dbldotb}'; # combining double dot below
1791 $outchar{chr(0xf4)} = '{ringb}'; # combining ring below
1792 $outchar{chr(0xf5)} = '{dblunder}'; # combining double underscore
1793 $outchar{chr(0xf6)} = '{under}'; # combining underscore
1794 $outchar{chr(0xf7)} = '{commab}'; # combining comma below
1795 $outchar{chr(0xf8)} = '{rcedil}'; # combining right cedilla
1796 $outchar{chr(0xf9)} = '{breveb}'; # combining breve below
1797 $outchar{chr(0xfa)} = '{ldbltil}'; # combining double tilde left half
1798 $outchar{chr(0xfb)} = '{rdbltil}'; # combining double tilde right half
1799 $outchar{chr(0xfe)} = '{commaa}'; # combining comma above
1800 if ($MARC::DEBUG) {
1801 foreach my $num (sort keys %outchar) {
1802 printf "%x = %s\n", ord($num), $outchar{$num};
1803 }
1804 }
1805 return \%outchar;
1806 }
1807
1808 ####################################################################
1809 # _marc2html takes a MARC object as its input and converts it into #
1810 # HTML. It is possible to specify which field you want to output #
1811 # as well as field labels to be used instead of the MARC codes. #
1812 # The HTML is returned as a string #
1813 ####################################################################
1814 sub _marc2html { # rec
1815 my $marcrec = shift;
1816 my $args = shift;
1817 my $newline = $args->{'lineterm'} || "\n";
1818 my $output = "";
1819 my $outputall = 1;
1820
1821 my @tags =();
1822 @tags = grep /^[0-9]/, sort(keys(%{$args}));
1823
1824 $outputall = 0 if (scalar(@tags));
1825 if (defined $args->{'fields'}) {
1826 if ($args->{'fields'} =~ /all$/oi) {$outputall=1} ## still needed ?????
1827 }
1828
1829
1830 my %tags =();
1831
1832 %tags = map {$_=>1} @tags;
1833 %tags = map {$_->[0]=>1} @{$marcrec->{'array'}} if $outputall;
1834 #if 'all' fields are specified then set $outputall flag to yes
1835 local $^W = 0; # no warnings
1836
1837 my $j=$marcrec;
1838 $output.= $newline."<p>";
1839
1840 foreach my $rfield (@{$j->{'array'}}) {
1841 $output.= $rfield->[0]." ".$j->_joinfield($rfield,$rfield->[0])."<br>".$newline
1842 if $tags{$rfield->[0]};
1843 }
1844 $output.="</p>";
1845 return $output;
1846 }
1847
1848
1849 ####################################################################
1850 # _urls() takes a MARC object as its input, and then extracts the #
1851 # control# (MARC 001) and URLs (MARC 856) and outputs them as #
1852 # hypertext links in an HTML page. This could then be used with a #
1853 # link checker to determine what URLs are broken. #
1854 ####################################################################
1855 sub _urls {
1856 my $marcrec = shift;
1857 my $args = shift;
1858 my $newline = $args->{'lineterm'} || "\n";
1859 my $output = "";
1860
1861 my $controlnum=undef;
1862 foreach my $rfield (@{$marcrec->{'array'}}) {
1863 if ($rfield->[0] eq "001") {
1864 $controlnum= $rfield->[1];
1865 }
1866 elsif ($rfield->[0] eq "856") {
1867 for (my $k=3; $k< $#$rfield; $k++) {
1868 if ($rfield->[$k] eq "u") {
1869 $output.=qq{<a href="$rfield->[$k+1]">$controlnum :}.
1870 qq{$rfield->[$k+1]</a><br>$newline};
1871 }
1872 }
1873 }
1874 }
1875 return $output;
1876 }
1877
1878 ####################################################################
1879 # isbd() attempts to create a quasi ISBD output format #
1880 ####################################################################
1881 sub _isbd { # rec
1882 my $marcrec=shift;
1883 my $args=shift;
1884
1885 my $output = "";
1886 my $newline = $args->{'lineterm'} || "\n";
1887
1888 my @reporting_fields = grep {$_->[0] =~/020|245|250|260|300|440|490|5../}
1889 @{$marcrec->{'array'}}; # optimization.
1890 my %tagfields = (); # This will allow random access to fields based on tags
1891 foreach my $rfield (@reporting_fields) {
1892 push @{$tagfields{$rfield->[0]}},$rfield;
1893 }
1894 $output .= $marcrec->_joinfield($tagfields{245}[0],"245");
1895 for (qw/250 260 300/) {
1896 $output .= " -- ". $marcrec->_joinfield($tagfields{$_}[0],$_) if $tagfields{$_};
1897 }
1898 if ($tagfields{'440'}) {
1899 $output .= " -- ";
1900 foreach my $rfield (@{$tagfields{'440'}}) {
1901 $output .= "(".$marcrec->_joinfield($rfield,"440").") ";
1902 }
1903 }
1904 if ($tagfields{'490'}) {
1905 $output .= " -- " unless $tagfields{'440'};
1906 foreach my $rfield (@{$tagfields{'490'}}) {
1907 $output .= "(".$marcrec->_joinfield($rfield,"490").") ";
1908 }
1909 }
1910 my @f500s = grep {$_->[0] =~/5../} @reporting_fields;
1911 foreach my $rfield (@f500s) {
1912 $output .= $newline.$marcrec->_joinfield($rfield,$rfield->[0]);
1913 }
1914 if ($tagfields{'020'}) {
1915 $output .= $newline.$marcrec->_joinfield($tagfields{'020'}[0]);
1916 }
1917 $output .= $newline.$newline;
1918 return $output;
1919 }
1920
1921 ####################################################################
1922
1923 # createrecord takes a string leader and returns a new record with
1924 # leader information at the appropriate place.
1925
1926 ####################################################################
1927 sub createrecord { # rec
1928 my $marcrec = shift;
1929 local $^W = 0; # no warnings
1930 my $leader=shift || "00000nam 2200000 a 4500";
1931 my $newrec = $marcrec->copy_struct();
1932 #default leader see MARC documentation http://lcweb.loc.gov/marc
1933 my @ldrfield = ('000',$leader);
1934 $newrec->field_updatehook(\@ldrfield);
1935 push (@{$newrec->{'000'}},@ldrfield); #create map
1936 push(@{$newrec->{'array'}},$newrec->{'000'});
1937 return $newrec;
1938 }
1939
1940 ####################################################################
1941 # nextrec() will read in a record from a filehandle
1942 # already been opened with openmarc(). the increment can be #
1943 # adjusted if necessary by passing a new value as a parameter. the #
1944 # new records will be APPENDED to the MARC object #
1945 ####################################################################
1946 sub nextrec {
1947 my $marcrec=shift;
1948 if (not($marcrec->{'handle'})) {
1949 mycarp "There isn't a MARC file open";
1950 return;
1951 }
1952 if ($marcrec->{'format'} =~ /usmarc/oi) {
1953 return _readmarc($marcrec);
1954 }
1955 elsif ($marcrec->{'format'} =~ /marcmaker/oi) {
1956 return _readmarcmaker($marcrec);
1957 }
1958 else {return (undef,-3)}
1959 }
1960
1961 ####################################################################
1962
1963 # Add_map is the rec equivalent of MARC::add_map (as usual, without
1964 # the record number).
1965
1966 ####################################################################
1967 sub add_map { # rec
1968 my $marcrec=shift;
1969 my $rafield = shift;
1970 my $tag = $rafield->[0];
1971 return undef if $tag eq '000'; #currently handle ldr yourself...
1972 my @tmp = @$rafield;
1973 my $field_len = $#tmp;
1974 my $record = $marcrec;
1975 if ($tag > 10 ) {
1976 my $i1 = $rafield->[1];
1977 my $i2 = $rafield->[2];
1978 my $i12 = $i1.$i2;
1979
1980 for(my $i=3;$i<$field_len;$i+=2) {
1981 my $subf_code = $rafield->[$i];
1982 push(@{$record->{$tag}{$subf_code}}, \$rafield->[$i+1]);
1983 }
1984 push(@{$record->{$tag}{'i1'}{$i1}},$rafield);
1985 push(@{$record->{$tag}{'i2'}{$i2}},$rafield);
1986 push(@{$record->{$tag}{'i12'}{$i12}},$rafield);
1987 }
1988 push(@{$record->{$tag}{field}},$rafield);
1989 }
1990
1991 ####################################################################
1992
1993 # rebuild_map() is the ::Rec version of MARC::rebuild_map().
1994
1995 ####################################################################
1996 sub rebuild_map { # rec
1997 my $marcrec=shift;
1998 my $tag = shift;
1999 return undef if $tag eq '000'; #currently ldr is different...
2000 my @tagrefs = grep {$_->[0] eq $tag} @{$marcrec->{'array'}};
2001 delete $marcrec->{$tag};
2002 for (@tagrefs) {$marcrec->add_map($_)};
2003 }
2004
2005 ####################################################################
2006
2007 # rebuild_map_all() is the ::Rec version of MARC::rebuild_map_all()
2008
2009 ####################################################################
2010 sub rebuild_map_all { # rec
2011 my $marcrec=shift;
2012 my %tags=();
2013 map {$tags{$_->[0]}++} @{$marcrec->{'array'}};
2014 foreach my $tag (keys %tags) {$marcrec->rebuild_map($tag)};
2015 }
2016
2017
2018
2019 ####################################################################
2020
2021 # Reads the next record out of the handle. Returns a pair (new
2022 # record,status). Status is 1 in the generic case. Status is -1 if
2023 # lengths do not match -2 if leader size is not numeric, undef if at
2024 # the last record. New record is undef if there is an error or at the
2025 # last record.
2026
2027 ####################################################################
2028 sub _readmarc { # rec
2029 my $marcrec = shift;
2030 my $handle = $marcrec->{'handle'};
2031 my $string = shift;
2032 local $/ = "\035"; # cf. TPJ #14
2033 local $^W = 0; # no warnings
2034 my $line;
2035 $line = $string if $string;
2036 $line = <$handle> if $handle and !defined($string);
2037 my $recordlength = substr($line,0,5);
2038 my $octets = length ($line);
2039 $line=~s/[\n\r\cZ]//og;
2040 return (undef,undef) unless $line;
2041 if ($recordlength =~ /\d{5}/o) {
2042 print "recordlength = $recordlength, length = $octets\n"
2043 if $MARC::DEBUG;
2044 return (undef,-1) unless $recordlength == $octets;
2045 } else {
2046 return (undef,-2);
2047 }
2048 my @d = ();
2049 $line=~/^(.{24})([^\036]*)\036(.*)/o;
2050 my $leader=$1; my $dir=$2; my $data=$3;
2051 my $record = $marcrec->createrecord($leader);
2052
2053 @d=$dir=~/(.{12})/go;
2054 for my $d(@d) {
2055 my @field=();
2056 my $tag=substr($d,0,3);
2057 chop(my $field=substr($data,substr($d,7,5),substr($d,3,4)));
2058 if ($tag<10) {
2059 @field=($tag,$field);
2060 }
2061 else {
2062 my ($indi1, $indi2, $field_data) = unpack ("a1a1a*", $field);
2063
2064 push (@field, $tag, $indi1, $indi2);
2065
2066 my @subfields = split(/\037/,$field_data);
2067 foreach (@subfields) {
2068 my $delim = substr($_,0,1);
2069 next unless $delim;
2070 my $subfield_data = substr($_,1);
2071 push(@field, $delim, $subfield_data);
2072
2073 } #end parsing subfields
2074 } #end testing tag number
2075 push(@{$record->{'array'}},\@field);
2076 $record-> add_map(\@field);
2077 } #end processing this field
2078 return ($record,1);
2079 }
2080
2081 ###################################################################
2082 # readmarcmaker() reads a marcmaker file into the MARC object #
2083 ###################################################################
2084 sub _readmarcmaker { # rec
2085 my $marcrec = shift;
2086 my $handle = $marcrec->{'handle'};
2087 my $string = shift;
2088 my $record;
2089
2090 unless (exists $marcrec->{'makerchar'}) {
2091 $marcrec->{'makerchar'} = usmarc_default(); # hash ref
2092 }
2093 my $charset = $marcrec->{makerchar};
2094 my $lineterm = $marcrec->{'lineterm'} || "\015\012";
2095 # MS-DOS file default for MARCMaker
2096
2097 #Set the file input separator to "\r\n\r\n", which is the same as
2098 #a blank line. A single blank line separates individual MARC records
2099 #in the MARCMakr format.
2100 local $/ = "$lineterm$lineterm"; # cf. TPJ #14
2101 local $^W = 0; # no warnings
2102 $record = $string if $string;
2103 $record = <$handle> if $handle and !defined($string);
2104
2105 return (undef,undef) unless $record;
2106 #Split each record on the "\n=" into the @fields array
2107 my @lines=split "$lineterm=",$record;
2108 my $leader = shift @lines;
2109 unless ($leader =~ /^=LDR /o) {
2110 return (undef, -1);
2111 }
2112
2113 $leader=~s/^=LDR //o; #Remove "=LDR "
2114 $leader=~s/[\n\r]//og;
2115 $leader=~s/\\/ /go; # substitute " " for \
2116 my $rec = $marcrec->createrecord($leader);
2117 foreach my $line (@lines) {
2118 #Remove newlines from @fields ; and also substitute " " for \
2119 $line=~s/[\n\r]//og;
2120 $line=~s/\\/ /go;
2121 #get the tag name
2122 my $tag = substr($line,0,3);
2123 my @field=(); #this will be added to $marcrec and the map updated.
2124 #if the tag is less than 010 (has no indicators or subfields)
2125 #then push the data into @$field
2126 if ($tag < 10) {
2127 my $value = _maker2char (substr($line,5), $charset);
2128 @field=($tag,$value);
2129 }
2130 else {
2131 #elseif the tag is greater than 010 (has indicators and
2132 #subfields then add the data to the $marc object
2133 my $field_data=substr($line,7);
2134 my $i1=substr($line,5,1);
2135 my $i2=substr($line,6,1);
2136 @field = ($tag,$i1,$i2);
2137
2138 my @subfields=split /\$/, $field_data; #get the subfields
2139 foreach my $subfield (@subfields) {
2140 my $delim=substr($subfield,0,1); #extract subfield delimiter
2141 next unless $delim;
2142 my $subfield_data= MARC::_maker2char (substr($subfield,1),
2143 $charset);
2144 #extract subfield value
2145 push (@field, $delim, $subfield_data);
2146 } #end parsing subfields
2147 } #end tag>10
2148 print "DEBUG: tag = $tag\n" if $MARC::DEBUG;
2149 push @{$rec->{'array'}},\@field;
2150 $rec -> add_map(\@field);
2151 } #end reading this line
2152 return ($rec,1);
2153 } #end reading this record
2154
2155 sub _maker2char { # rec
2156 my $marc_string = shift;
2157 my $charmap = shift;
2158 while ($marc_string =~ /{(\w{1,8}?)}/o) {
2159 if (exists ${$charmap}{$1}) {
2160 $marc_string = join ('', $`, ${$charmap}{$1}, $');
2161 }
2162 else {
2163 $marc_string = join ('', $`, '&', $1, ';', $');
2164 }
2165 }
2166 # closing curly brace - part 2, permits {lcub}text{rcub} in input
2167 $marc_string =~ s/\&rcub;/\x7d/go;
2168 return $marc_string;
2169 }
2170
2171 sub usmarc_default { # rec
2172 my @hexchar = (0x00..0x1a,0x1c,0x7f..0x8c,0x8f..0xa0,0xaf,0xbb,
2173 0xbe,0xbf,0xc7..0xdf,0xfc,0xfd,0xff);
2174 my %inchar = map {sprintf ("%2.2X",int $_), chr($_)} @hexchar;
2175
2176 $inchar{esc} = chr(0x1b); # escape
2177 $inchar{dollar} = chr(0x24); # dollar sign
2178 $inchar{curren} = chr(0x24); # dollar sign - alternate
2179 $inchar{24} = chr(0x24); # dollar sign - alternate
2180 $inchar{bsol} = chr(0x5c); # back slash (reverse solidus)
2181 $inchar{lcub} = chr(0x7b); # opening curly brace
2182 $inchar{rcub} = "&rcub;"; # closing curly brace - part 1
2183 $inchar{joiner} = chr(0x8d); # zero width joiner
2184 $inchar{nonjoin} = chr(0x8e); # zero width non-joiner
2185 $inchar{Lstrok} = chr(0xa1); # latin capital letter l with stroke
2186 $inchar{Ostrok} = chr(0xa2); # latin capital letter o with stroke
2187 $inchar{Dstrok} = chr(0xa3); # latin capital letter d with stroke
2188 $inchar{THORN} = chr(0xa4); # latin capital letter thorn (icelandic)
2189 $inchar{AElig} = chr(0xa5); # latin capital letter AE
2190 $inchar{OElig} = chr(0xa6); # latin capital letter OE
2191 $inchar{softsign} = chr(0xa7); # modifier letter soft sign
2192 $inchar{middot} = chr(0xa8); # middle dot
2193 $inchar{flat} = chr(0xa9); # musical flat sign
2194 $inchar{reg} = chr(0xaa); # registered sign
2195 $inchar{plusmn} = chr(0xab); # plus-minus sign
2196 $inchar{Ohorn} = chr(0xac); # latin capital letter o with horn
2197 $inchar{Uhorn} = chr(0xad); # latin capital letter u with horn
2198 $inchar{mlrhring} = chr(0xae); # modifier letter right half ring (alif)
2199 $inchar{mllhring} = chr(0xb0); # modifier letter left half ring (ayn)
2200 $inchar{lstrok} = chr(0xb1); # latin small letter l with stroke
2201 $inchar{ostrok} = chr(0xb2); # latin small letter o with stroke
2202 $inchar{dstrok} = chr(0xb3); # latin small letter d with stroke
2203 $inchar{thorn} = chr(0xb4); # latin small letter thorn (icelandic)
2204 $inchar{aelig} = chr(0xb5); # latin small letter ae
2205 $inchar{oelig} = chr(0xb6); # latin small letter oe
2206 $inchar{hardsign} = chr(0xb7); # modifier letter hard sign
2207 $inchar{inodot} = chr(0xb8); # latin small letter dotless i
2208 $inchar{pound} = chr(0xb9); # pound sign
2209 $inchar{eth} = chr(0xba); # latin small letter eth
2210 $inchar{ohorn} = chr(0xbc); # latin small letter o with horn
2211 $inchar{uhorn} = chr(0xbd); # latin small letter u with horn
2212 $inchar{deg} = chr(0xc0); # degree sign
2213 $inchar{scriptl} = chr(0xc1); # latin small letter script l
2214 $inchar{phono} = chr(0xc2); # sound recording copyright
2215 $inchar{copy} = chr(0xc3); # copyright sign
2216 $inchar{sharp} = chr(0xc4); # sharp
2217 $inchar{iquest} = chr(0xc5); # inverted question mark
2218 $inchar{iexcl} = chr(0xc6); # inverted exclamation mark
2219 $inchar{hooka} = chr(0xe0); # combining hook above
2220 $inchar{grave} = chr(0xe1); # combining grave
2221 $inchar{acute} = chr(0xe2); # combining acute
2222 $inchar{circ} = chr(0xe3); # combining circumflex
2223 $inchar{tilde} = chr(0xe4); # combining tilde
2224 $inchar{macr} = chr(0xe5); # combining macron
2225 $inchar{breve} = chr(0xe6); # combining breve
2226 $inchar{dot} = chr(0xe7); # combining dot above
2227 $inchar{diaer} = chr(0xe8); # combining diaeresis
2228 $inchar{uml} = chr(0xe8); # combining umlaut
2229 $inchar{caron} = chr(0xe9); # combining hacek
2230 $inchar{ring} = chr(0xea); # combining ring above
2231 $inchar{llig} = chr(0xeb); # combining ligature left half
2232 $inchar{rlig} = chr(0xec); # combining ligature right half
2233 $inchar{rcommaa} = chr(0xed); # combining comma above right
2234 $inchar{dblac} = chr(0xee); # combining double acute
2235 $inchar{candra} = chr(0xef); # combining candrabindu
2236 $inchar{cedil} = chr(0xf0); # combining cedilla
2237 $inchar{ogon} = chr(0xf1); # combining ogonek
2238 $inchar{dotb} = chr(0xf2); # combining dot below
2239 $inchar{dbldotb} = chr(0xf3); # combining double dot below
2240 $inchar{ringb} = chr(0xf4); # combining ring below
2241 $inchar{dblunder} = chr(0xf5); # combining double underscore
2242 $inchar{under} = chr(0xf6); # combining underscore
2243 $inchar{commab} = chr(0xf7); # combining comma below
2244 $inchar{rcedil} = chr(0xf8); # combining right cedilla
2245 $inchar{breveb} = chr(0xf9); # combining breve below
2246 $inchar{ldbltil} = chr(0xfa); # combining double tilde left half
2247 $inchar{rdbltil} = chr(0xfb); # combining double tilde right half
2248 $inchar{commaa} = chr(0xfe); # combining comma above
2249 if ($MARC::DEBUG) {
2250 foreach my $str (sort keys %inchar) {
2251 printf "%s = %x\n", $str, ord($inchar{$str});
2252 }
2253 }
2254 return \%inchar;
2255 }
2256
2257 ####################################################################
2258
2259 # updatefirst() takes a template, a request to rebuild the index, and
2260 # an array from $marc->[recnum]{array}. It replaces/creates the field
2261 # data for a first match, using the template, and leaves the rest
2262 # alone. If the template has a subfield element, (this includes
2263 # indicators) it ignores all other information in the array and only
2264 # updates/creates based on the subfield information in the array. If
2265 # the template has no subfield information then indicators are left
2266 # untouched unless a new field needs to be created, in which case they
2267 # are left blank.
2268
2269 ####################################################################
2270
2271 sub updatefirst { # rec
2272 my $marcrec = shift || return;
2273 my $template = shift;
2274 return unless (ref($template) eq "HASH");
2275 return unless (@_);
2276 return if (defined $template->{'value'});
2277
2278
2279 my @ufield = @_;
2280 my $field = $template->{'field'};
2281 my $subfield = $template->{'subfield'};
2282 my $do_rebuild_map = $template->{'rebuild_map'};
2283
2284 $ufield[0]= $field;
2285 my $ufield_lt_10_value = $ufield[1];
2286 my $ftemplate = {field=>$field};
2287 if (!$field) {mycarp "Need a field to configure my changing needs."; return undef}
2288
2289 my @fieldrefs = $marcrec->getfields($template);
2290
2291 # An invariant is that at most one element of @fieldrefs is affected.
2292 if ($field and not($subfield)) {
2293 #save the indicators! Yes! Yes!
2294 my ($i1,$i2) = (" "," ");
2295 if (defined($fieldrefs[0])) {
2296 $i1 = $fieldrefs[0][1];
2297 $i2 = $fieldrefs[0][2];
2298 }
2299 $ufield[1]=$i1;
2300 $ufield[2]=$i2;
2301 if ($field <10) {@ufield = ($field,$ufield_lt_10_value)}
2302 my $rafieldrefs = \@fieldrefs;
2303 $marcrec->field_updatehook(\@ufield);
2304 $rafieldrefs->[0] = \@ufield;
2305 if (!scalar(@fieldrefs)) {
2306 $marcrec->updatefields($template,$rafieldrefs);
2307 return;
2308 }
2309 $fieldrefs[0]=\@ufield;
2310 #There is no issue with $fieldrefs being taken over by the splice in updatefields.
2311 # in current testing. Perl may change its behavior later...
2312 $marcrec->updatefields($template,\@fieldrefs);
2313 return;
2314 } #end field.
2315 # The case of adding first subfields is hard. (Not too bad with
2316 # indicators since every non-control field has them.)
2317 # OK, we have field, and subfield.
2318 if ($field and $subfield) {
2319 if ($field <10) {croak "Cannot update subfields of control fields"; return undef}
2320
2321 my $rvictim=0;
2322 my $fieldnum = 0;
2323 my $rval = 0;
2324 foreach my $fieldref (@fieldrefs) {
2325 $rval = $marcrec->getmatch($subfield,$fieldref);
2326 if ($rval){
2327 $rvictim=$fieldref;
2328 last;
2329 }
2330 $fieldnum++;
2331 }
2332 # At this stage we have the number of the field $fieldnum,
2333 # whether there is a match, $rvictim,
2334 # and what to update if there is, $rval.
2335
2336 if (!$rvictim and $subfield =~/^i[12]$/) {
2337 mycarp "Field $field does not exist. Can only add indicator $subfield to existing fields.";
2338 return undef;
2339 }
2340 #Now we need to find first match in @ufield.
2341 my $usub = undef;
2342 $usub=$ufield[1] if $subfield eq 'i1';
2343 $usub=$ufield[2] if $subfield eq 'i2';
2344
2345 for(my $i=3;$i<@ufield;$i = $i+2) {
2346 my $sub = $ufield[$i];
2347 if ($sub eq $subfield) {
2348 $usub = $ufield[$i+1];
2349 last;
2350 }
2351 }
2352 mycarp(
2353 "Did not find $subfield in spec (".
2354 join " ",@ufield . ")"
2355 ) if !defined($usub);
2356
2357 if (!scalar(@fieldrefs)) {
2358 my @newfield = ($field, ' ',' ', $subfield =>$usub);
2359 my $rafields;
2360 $marcrec->field_updatehook(\@newfield);
2361 $rafields->[0] = \@newfield;
2362 return $marcrec->updatefields($template,$rafields);
2363 }
2364 #The general insert case.
2365 if (!$rvictim and scalar(@fieldrefs)) {
2366 $rvictim = $fieldrefs[0];
2367 $marcrec->insertpos($subfield,$usub,$rvictim);
2368 $marcrec->field_updatehook($rvictim);
2369 $marcrec->rebuild_map($field) if $do_rebuild_map;
2370 return 1; # $rvictim is now defined, so can't depend on future
2371 # control logic.
2372 }
2373 #The general replace case.
2374 if ($rvictim) {
2375 $$rval = $usub;
2376 $marcrec->field_updatehook($rvictim);
2377
2378 # The following line is unecessary for this class:
2379 # everything updates due to hard-coded ref
2380 # relationships in the index. Left so that subclasses
2381 # can do their thing with less over-ruling.
2382
2383 $marcrec->rebuild_map($field) if $do_rebuild_map;
2384 return 1;
2385 }
2386 } #end $field and $subfield
2387 }
2388
2389 ####################################################################
2390
2391 # updatefields() takes a template which specifies a
2392 # $do_rebuild_map and a field (needs the field in case $rafields->[0]
2393 # is empty). It also takes a ref to an array of fieldrefs formatted
2394 # like the output of getfields(), and replaces/creates the field
2395 # data. It assumes that it should remove the fields with the first tag
2396 # in the fieldrefs. It calls rebuild_map() if $do_rebuild_map.
2397
2398 ####################################################################
2399 sub updatefields { # rec
2400 my $marcrec = shift || return;
2401 my $template = shift;
2402
2403 my $do_rebuild_map = $template->{'rebuild_map'};
2404 my $tag = $template->{'field'};
2405 my $rafieldrefs = shift;
2406 my @fieldrefs = @$rafieldrefs;
2407
2408
2409 my $pos = 0;
2410 my $first=undef;
2411 my $last = $first; # Should be "Let the first be last". Misbegotten Perl syntax.
2412 my $firstpast = undef;
2413 my $len = 0;
2414 my @mfields = @{$marcrec->{'array'}};
2415 my $insertpos = undef;
2416 for (@mfields) {
2417 $first = $pos if ($_->[0] eq $tag and !defined($first)) ;
2418 $last = $pos if $_->[0] eq $tag;
2419 $firstpast = $pos if ($_->[0] >= $tag and !defined($firstpast)) ;
2420 $pos++;
2421 }
2422 $len = $last - $first +1 if defined($first);
2423 $insertpos = scalar(@mfields) if !defined($firstpast);
2424 $insertpos = $first if (defined($first));
2425 $insertpos = $firstpast unless $insertpos;
2426 splice @{$marcrec->{'array'}},$insertpos,$len,@fieldrefs;
2427 $marcrec->rebuild_map($tag) if $do_rebuild_map;
2428 }
2429
2430 ####################################################################
2431 # output() will call the appropriate output method using the marc #
2432 # object and desired format parameters. #
2433 ####################################################################
2434 sub output {
2435 my $marcrec=shift;
2436 my $args=shift;
2437 my $output = "";
2438 my $newline = $args->{'lineterm'} || "\n";
2439
2440 $marcrec->add_005($args) if ($args->{'file'} or $args->{'add_005s'});
2441
2442 unless (exists $args->{'format'}) {
2443 # everything to string
2444 $args->{'format'} = "usmarc";
2445 $args->{'lineterm'} = $newline;
2446 }
2447 if ($args->{'format'} =~ /marc$/oi) {
2448 $output = _writemarc($marcrec,$args);
2449 }
2450 elsif ($args->{'format'} =~ /marcmaker$/oi) {
2451 $output = _marcmaker($marcrec,$args);
2452 }
2453 elsif ($args->{'format'} =~ /ascii$/oi) {
2454 $output = _marc2ascii($marcrec,$args);
2455 }
2456 elsif ($args->{'format'} =~ /html$/oi) {
2457 $output .= _marc2html($marcrec,$args);
2458 }
2459 elsif ($args->{'format'} =~ /html_header$/oi) {
2460 $output = "Content-type: text/html\015\012\015\012";
2461 }
2462 elsif ($args->{'format'} =~ /html_start$/oi) {
2463 if ($args->{'title'}) {
2464 $output = "<html><head><title>$args->{'title'}</title></head>";
2465 $output .= "$newline<body>";
2466 }
2467 else {
2468 $output = "<html><body>";
2469 }
2470 }
2471 elsif ($args->{'format'} =~ /html_body$/oi) {
2472 $output =_marc2html($marcrec,$args);
2473 }
2474 elsif ($args->{'format'} =~ /html_footer$/oi) {
2475 $output = "$newline</body></html>$newline";
2476 }
2477 elsif ($args->{'format'} =~ /urls$/oi) {
2478 $output .= _urls($marcrec,$args);
2479 }
2480 elsif ($args->{'format'} =~ /isbd$/oi) {
2481 $output = _isbd($marcrec,$args);
2482 }
2483 elsif ($args->{'format'} =~ /xml/oi) {
2484 mycarp "XML formats are now handled by MARC::XML" if ($^W);
2485 return;
2486 }
2487 if ($args->{'file'}) {
2488 if ($args->{'file'} !~ /^>/) {
2489 mycarp "Don't forget to use > or >> with output file name";
2490 return;
2491 }
2492 open (OUT, $args->{file}) || mycarp "Couldn't open file: $!";
2493 #above quote is bad if {file} is tainted. Is probably unecessary.dgl.
2494 binmode OUT;
2495 print OUT $output;
2496 close OUT || mycarp "Couldn't close file: $!";
2497 return 1;
2498 }
2499 #if no filename was specified return the output so it can be grabbed
2500 else {
2501 return $output;
2502 }
2503 }
2504
2505 ####################################################################
2506
2507 # add_005s takes a template and adds current 005s to the elements of
2508 # $marc mentioned in $template->{records}
2509
2510 ####################################################################
2511 sub add_005 {
2512 my $marcrec=shift;
2513 my $time = shift;
2514 my @m005 = ('005', $time );
2515 $marcrec->updatefirst({field=>'005'},@m005);
2516 }
2517
2518 ##############################################################
2519 sub _joinfield { # rec
2520 my $marcrec=shift;
2521 my ($rfield,$field,$delim)=@_;
2522 my $result;
2523 return $rfield->[1] if $field<10;
2524
2525 if ($delim) {
2526 foreach (my $i=3; $i<$#$rfield; $i+=2) {
2527 $result.=$delim.$rfield->[$i].$rfield->[$i+1];
2528 }
2529 return $result;
2530 }
2531
2532 for (my $i=4; $i<=$#$rfield; $i=$i+2) {
2533 $result.=$rfield->[$i];
2534 $result.=" " unless $result=~/ $/;
2535 }
2536 return $result;
2537 }
2538
2539 ####################################################################
2540
2541 # getmatch() takes a subfield code (can be an indicator) and a fieldref
2542 # Returns 0 or a ref to the value to be updated.
2543
2544 ####################################################################
2545 sub getmatch { # rec
2546 my $marcrec = shift || return;
2547 my $subf = shift;
2548 my $rfield = shift;
2549 my $tag = $rfield->[0];
2550 if ($tag < 10) {mycarp "can't find subfields or indicators for control fields"; return undef}
2551 return \$rfield->[1] if $subf eq 'i1';
2552 return \$rfield->[2] if $subf eq 'i2';
2553
2554 for (my $i=3;$i<@$rfield;$i+=2) {
2555 return \$rfield->[$i+1] if $rfield->[$i] eq $subf;
2556 }
2557 return 0;
2558 }
2559
2560 ####################################################################
2561
2562 # deletesubfield() takes a subfield code (can not be an indicator) and a
2563 # fieldref. Deletes the subfield code and its value in the fieldref at
2564 # the first match on subfield code. Assumes there is an exact
2565 # subfield match in $fieldref.
2566
2567 ####################################################################
2568 sub deletesubfield { # rec
2569 my $marcrec = shift || return;
2570 my $subf = shift;
2571 my $rfield = shift;
2572 my $tag = $rfield->[0];
2573 if ($tag < 10) {mycarp "Can't use subfields or indicators for control fields"; return undef}
2574
2575 if ($subf =~/i[12]/) {mycarp "Can't delete an indicator."; return undef}
2576 my $i=3;
2577 for ($i=3;$i<@$rfield;$i+=2) {
2578 last if $rfield->[$i] eq $subf;
2579 }
2580 splice @$rfield,$i,2;
2581
2582 }
2583
2584 ####################################################################
2585
2586 # insertpos() takes a subfield code (can not be an indicator), a
2587 # value, and a fieldref. Updates the fieldref with the first
2588 # place that the fieldref can match. Assumes there is no exact
2589 # subfield match in $fieldref.
2590
2591 ####################################################################
2592 sub insertpos { # rec
2593 my $marcrec = shift || return;
2594 my $subf = shift;
2595 my $value = shift;
2596 my $rfield = shift;
2597 my $tag = $rfield->[0];
2598 if ($tag < 10) {mycarp "Can't use subfields or indicators for control fields"; return undef}
2599
2600 if ($subf =~/i[12]/) {mycarp "Can't insert past an indicator."; return undef}
2601 my $i=3;
2602 for ($i=3;$i<@$rfield;$i+=2) {
2603 last if $rfield->[$i] gt $subf;
2604 }
2605 splice @$rfield,$i,0,$subf,$value;
2606 }
2607
2608 ####################################################################
2609
2610 # getfirstvalue() will return the first value of a field or subfield
2611 # or indicator or i12 in a particular record found in the MARC
2612 # object. It does not depend on the index being up to date.
2613
2614 ####################################################################
2615 sub getfirstvalue { # rec
2616 my $marcrec= shift;
2617 my $template=shift;
2618 return unless (ref($template) eq "HASH");
2619 my $field = $template->{'field'};
2620 my $delim = $template->{'delimiter'};
2621 my $subfield;
2622 $subfield = $template->{'subfield'} if $template->{'subfield'};
2623
2624 if (not($field)) {mycarp "You must specify a field"; return}
2625 unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return}
2626 my @fieldrefs = grep {$_->[0] eq $field} @{$marcrec->{'array'}};
2627 return unless @fieldrefs;
2628 if ($field and not $subfield) {
2629 return $marcrec->_joinfield($fieldrefs[0],$field,$delim);
2630 } elsif ($field and $subfield) {
2631 if ($field <10) {mycarp "There are no subfields or indicators for control fields";return}
2632 return $fieldrefs[0][1].$fieldrefs[0][2] if $subfield eq 'i12';
2633 my $rsubf = undef;
2634 foreach my $fieldref (@fieldrefs) {
2635 $rsubf =$marcrec->getmatch($subfield,$fieldref);
2636 return $$rsubf if $rsubf;
2637 }
2638 return undef unless $rsubf;
2639 }
2640 }
2641 ####################################################################
2642 # getvalue() will return the value of a field or subfield in a #
2643 # particular record found in the MARC object #
2644 ####################################################################
2645 sub getvalue { # rec
2646 my $marcrec = shift;
2647 my $template=shift;
2648 return unless (ref($template) eq "HASH");
2649 my $params = _params($template,@_);
2650
2651 my $field = $params->{field};
2652 if (not($field)) {mycarp "You must specify a field"; return}
2653 unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return}
2654 my $subfield = $params->{subfield};
2655 my $delim = $params->{delimiter};
2656 my @values;
2657 if ($field and not($subfield)) {
2658 return unless exists $marcrec->{$field};
2659 if ($field eq '000') { return $marcrec->{'000'}[1] };
2660 foreach my $rfield (@{$marcrec->{$field}{field}}) {
2661 push @values,
2662 $marcrec->_joinfield($rfield,$field,$delim);
2663 }
2664 return @values;
2665 }
2666 elsif ($field and $subfield) {
2667 return unless exists $marcrec->{$field};
2668 return unless exists $marcrec->{$field}{$subfield};
2669 if ($subfield eq "i1" || $subfield eq "i2" || $subfield eq "i12") {
2670 my @shortone = @{$marcrec->{$field}{field}};
2671 foreach my $rfield (@shortone) {
2672 if ($subfield eq 'i1') {
2673 push @values, $rfield->[1];
2674 }
2675 elsif ($subfield eq 'i2') {
2676 push @values, $rfield->[2];
2677 }
2678 else {
2679 push @values, $rfield->[1].$rfield->[2];
2680 }
2681 }
2682 return @values;
2683 }
2684 foreach my $rval (@{$marcrec->{$field}{$subfield}}) {
2685 push @values, $$rval;
2686 }
2687 return @values;
2688 }
2689 }
2690
2691 ####################################################################
2692 #Returns LDR at $record. #
2693 ####################################################################
2694 sub ldr { # rec
2695 my $marcrec = shift;
2696 return $marcrec->{array}[0][1];
2697 }
2698
2699
2700 ####################################################################
2701 #Takes a record number and returns a hash of fields. #
2702 #Needed to determine the format (BOOK, VIS, etc) of #
2703 #the record. #
2704 #Folk also like to know what Ctrl, Desc etc are. #
2705 ####################################################################
2706 sub unpack_ldr { # rec
2707 my $marcrec = shift;
2708
2709 my $ldr = $marcrec->ldr();
2710 my $rhldr = $marcrec->_unpack_ldr($ldr);
2711 $marcrec->{unp_ldr}=$rhldr;
2712 return $rhldr;
2713 }
2714
2715
2716 sub _unpack_ldr { # rec
2717 my ($marcrec,$ldr) = @_;
2718
2719 my %ans=();
2720
2721 my @fields=unpack($LDR_TEMPLATE,$ldr);
2722 for (@LDR_FIELDS) {
2723 $ans{$_}=shift @fields;
2724 }
2725 return \%ans;
2726 }
2727
2728
2729 ####################################################################
2730 #Takes a record number. #
2731 #Returns the unpacked ldr as a ref to hash from the ref in $self. #
2732 #Does not overwrite hash from ldr. #
2733 ####################################################################
2734 sub get_hash_ldr { # rec
2735 my $marcrec = shift;
2736 return undef unless exists($marcrec->{unp_ldr});
2737 return $marcrec->{unp_ldr};
2738 }
2739
2740 ####################################################################
2741 # Takes a record number and updates the corresponding ldr if there
2742 # is a hashed form. Returns undef unless there is a hash. Else
2743 # returns $ldr.
2744 ####################################################################
2745 sub pack_ldr { # rec
2746 my $marcrec = shift;
2747 return undef unless exists($marcrec->{unp_ldr});
2748 my $rhldr = $marcrec->{unp_ldr};
2749 my $ldr = $marcrec -> _pack_ldr($rhldr);
2750 $marcrec->{array}[0][1] = $ldr;
2751 return $ldr;
2752 }
2753
2754 ####################################################################
2755 #Takes a ref to hash version of the LDR and returns a string #
2756 # version #
2757 ####################################################################
2758 sub _pack_ldr { # rec
2759
2760 my ($marcrec,$rhldr) = @_;
2761 my @fields=();
2762
2763 for (@LDR_FIELDS) {
2764 push @fields,$rhldr->{$_};
2765 }
2766 my $ans = pack($LDR_TEMPLATE,@fields);
2767 return $ans;
2768 }
2769
2770 ####################################################################
2771 #Takes a string record number. #
2772 #Returns a the format necessary to pack/unpack 008 fields correctly#
2773 ####################################################################
2774 sub bib_format { # rec
2775 my ($marcrec)=@_;
2776 $marcrec->pack_ldr();
2777 my $ldr = $marcrec->ldr();
2778 return $marcrec->_bib_format($ldr);
2779 }
2780
2781 sub _bib_format { # rec
2782 my ($marcrec,$ldr)=@_;
2783 my $rldr=$marcrec->_unpack_ldr($ldr);
2784 my ($type,$bib_lvl) = ($rldr->{'Type'},$rldr->{'BLvl'});
2785 return "UNKNOWN (Type $type Bib_Lvl $bib_lvl)" unless ($type=~/[abcdefgijkmprot]/ &&
2786 (($bib_lvl eq "") or
2787 $bib_lvl=~/[abcdms]/)
2788 );
2789
2790 return "BOOKS" if (
2791 (
2792 ($type eq "a") && !($bib_lvl =~/[bs]/)
2793 )
2794 or $type eq "t" or $type eq "b"
2795 ); #$type b is obsolete, 'tho.
2796 return "SERIALS" if (
2797 ($type eq "a") &&
2798 ($bib_lvl =~/[bs]/)
2799 );
2800 return "COMPUTER_FILES" if ($type =~/m/);
2801 return "MAPS" if ($type =~/[ef]/);
2802 return "MUSIC" if ($type =~/[cdij]/);
2803 return "VIS" if ($type =~/[gkro]/);
2804 return "MIX" if ($type =~/p/);
2805 return "UNKNOWN (Type $type Bib_Lvl $bib_lvl) ??"; # Shouldn't happen
2806 }
2807
2808 ####################################################################
2809 #Takes a record number. #
2810 #Returns the unpacked 008 as a ref to hash. Installs ref in $self. #
2811 ####################################################################
2812 sub unpack_008 { # rec
2813 my ($marcrec) = @_;
2814 my ($ff_string) = $marcrec->getfirstvalue({field=>'008'});
2815 my $bib_format = $marcrec->bib_format();
2816 my $rh008= $marcrec->_unpack_008($ff_string,$bib_format);
2817 $marcrec->{unp_008}=$rh008;
2818 return $rh008;
2819 }
2820
2821 sub _unpack_008 { # rec
2822 my ($marcrec,$ff_string,$bib_format) = @_;
2823 my %ans=();
2824
2825 my $ff_templ=$FF_TEMPLATE{$bib_format};
2826 my $raff_fields=$FF_FIELDS{$bib_format};
2827 if ($bib_format =~/UNKNOWN/) {
2828 mycarp "Format is $bib_format";
2829 return;
2830 }
2831 my @fields=unpack($ff_templ,$ff_string);
2832 for (@{$raff_fields}) {
2833 $ans{$_}=shift @fields;
2834 }
2835 return \%ans;
2836 }
2837
2838 ####################################################################
2839 #Takes a record number. #
2840 #Returns the unpacked 008 as a ref to hash from the ref in $self. #
2841 #Does not overwrite hash from 008 field. #
2842 ####################################################################
2843 sub get_hash_008 { # rec
2844 my ($marcrec)=@_;
2845 return undef unless exists($marcrec->{unp_008});
2846 return $marcrec->{unp_008};
2847 }
2848
2849 ####################################################################
2850 #Takes a record number. Flushes hashes to 008 and ldr. #
2851 #Updates the 008 field from an installed fixed field hash.
2852 #Returns undef unless there is a hash, else returns the 008 field #
2853 ####################################################################
2854 sub pack_008 { # rec
2855 my ($marcrec) = @_;
2856 $marcrec->pack_ldr();
2857 my $ldr = $marcrec->ldr();
2858 my $rhff = $marcrec->get_hash_008();
2859 return undef unless $rhff;
2860 my $ff_string = $marcrec->_pack_008($ldr,$rhff);
2861 $marcrec->updatefirst({field=>'008'},$ff_string);
2862 return $ff_string;
2863 }
2864
2865 ####################################################################
2866 #Takes LDR and ref to hash of unpacked 008 #
2867 #Returns string version of 008 *without* newlines. #
2868 ####################################################################
2869 sub _pack_008 { # rec
2870 my ($marcrec,$ldr,$rhff) = @_;
2871 my $bib_format = $marcrec->_bib_format($ldr);
2872 my $ans = "";
2873 my @fields = ();
2874 for (@{$FF_FIELDS{$bib_format}}) {
2875 push @fields, $rhff->{$_};
2876 }
2877 $ans = pack($FF_TEMPLATE{$bib_format},@fields);
2878 return $ans;
2879 }
2880
2881 ####################################################################
2882
2883 # as_string returns a newline-\c^ separated version of the record.
2884 # Subclasses may need to override this. If so, to make Tie happy,
2885 # they should override from_string. 000 is ldr.
2886
2887 ####################################################################
2888
2889 sub as_string {
2890 my $marcrec=shift;
2891 my $SEP = "\cJ"; #unix newline
2892 my $ans = "";
2893 for (@{$marcrec->{'array'}}) {
2894 my $tag = $_->[0];
2895 if ($tag < 10) {
2896 $ans .= "$tag $_->[1]$SEP";
2897 next;
2898 }
2899 $ans .= "$tag $_->[1]$_->[2] ";
2900 foreach (my $i=3; $i<$#$_; $i+=2) {
2901 $ans .="\c_$_->[$i]$_->[$i+1]";
2902 }
2903 $ans .=$SEP;
2904 }
2905 return $ans;
2906 }
2907
2908 ####################################################################
2909
2910 # from_string takes a newline-\c^ separated version of the record
2911 # and replaces the {array} information from that information.
2912 # Subclasses may need to override this. If so, to make Tie happy,
2913 # they should override as_string. 000 is ldr.
2914
2915 ####################################################################
2916 sub from_string {
2917 my $marcrec=shift;
2918 my $string = shift;
2919 my $do_rebuild_map = shift;
2920 my $SEP = "\cJ"; #unix newline
2921 my @lines = split /$SEP/,$string;
2922 @{$marcrec->{'array'}}=();
2923 for (@lines) {
2924 next if /^\s*$/;
2925 my $tag = substr($_,0,3);
2926 if ($tag < 10) {
2927 my $contents = substr($_,4);
2928 push @{$marcrec->{'array'}}, [$tag, $contents];
2929 next;
2930 }
2931 my ($i1,$i2,$sub_string) = (substr($_,4,1),substr($_,5,1),substr($_,7));
2932 my @field = ($tag,$i1,$i2);
2933 my @subfields = split /\c_(.)/,$sub_string;
2934 shift @subfields if $subfields[0] eq ''; # feature of split.
2935 push @field,@subfields;
2936 push @{$marcrec->{'array'}}, [@field];
2937 }
2938 $marcrec->rebuild_map_all() if $do_rebuild_map;
2939 }
2940
2941 1; # so the require or use succeeds
2942
2943 __END__
2944
2945
2946 ####################################################################
2947 # D O C U M E N T A T I O N #
2948 ####################################################################
2949
2950 =pod
2951
2952 =head1 NAME
2953
2954 MARC.pm - Perl extension to manipulate MAchine Readable Cataloging records.
2955
2956 =head1 SYNOPSIS
2957
2958 use MARC;
2959
2960 # constructors
2961 $x=MARC->new();
2962 $x=MARC->new("filename","fileformat");
2963 $x->openmarc({file=>"makrbrkr.mrc",'format'=>"marcmaker",
2964 increment=>"5", lineterm=>"\n",
2965 charset=>\%char_hash});
2966 $record_num=$x->createrecord({leader=>"00000nmm 2200000 a 4500"});
2967
2968 # input/output operations
2969 $y=$x->nextmarc(10); # increment
2970 $x->closemarc();
2971 print $x->marc_count();
2972 $x->deletemarc({record=>'2',field=>'110'});
2973 $y=$x->selectmarc(['4','21-50','60']);
2974
2975 # character translation
2976 my %inc = %{$x->usmarc_default()}; # MARCMaker input charset
2977 my %outc = %{$x->ustext_default()}; # MARCBreaker output charset
2978
2979 # data queries
2980 @records = $x->searchmarc({field=>"245"});
2981 @records = $x->searchmarc({field=>"260",subfield=>"c",
2982 regex=>"/19../"});
2983 @records = $x->searchmarc({field=>"245",notregex=>"/huckleberry/i"});
2984 @results = $x->getvalue({record=>'12',field=>'856',subfield=>'u'});
2985
2986 # header and control field operations
2987 $rldr = $x->unpack_ldr($record);
2988 print "Desc is $rldr->{Desc}";
2989 next if ($x->bib_format($record) eq 'SERIALS');
2990 $rff = $x->unpack_008($record);
2991 last if ($rff->{'Date1'}=~/00/ or $rff->{'Date2'}=~/00/);
2992
2993 # data modifications
2994 $x->addfield({record=>"2", field=>"245",
2995 i1=>"1", i2=>"4", ordered=>'y', value=>
2996 [a=>"The adventures of Huckleberry Finn /",
2997 c=>"Mark Twain ; illustrated by E.W. Kemble."]});
2998
2999 my $update245 = {field=>'245',record=>2,ordered=>'y'};
3000 my @u245 = $x->getupdate($update245);
3001 $x->deletemarc($update245);
3002 $x->addfield($update245, @u245_modified);
3003
3004 # outputs
3005 $y = $x->output({'format'=>"marcmaker", charset=>\%outc});
3006 $x->output({file=>">>my_text.txt",'format'=>"ascii",record=>2});
3007 $x->output({file=>">my_marcmaker.mkr",'format'=>"marcmaker",
3008 nolinebreak=>'y',lineterm=>'\n'});
3009 $x->output({file=>">titles.html",'format'=>"html", 245=>"Title: "});
3010
3011 # manipulation of individual marc records.
3012 @recs = $x[1..$#$x];
3013 grep {$_->unpack_ldr() && 0} @recs;
3014 @LCs = grep {$_->unp_ldr{Desc} eq 'a' &&
3015 $_->getvalue({field=>'040'}) =~/DLC\c_.DLC/} @recs;
3016 foreach my $rec (@LCs) {
3017 print $rec->output({format=>'usmarc'});
3018 }
3019
3020 # manipulation as strings.
3021 foreach my $rec (@LCs) {
3022 my $stringvar = $rec->as_string();
3023 $stringvar=~s[^(
3024 100\s # main entries of this stripe..
3025 ..\s # (don't care about indicators)
3026 \c_.\s*
3027 )(\S) # take the first letter..
3028 ] [
3029 ${1}uc($2) # and upcase it. All authors have
3030 # upcase first letters in my library.
3031 ]xm; # x means 'ignore whitespace and allow
3032 # embedded comments'.
3033 $rec->from_string($stringvar);
3034 my ($i2,$article) = $stringvar =~/245 .(.) \c_.(.{0,9})/;
3035 $article = substr($article,0,$i2) if $i2=~/\d/;
3036 print "article $article is not common" unless $COMMON_ARTS{$article};
3037 }
3038
3039
3040
3041 =head1 DESCRIPTION
3042
3043 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").
3044
3045 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.
3046
3047 =head2 Types of Conversions:
3048
3049 =over 4
3050
3051 =item *
3052
3053 MARC -> ASCII : separates the MARC fields out into separate lines
3054
3055 =item *
3056
3057 MARC <-> MARCMaker : The MARCMaker format is a format that was developed by the
3058 I<Library of Congress> for use with their DOS based I<MARCMaker> and
3059 I<MARCBreaker> utilities. This format is particularly useful for making
3060 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
3061
3062 =item *
3063
3064 MARC -> HTML : The MARC to HTML conversion creates an HTML file
3065 from the fields and field labels that you supply. You could possibly use
3066 this to create HTML bibliographies from a batch of MARC records.
3067
3068 =item *
3069
3070 MARC E<lt>-E<gt> XML : XML support is handled by MARC::XML which is a subclass of MARC.pm and is
3071 also available for download from the CPAN.
3072
3073 =item *
3074
3075 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!
3076
3077 =back
3078
3079 =head2 Downloading and Installing
3080
3081 =over 4
3082
3083 =item Download
3084
3085 The module is provided in standard CPAN distribution format. It will
3086 extract into a directory MARC-version with any necessary subdirectories.
3087 Change into the MARC top directory. Download the latest version from
3088 http://www.cpan.org/modules/by-module/MARC/
3089
3090 =item Unix
3091
3092 perl Makefile.PL
3093 make
3094 make test
3095 make install
3096
3097 =item Win9x/WinNT/Win2000
3098
3099 perl Makefile.PL
3100 perl test.pl
3101 perl install.pl
3102
3103 =item Test
3104
3105 Once you have installed, you can check if Perl can find it. Change to some
3106 other directory and execute from the command line:
3107
3108 perl -e "use MARC"
3109
3110 If you do not get any response that means everything is OK! If you get an
3111 error like I<Can't locate method "use" via package MARC>.
3112 then Perl is not able to find MARC.pm--double check that the file copied
3113 it into the right place during the install.
3114
3115 =back
3116
3117 =head2 Todo
3118
3119 =over 4
3120
3121 =item *
3122
3123 Support for other MARC formats (UKMARC, FINMARC, etc).
3124
3125 =item *
3126
3127 Create a map and instructions for using and extending the MARC.pm data
3128 structure.
3129
3130 =item *
3131
3132 Develop better error catching mechanisms.
3133
3134 =item *
3135
3136 Support for MARC E<lt>-E<gt> Unicode character conversions.
3137
3138 =item *
3139
3140 MARC E<lt>-E<gt> EAD (Encoded Archival Description) conversion?
3141
3142 =item *
3143
3144 MARC E<lt>-E<gt> DC/RDF (Dublin Core Metadata encoded in the Resource Description Framework)?
3145
3146 =back
3147
3148 =head2 Web Interface
3149
3150 A web interface to MARC.pm is available at
3151 http://libstaff.lib.odu.edu/cgi-bin/marc.cgi where you can upload records and
3152 observe the results. If you'd like to check out the cgi script take a look at
3153 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.
3154
3155 =head2 Option Templates
3156
3157 A MARC record is a complex structure. Hence, most of the methods have a number
3158 of options. Since a series of operations frequently uses many the same options
3159 for each method, you can create a single variable that forms a "template" for
3160 the desired options. The variable points to a hash - and the hash keys have
3161 been selected so the same hash works for all of the related methods.
3162
3163 my $loc852 = {record=>1, field=>'852', ordered=>'y'};
3164 my ($found) = $x->searchmarc($loc852);
3165 if (defined $found) {
3166 my @m852 = $x->getupdate($loc852);
3167 $x->deletemarc($loc852);
3168 # change @m852 as desired
3169 $x->updaterecord($loc852, @m852fix);
3170 }
3171 else {
3172 $x->addfield($loc852, @m852new);
3173 }
3174
3175 The following methods are specifically designed to work together using
3176 I<Option Templates>. The B<required> options are shown as B<bold>. Any
3177 C<(default)> options are shown in parentheses. Although B<deletemarc()>
3178 permits an array for the I<record> option, a single I<record> should be
3179 used in a Template. The I<subfield> option must not be used in a
3180 Template that uses both B<deletemarc> and one of the methods that
3181 acts on a complete I<field> like B<addfield()>. The I<value> option
3182 must not be used with B<updaterecord()>.
3183
3184
3185 =over 4
3186
3187 deletemarc() - field (all), record (all), subfield [supplemental]
3188
3189 searchmarc() - B<field>, regex, notregex, subfield [supplemental]
3190
3191 getvalue() - B<record>, B<field>, subfield, delimiter [supplemental]
3192
3193 getupdate() - B<record>, B<field>
3194
3195 addfield() - B<record>, B<field>, i1 (' '), i2 (' '), value, ordered ('y')
3196
3197 updaterecord() - B<record>, B<field>, i1 (' '), i2 (' '), ordered ('y')
3198
3199 =back
3200
3201 The methods that accept a I<subfield> option also accept specifying it as a
3202 supplemental parameter. Supplemental parameters append/overwrite the hash
3203 values specified in the template.
3204
3205 $x->deletemarc($loc852, 'subfield','k');
3206
3207 my $f260 = {field=>"260",regex=>"/19../"};
3208 my @records=$x->searchmarc($f260,'subfield','c');
3209 foreach $found (@records) {
3210 $value = $x->getvalue($f260,'record',"$found",'field',"245");
3211 print "TITLE: $value\n";
3212 }
3213
3214 =head1 METHODS
3215
3216
3217 Here is a list of the methods in MARC.pm that are available to you for reading in, manipulating and outputting MARC data.
3218
3219 =head2 new()
3220
3221 Creates a new MARC object.
3222
3223 $x = MARC->new();
3224
3225 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.
3226
3227 $x = MARC->new("mymarc.dat","usmarc");
3228 $x = MARC->new("mymarcmaker.mkr","marcmaker");
3229
3230 Creates a new MARC::Rec object.
3231
3232 $rec=MARC::Rec->new();
3233 $rec=MARC::Rec->new($filehandle,"usmarc");
3234
3235 MARC::Rec objects are typically created by reading from a filehandle using nextrec()
3236 and a proto MARC::Rec object or by directly stuffing the @{$rec->{'array'}} array.
3237
3238
3239
3240 =head2 openmarc()
3241
3242 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.
3243
3244 $x = new MARC;
3245 $x->openmarc({file=>"mymarc.dat",'format'=>"usmarc",
3246 increment=>"1"});
3247 $x->openmarc({file=>"mymarcmaker.mkr",'format'=>"marcmaker",
3248 increment=>"5"});
3249
3250 note: openmarc() will return the number of records read in. If the file opens
3251 successfully, but no records are read, it returns C<"0 but true">. For example:
3252
3253 $y=$x->openmarc({file=>"mymarc.dat",'format'=>"usmarc",
3254 increment=>"5"});
3255 print "Read in $y records!";
3256
3257 When the I<MARCMaker> format is specified, the I<lineterm> parameter can be
3258 used to override the CRLF line-ending default (the format was originally
3259 released for MS-DOS). A I<charset> parameter accepts a hash-reference to a
3260 user supplied character translation table. The "usmarc.txt" table supplied
3261 with the LoC. MARCMaker utility is used internally as the default. You can
3262 use the B<usmarc_default> method to get a hash-reference to it if you only
3263 want to modify a couple of characters. See example below.
3264
3265 $x->openmarc({file=>"makrbrkr.mrc",'format'=>"marcmaker",
3266 increment=>"5",lineterm=>"\n",
3267 charset=>\%char_hash});
3268
3269 =head2 nextmarc()
3270
3271 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.
3272
3273 $x->nextmarc();
3274 $x->nextmarc(10);
3275 $x->nextmarc(-1);
3276
3277 note: Similar to openmarc(), nextmarc() will return the number of records read in.
3278
3279 $y=$x->nextmarc();
3280 print "$y more records read in!";
3281
3282 =head2 nextrec()
3283
3284 MARC:Rec instances can read from a filehandle and produce a new MARC::Rec instance.
3285 If nextrec is passed a string, it will read from that instead. The string should be
3286 formatted according to the {format} field of the instance.
3287
3288 Cases where a new instance cannot be created are classified by a status value:
3289
3290 my ($newrec,$status) = $rec->nextrec();
3291
3292 $status is undefined if we are at the end of the filehandle. If the
3293 data read from the filehandle cannot be made into a marc record,
3294 $status will be negative. For example, $status is -1 if there is a
3295 distinction between recsize and leader definition of recsize, and -2
3296 if the leader is not numeric.
3297
3298 An idiom for reading records incrementally with MARC::Recs is:
3299
3300 my $proto=MARC::Rec->new($filehandle,$format);
3301 while (1) {
3302 my ($rec,$status)=$proto->nextrec();
3303 last unless $status;
3304 die "Bad record, bad, bad record: error $status"
3305 if $status <0;
3306 print $rec->output({$format=>'ascii'});
3307 # or replace print and output with your own functions/methods.
3308 }
3309 close $filehandle or die "File $filehandle is not happy on close\n";
3310
3311 If you are getting records from an external source as strings, the idiom is:
3312
3313 my $proto=MARC::Rec->new($filehandle,$format);
3314 while (1) {
3315 my $string = get_external_marc();
3316 last unless $string;
3317 my ($rec,$status)=$proto->nextrec($string);
3318 last unless $status;
3319 die "Bad record, bad, bad record: error $status"
3320 if $status <0;
3321 print $rec->output({$format=>'ascii'});
3322 # or replace print and output with your own functions/methods.
3323 }
3324
3325
3326 =head2 closemarc()
3327
3328 If you are finished reading in records from a file you should close it immediately.
3329
3330 $x->closemarc();
3331
3332 =head2 add_map()
3333
3334 add_map() takes a recnum and a ref to a field in ($tag,
3335 $i1,$i2,a=>"bar",...) or ($tag, $field) formats and will append to the
3336 various indices that we have hanging off that record. It is intended
3337 for use in creating records de novo and as a component for
3338 rebuild_map(). It carefully does not copy subfield values or entire
3339 fields, maintaining some reference relationships. What this means for
3340 indices created with add_map that you can directly edit subfield
3341 values in $marc->[recnum]{array} and the index will adjust
3342 automatically. Vice-versa, if you edit subfield values in
3343 $marc->{recnum}{tag}{subfield_code} the fields in
3344 $marc->[recnum]{array} will adjust. If you change structural
3345 information in the array with such an index, you must rebuild the part
3346 of the index related to the current tag (and possibly the old tag if
3347 you change the tag).
3348
3349 use MARC 1.02;
3350 while (<>) {
3351 chomp;
3352 my ($author,$title) = split(/\t/);
3353 my $rnum = $x->createrecord({leader=>
3354 "00000nmm 2200000 a 4500"});
3355
3356 my @auth = (100, ' ', ' ', a=>$author);
3357 my @title = (245, ' ', ' ', a=>$title);
3358 push @{$x->[$rnum]{array}}, \@auth;
3359 $x->add_map($rnum,\@auth);
3360 push @{$x->[$rnum]{array}}, \@title;
3361 $x->add_map($rnum,\@title);
3362 }
3363
3364 MARC::Rec::add_map($rfield) does not need the record specification and has the same
3365 effect as add_map.
3366
3367 =head2 rebuild_map
3368
3369 rebuild_map takes a recnum and a tag and will synchronise the index with
3370 the array elements of the marc record at the recnum with that tag.
3371
3372 #Gonna change all 099's to 092's since this is a music collection.
3373 grep {$->[0] =~s/099/092} @{$x->[$recnum]{array}};
3374
3375 #Oops, now the index is out of date on the 099's...
3376 $x->rebuild_map($recnum,099);
3377 #... and the 092's since we now have new ones.
3378 $x->rebuild_map($recnum,092);
3379 #All fixed.
3380
3381 MARC::Rec::rebuild_map($tag) does not need the record number and has the same effect
3382 as rebuild_map.
3383
3384 =head2 rebuild_map_all
3385
3386 rebuild_map takes a recnum and will synchronise the index with
3387 the array elements of the marc record at the recnum.
3388
3389 MARC::Rec::rebuild_map_all() does not need the record number and has the same effect
3390 as rebuild_map_all.
3391
3392 =head2 getfields
3393
3394 getfields takes a template and returns an array of fieldrefs from the
3395 record number implied by that template. The fields referred are
3396 fields from the $marc->[$recnum]{array} group. The fields are all
3397 fields from the first one with the tag from the template to the last
3398 with that tag. Some marc records (e.g. cjk) may have fields with other
3399 tags mixed in. Consecutive calls to updatefields with a different
3400 tag and the same record are probably a bad idea unless you have assurance
3401 that fields with the same tag are always together.
3402
3403 MARC::Rec::getfields is identical to getfields, but ignores any record
3404 specification in the template.
3405
3406 =head2 marc_count()
3407
3408 Returns the total number of records in a MARC object. This method was
3409 previously named B<length()>, but that conflicts with the Perl built-in
3410 of the same name. Use the new name, the old one is deprecated and will
3411 disappear shortly.
3412
3413 $length=$x->marc_count();
3414
3415 =head2 getfirstvalue()
3416
3417 getfirstvalue will return the first value of a field or subfield or
3418 indicator or i12 in a particular record found in the MARC object. It
3419 does not depend on the index being up to date.
3420
3421 MARC::Rec::getfirstvalue is identical to getfields, but ignores any record
3422 specification in the template.
3423
3424 =head2 getvalue()
3425
3426 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).
3427
3428 #get the 650 field(s)
3429 @results = $x->getvalue({record=>'1',field=>'650'});
3430
3431 #get the 650 field(s) with subfield delimiters (ie. |x |v etc)
3432 @results = $x->getvalue({record=>'1',field=>'650',delimiter=>'|'});
3433
3434 #get all of the subfield u's from the 856 field
3435 @results = $x->getvalue({record=>'12',field=>'856',subfield=>'u'});
3436
3437 MARC::Rec::getvalue($template) is identical to getvalue, but ignores any record specification.
3438
3439 =head2 unpack_ldr($record)
3440
3441 Returns a ref to a hash version of the record'th LDR.
3442 Installs the ref in $marc as $marc->[$record]{unp_ldr}
3443
3444 my $rldr = $x->unpack_ldr(1);
3445 print "Desc is $rldr{Desc}";
3446 my ($m040) = $x->getvalues({record=>'1',field=>'040'});
3447 print "First record is LC, let's leave it alone"
3448 if $rldr->{'Desc'} eq 'a' && $m040=~/DLC\s*\c_c\s*DLC/;
3449
3450 The hash version contains the following information:
3451
3452 Key 000-Pos length Function [standard value]
3453 --- ------- ------ --------
3454 rec_len 00-04 5 Logical Record Length
3455 RecStat 05 1 Record Status
3456 Type 06 1 Type of Record
3457 BLvl 07 1 Bibliographic Level
3458 Ctrl 08 1
3459 Undefldr 09-11 3 [x22]
3460 base_addr 12-16 5 Base Address of Data
3461 ELvl 17 1 Encoding Level
3462 Desc 18 1 Descriptive Cataloging Form
3463 ln_rec 19 1 Linked-Record Code
3464 len_len_field 20 1 Length "length of field" [4]
3465 len_start_char 21 1 Length "start char pos" [5]
3466 len_impl 22 1 Length "implementation dep" [0]
3467 Undef2ldr 23 1 [0]
3468
3469 MARC::Rec::unpack_ldr() is identical to unpack_ldr, but does not need the record number.
3470
3471 =head2 get_hash_ldr($record)
3472
3473 Takes a record number. Returns a ref to the cached version of the hash ldr if it exists.
3474 Does this *without* overwriting the hash ldr. Allows external code to safely manipulate
3475 hash versions of the ldr.
3476
3477 my $rhldr = $marc->get_hash_ldr($record);
3478 return undef unless $rhldr;
3479 $rhldr->{'Desc'} =~ s/a/b/;
3480 $ldr = $x->pack_ldr($record);
3481
3482 MARC::Rec::get_hash_ldr() is identical to get_hash_ldr, but does not need the record number.
3483
3484 =head2 pack_ldr($record)
3485
3486 Takes a record number. Updates the appropriate ldr.
3487
3488 $marc->[$record]{'unp_ldr'}{'Desc'} =~ s/a/b/;
3489 my $ldr = $x->pack_ldr($record);
3490 return undef unless $ldr;
3491
3492 MARC::Rec::pack_ldr() is identical to pack_ldr, but does not need the record number.
3493
3494 =head2 bib_format($record)
3495
3496 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.
3497
3498 foreach $record (1..$#$x) {
3499 next if $x->bib_format($record) eq 'SERIALS';
3500 # serials are hard
3501 do_something($x->[record]);
3502 }
3503
3504 MARC::Rec::bib_format() is identical to bib_format, but does not need the record number.
3505
3506 =head2 unpack_008($record)
3507
3508 Returns a ref to hash version of the 008 field, based on the field's value.
3509 Installs the ref as $marc->[$record]{unp_008}
3510
3511 foreach $record (1..$#$x) {
3512 my $rff = $x->unpack_008($record);
3513 print "Record $record: Y2K problem possible"
3514 if ($rff->{'Date1'}=~/00/ or $rff->{'Date2'}=~/00/);
3515 }
3516
3517 MARC::Rec::unpack_008() is identical to unpack_008, but does not need the record number.
3518
3519 =head2 get_hash_008($record)
3520
3521 Takes a record number. Returns a ref to the cached version of the hash 008 if it exists.
3522 Does this *without* overwriting the hash 008. Allows external code to safely manipulate
3523 hash versions of the 008.
3524
3525 my $rh008 = $marc->get_hash_008($record);
3526 return undef unless $rh008;
3527 $rh008->{'Date1'} =~ s/00/01/;
3528 my $m008 = $x->pack_008($record);
3529 return undef unless $m008;
3530
3531 MARC::Rec::get_hash_008() is identical to get_hash_008, but does not need the record number.
3532
3533 =head2 pack_008($record)
3534
3535 Takes a record number and updates the appropriate 008. Will force update of the
3536 ldr based on any existing hash version.
3537
3538 foreach $record (1..$#$x) {
3539 my $rff = $x->unpack_008($record);
3540 $rff->{'Date1'}='2000';
3541 print "Record:$record Y2K problem created";
3542 $x->pack_008($record);
3543 # New value is in the 008 field of $record'th marc
3544 }
3545
3546 MARC::Rec::pack_008() is identical to pack_008, but does not need the record number.
3547
3548 =head2 deletefirst()
3549
3550 deletefirst() takes a template. It deletes the field data for a first
3551 match, using the template and leaves the rest alone. If the template
3552 has a subfield element it deletes based on the subfield information in
3553 the template. If the last subfield of a field is deleted,
3554 deletefirst() also deletes the field. It complains about attempts to
3555 delete indicators. If there is no match, it does nothing. Deletefirst
3556 also rebuilds the map if the template asks for that
3557 $do_rebuild_map. Deletefirst returns the number of matches deleted
3558 (that would be 0 or 1), or undef if it feels grumpy (i.e. carps).
3559
3560 MARC::Rec::deletefirst($template) is identical to deletefirst, but ignores any record number
3561 specified by $template.
3562
3563 Most use of deletefirst is expected to be by MARC::Tie.
3564
3565
3566 =head2 deletemarc()
3567
3568 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.
3569
3570 #delete all the records in the object
3571 $x->deletemarc();
3572
3573 #delete records 1-5 and 7
3574 $x->deletemarc({record=>[1..5,7]});
3575
3576 #delete all of the 650 fields from all of the records
3577 $x->deletemarc({field=>'650'});
3578
3579 #delete the 110 field in record 2
3580 $x->deletemarc({record=>'2',field=>'110'});
3581
3582 #delete all of the subfield h's in the 245 fields
3583 $x->deletemarc({field=>'245',subfield=>'h'});
3584
3585 =head2 updatefirst()
3586
3587 updatefirst() takes a template, and an array from
3588 $marc->[recnum]{array}. It replaces/creates the field data for a first
3589 match, using the template and the array, and leaves the rest alone. If
3590 the template has a subfield element, (this includes indicators) it
3591 ignores all other information in the array and only updates/creates
3592 based on the subfield information in the array. If the template has no
3593 subfield information then indicators are left untouched unless a new
3594 field needs to be created, in which case they are left blank.
3595
3596 MARC::Rec::updatefirst($template) is identical to deletefirst, but ignores any record number
3597 specified by $template.
3598
3599 Most use of updatefirst() is expected to be from MARC::Tie.
3600 It does not currently provide a useful return value.
3601
3602 =head2 updatefields()
3603
3604 updatefields() takes a template which specifies recnum, a
3605 $do_rebuild_map and a field (needs the field in case $rafields->[0] is
3606 empty). It also takes a ref to an array of fieldrefs formatted like
3607 the output of getfields(), and replaces/creates the field data. It
3608 assumes that it should replace the fields with the first tag in the
3609 fieldrefs. It calls rebuild_map() if $do_rebuild_map.
3610
3611 #Let's kill the *last* 500 field.
3612 my $loc500 = {record=>1,field=>500,rebuild_map=>1};
3613 my @rfields = $x->getfields($loc500);
3614 pop @rfields;
3615 $x->updatefields($loc500,\@rfields);
3616
3617 =head2 getmatch()
3618
3619 getmatch() takes a subfield code (can be an indicator) and a fieldref.
3620 Returns 0 or a ref to the value to be updated.
3621
3622 #Let's update the value of i2 for the *last* 500
3623 my $loc500 = {record=>1,field=>500,rebuild_map=>1};
3624 my @rfields = $x->getfields($loc500);
3625 my $rvictim = pop @rfields;
3626 my $rval = getmatch('i2',$rvictim);
3627 $$rval = "4" if $rval;
3628
3629 MARC::Rec::getmatch($subf,$rfield) is identical to getmatch;
3630
3631 =head2 insertpos()
3632
3633 insertpos() takes a subfield code (can not be an indicator), a value,
3634 and a fieldref. Updates the fieldref with the first place that the
3635 fieldref can match. Assumes there is no exact subfield match in
3636 $fieldref.
3637
3638 #Let's update the value of subfield 'a' for the *last* 500
3639 my $value = "new info";
3640 my $loc500 = {record=>1,field=>500,rebuild_map=>1};
3641 my @rfields = $x->getfields($loc500);
3642 my $rvictim = pop @rfields;
3643 my $rval = getmatch('a',$rvictim);
3644 if ($rval) {
3645 $$rval = $value ;
3646 } else {
3647 $x->insertpos('a',$value,$rvictim);
3648 }
3649
3650 MARC::Rec::insertpos($subf,$value,$rfield) is identical to insertpos;
3651
3652 =head2 selectmarc()
3653
3654 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.
3655
3656 $x->selectmarc(['3']);
3657 $y=$x->selectmarc(['4','21-50','60']);
3658 print "$y records selected!";
3659
3660 =head2 searchmarc()
3661
3662 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.
3663
3664 =over 4
3665
3666 =item *
3667
3668 1) Field/Subfield Presence:
3669
3670 @records=$x->searchmarc({field=>"245"});
3671 @records=$x->searchmarc({field=>"245",subfield=>"a"});
3672
3673 =item *
3674
3675 2) Field/Subfield Match:
3676
3677 @records=$x->searchmarc({field=>"245",
3678 regex=>"/huckleberry/i"});
3679 @records=$x->searchmarc({field=>"260",subfield=>"c",
3680 regex=>"/19../"});
3681
3682 =item *
3683
3684 3) Field/Subfield NotMatch:
3685
3686 @records=$x->searchmarc({field=>"245",
3687 notregex=>"/huckleberry/i"});
3688 @records=$x->searchmarc({field=>"260",
3689 subfield=>"c",notregex=>"/19../"});
3690
3691 =back
3692
3693 =head2 createrecord()
3694
3695 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.
3696
3697 use MARC;
3698 my $x = new MARC;
3699 $record_number = $x->createrecord();
3700 $record_number = $x->createrecord({leader=>
3701 "00000nmm 2200000 a 4500"});
3702
3703 MARC::Rec::createrecord($leader) returns an instance of a suitable subclass of MARC::Rec.
3704
3705 =head2 getupdate()
3706
3707 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:
3708
3709 246 30 $aPhoto archive
3710 246 3 $aAssociated Press photo archive
3711
3712 my $update246 = {field=>'246',record=>2,ordered=>'y'};
3713 # next two statements are equivalent
3714 my @u246 = $x->getupdate($update246);
3715 # or
3716 my @u246 = ('i1','3','i2','0',
3717 'a','Photo archive',"\036",
3718 'i1','3','i2',' ',
3719 'a','Associated Press photo archive',"\036");
3720
3721 After making any desired modifications to the data, the existing field can be replaced using the following sequence (for non-repeating fields):
3722
3723 $x->deletemarc($update246));
3724 my @records = ();
3725 foreach my $y1 (@u246) {
3726 last if ($y1 eq "\036");
3727 push @records, $y1;
3728 }
3729 $x->addfield($update246, @records);
3730
3731 =head2 updaterecord()
3732
3733 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.
3734
3735 $repeats = $x->updaterecord($update246, @u246); # same as above
3736
3737 =head2 addfield()
3738
3739 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:
3740
3741 $y = $x->createrecord(); # $y will store the record number created
3742
3743 $x->addfield({record=>"$y", field=>"100", i1=>"1", i2=>"0",
3744 value=> [a=>"Twain, Mark, ", d=>"1835-1910."]});
3745
3746 $x->addfield({record=>"$y", field=>"245",
3747 i1=>"1", i2=>"4", value=>
3748 [a=>"The adventures of Huckleberry Finn /",
3749 c=>"Mark Twain ; illustrated by E.W. Kemble."]});
3750
3751 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.
3752
3753 # same as "100" example above
3754 my @v100 = 'i1','1','i2',"0",'a',"Twain, Mark, ",
3755 'd',"1835-1910.";
3756 $x->addfield({record=>"$y", field=>"100"}, @v100);
3757
3758 =head2 add_005s()
3759
3760 Add_005s takes a specification of records (defaults to everything) and
3761 updates the indicated records with updated 005 fields (date of last transaction).
3762
3763 =head2 output()
3764
3765 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).
3766
3767 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.
3768
3769 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.
3770
3771 The I<lineterm> parameter can be used to override the line-ending default
3772 for any of the formats. I<MARCMaker> defaults to CRLF (the format was
3773 originally released for MS-DOS). The others use '\n' as the default.
3774
3775 With the I<MARCMaker> format, a I<charset> parameter accepts a hash-reference
3776 to a user supplied character translation table. The "ustext.txt" table supplied
3777 with the LoC. MARCBreaker utility is used internally as the default. You can
3778 use the B<ustext_default> method to get a hash-reference to it if you only
3779 want to modify a couple of characters. See example below.
3780
3781 The I<MARCMaker> Specification requires that long lines be split to less
3782 than 80 columns. While that behavior is the default, the I<nolinebreak>
3783 parameter can override it and the resulting output will be much like the
3784 I<ascii> format.
3785
3786 MARC::Rec::output($template) is the same as output except that ignores
3787 record number(s) and only outputs its caller. (E.g., with $format
3788 eq 'urls' it does not output html header and footer information.)
3789
3790 =over 4
3791
3792 =item *
3793
3794 MARC
3795
3796 $x->output({file=>">mymarc.dat",'format'=>"usmarc"});
3797 $x->output({file=>">mymarc.dat",'format'=>"usmarc",
3798 records=>\@records});
3799 $y=$x->output({'format'=>"usmarc"}); #put the output into $y
3800
3801 =item *
3802
3803 MARCMaker
3804
3805 $x->output({file=>">mymarcmaker.mkr",'format'=>"marcmaker"});
3806 $x->output({file=>">mymarcmaker.mkr",'format'=>"marcmaker",
3807 records=>\@records});
3808 $y=$x->output({'format'=>"marcmaker"}); #put the output into $y
3809
3810 $x->output({file=>"brkrtest.mkr",'format'=>"marcmaker",
3811 nolinebreak=>"1", lineterm=>"\n",
3812 charset=>\%char_hash});
3813
3814
3815 =item *
3816
3817 ASCII
3818
3819 $x->output({file=>">myascii.txt",'format'=>"ascii"});
3820 $x->output({file=>">myascii.txt",'format'=>"ascii",
3821 records=>\@records});
3822 $y=$x->output({'format'=>"ascii"}); #put the output into $y
3823
3824 =item *
3825
3826 HTML
3827
3828 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.
3829
3830 $x->output({file=>">myhtml.html",'format'=>"html",
3831 fields=>"all"});
3832
3833 #this will only output the 100 and 245 fields, with the
3834 #labels "Title: " and "Author: "
3835 $x->output({file=>">myhtml.html",'format'=>"html",
3836 245=>"Title: ",100=>"Author: "});
3837
3838 $y=$x->output({'format'=>"html"});
3839
3840 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!
3841
3842 $x->output({file=>">myhtml.html",
3843 'format'=>"html_header"}); # Content-type
3844 $x->output({file=>">>myhtml.html",
3845 'format'=>"html_start"}); # <BODY>
3846 $x->output({file=>">>myhtml.html",
3847 'format'=>"html_body",fields=>"all"});
3848 $x->output({file=>">>myhtml.html",
3849 'format'=>"html_footer"});
3850
3851 =item *
3852
3853 URLS
3854
3855 $x->output({file=>"urls.html",'format'=>"urls"});
3856 $y=$x->output({'format'=>"urls"});
3857
3858 =item *
3859
3860 ISBD
3861
3862 An experimental output format that attempts to mimic the ISBD.
3863
3864 $x->output({file=>"isbd.txt",'format'=>"isbd"});
3865 $y=$x->output({'format'=>"isbd"});
3866
3867 =item *
3868
3869 XML
3870
3871 Roundtrip conversion between MARC and XML is handled by the subclass
3872 MARC::XML. MARC::XML is available for download from the CPAN.
3873
3874
3875 =back
3876
3877 =head2 usmarc_default()
3878
3879 This method returns a hash reference to a translation table between mnemonics
3880 delimited by curly braces and single-byte character codes in the MARC record.
3881 Multi-byte characters are not currently supported. The hash has keys of the
3882 form '{esc}' and values of the form chr(0x1b). It is used during MARCMaker
3883 input.
3884
3885 my %inc = %{$x->usmarc_default()};
3886 printf "dollar = %s\n", $inc{'dollar'}; # prints '$'
3887 $inc{'yen'} = 'Y';
3888 $x->openmarc({file=>"makrbrkr.mrc",'format'=>"marcmaker",
3889 charset=>\%inc});
3890
3891 MARC::Rec::usmarc_default is identical to usmarc_default;
3892
3893 =head2 ustext_default()
3894
3895 This method returns a hash reference to a translation table between single-byte
3896 character codes and mnemonics delimited by curly braces. Multi-byte characters
3897 are not currently supported. The hash has keys of the form chr(0x1b) and
3898 values of the form '{esc}'. It is used during MARCMaker output.
3899
3900 my %outc = %{$x->ustext_default()};
3901 printf "dollar = %s\n", $outc{'$'}; # prints '{dollar}'
3902 $outc{'$'} = '{uscash}';
3903 printf "dollar = %s\n", $outc{'$'}; # prints '{uscash}'
3904 $y = $x->output({'format'=>"marcmaker", charset=>\%outc});
3905
3906 MARC::Rec::ustext_default is identical to ustext_default;
3907
3908 =head2 as_string()
3909
3910 As_string() takes no paramaters and returns a (Unix) newline separated version of the record.
3911
3912 Format is: $tag<SPACE>$i1$i2<SPACE>$subfields
3913 where $subfields are separated by "\c_" binary subfield indicators.
3914 Tag 000 is ldr.
3915
3916 Subclasses may need to override this format. If so,
3917 they should override from_string.
3918
3919 =head2 from_string()
3920
3921 From_string() takes a string paramater and updates the calling record's {array} information.
3922 It assumes the string is formatted like the output of as_string().
3923
3924 =head1 EXAMPLES
3925
3926 Here are a few examples to fire your imagination.
3927
3928 =over 4
3929
3930 =item *
3931
3932 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".
3933
3934 #!/usr/bin/perl
3935 use MARC;
3936 $x = MARC->new("mymarc.dat","marcmaker");
3937 $x->output({file=>"mymkr.mkr",'format'=>"marcmaker");
3938
3939 =item *
3940
3941 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".
3942
3943 #!/usr/bin/perl
3944 use MARC;
3945 $x = new MARC;
3946 $x->openmarc({file=>"mymarc.dat",'format'=>"usmarc"});
3947 while ($x->nextmarc(1)) {
3948 $x->output({file=>">>myfile.mkr",'format'=>"marcmaker"});
3949 $x->deletemarc(); #empty the object for reading in another
3950 }
3951
3952 =item *
3953
3954 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.
3955
3956 #!/usr/bin/perl
3957 use MARC;
3958 $x = new MARC;
3959 open (INPUT_FILE, "delimited_file");
3960 while ($line=<INPUT_FILE>) {
3961 ($journaltitle,$issn) = split /\t/,$line;
3962 $num=$x->createrecord();
3963 $x->addfield({record=>$num,
3964 field=>"022",
3965 i1=>" ", i2=>" ",
3966 value=>$issn});
3967 $x->addfield({record=>$num,
3968 field=>"245",
3969 i1=>"0", i2=>" ",
3970 value=>[a=>$journaltitle]});
3971 $x->addfield({record=>$num,
3972 field=>"260",
3973 i1=>" ", i2=>" ",
3974 value=>[a=>"New York (N.Y.) :",
3975 b=>"Dow Jones & Company"]});
3976 $x->addfield({record=>$num,
3977 field=>"710",
3978 i1=>"2", i2=>" ",
3979 value=>[a=>"Dow Jones Interactive."]});
3980 $x->addfield({record=>$num,
3981 field=>"856",
3982 i1=>"4", i2=>" ",
3983 value=>[u=>"http://www.djnr.com",
3984 z=>"Connect"]});
3985 }
3986 close INPUT_FILE;
3987 $x->output({file=>">dowjones.mrc",'format'=>"usmarc"})
3988
3989 =item *
3990
3991 Perhaps you have periodicals coming in that you want to order by
3992 location and then title. MARC::Rec's get you out of some array indexing.
3993
3994 #!/usr/bin//perl
3995 use MARC 1.03;
3996
3997 my @newmarcs=@$marc[1..$#$marc]; # array slice.
3998 my @sortmarcs = sort by_loc_oclc @newmarcs;
3999 @marc[1..$#$marc] = @sortmarcs;
4000
4001 sub by_loc_title {
4002 my ($aloc,$atitle) = loc_title($a);
4003 my ($bloc,$btitle) = loc_title($b);
4004 return $aloc cmp $bloc
4005 ||
4006 $atitle cmp $btitle;
4007 }
4008
4009 sub loc_title {
4010 my ($rec)=@_;
4011 my $n049 = $rec->getfirstvalue({field=>040});
4012 my ($loc) = $n049=~/(ND\S+)/; # Or the first two letters of your OCLC
4013 # location.
4014
4015 my $title = $rec->getfirstvalue({field=>100,delimiter=>" "});
4016
4017 return ($loc,$title);
4018 }
4019
4020 =back
4021
4022 =head1 NOTES
4023
4024 Please let us know if you run into any difficulties using MARC.pm--we'd be
4025 happy to try to help. Also, please contact us if you notice any bugs, or
4026 if you would like to suggest an improvement/enhancement. Email addresses
4027 are listed at the bottom of this page.
4028
4029 Development of MARC.pm and other library oriented Perl utilities is conducted
4030 on the Perl4Lib listserv. Perl4Lib is an open list and is an ideal place to
4031 ask questions about MARC.pm. Subscription information is available at
4032 http://www.vims.edu/perl4lib
4033
4034 Two global boolean variables are reserved for test and debugging. Both are
4035 "0" (off) by default. The C<$TEST> variable disables internal error messages
4036 generated using I<Carp>. It also overrides the date_stamp in the "005" field
4037 with a constant "19960221075055.7". It should only be used in the automatic
4038 test suite. The C<$DEBUG> variable adds verbose diagnostic messages. Since
4039 both variables are used only in testing, I<MARC::Rec> uses C<$MARC::TEST>
4040 and C<$MARC::DEBUG> rather than define a second pair.
4041
4042 =head1 AUTHORS
4043
4044 Chuck Bearden cbearden@rice.edu
4045
4046 Bill Birthisel wcbirthisel@alum.mit.edu
4047
4048 Derek Lane dereklane@pobox.com
4049
4050 Charles McFadden chuck@vims.edu
4051
4052 Ed Summers ed@cheetahmail.com
4053
4054 =head1 SEE ALSO
4055
4056 perl(1), http://lcweb.loc.gov/marc
4057
4058 =head1 COPYRIGHT
4059
4060 Copyright (C) 1999,2000, Bearden, Birthisel, Lane, McFadden, and Summers.
4061 All rights reserved. This module is free software; you can redistribute
4062 it and/or modify it under the same terms as Perl itself. 23 April 2000.
4063 Portions Copyright (C) 1999,2000, Duke University, Lane.
4064
4065 =cut
+166
-0
Makefile.PL less more
0 use ExtUtils::MakeMaker;
1 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
2 # the contents of the Makefile that is written.
3
4 require 5.004;
5
6 unless ($^O =~ /Win/i) {
7 WriteMakefile(
8 'NAME' => 'MARC',
9 'VERSION_FROM' => 'MARC.pm', # finds $VERSION
10 'SKIP' => [qw(tool_autosplit)],
11 'clean' => {FILES => "*/output* output*"},
12 );
13 exit;
14 }
15
16 # On Windows, create substitute scripts for the "make deprived"
17
18 use File::Copy;
19 use File::Path;
20 use Pod::Html;
21 use File::Find;
22
23 # clean up test and example result files
24 find(\&wanted, ".");
25
26 sub wanted {
27 return unless (/^output/);
28 unlink ($_);
29 }
30
31 my $version = simple_version("MARC.pm");
32 my $INST_LIBDIR = "./lib";
33 my $INST_HTMLDIR = "./html";
34 my $INST_FILES = "MARC.pm";
35 my $INST_NAME = "MARC";
36 my @HTML_FILES = "MARC";
37
38 print <<INTRO3;
39 MARC version $version
40
41 No 'Makefile' will be created
42 Test with: perl test.pl
43 Install with: perl install.pl
44
45 INTRO3
46
47 my $dfile = "test.pl";
48 unlink $dfile;
49 print "Creating new $dfile\n";
50 open (DEFAULT, "> $dfile") or die "Can't create $dfile: $!\n";
51
52 print DEFAULT <<"TEST4"; # double quotes - need interpolation
53 # Created by Makefile.PL
54 # $INST_NAME Version $version
55 TEST4
56
57 print DEFAULT <<'TEST4'; # single quotes - minimize chaacter quoting
58 use Test::Harness;
59 runtests ("t/test1.t","t/test2.t","t/test3.t","t/test4.t","t/test5.t");
60
61 print "\nTo run individual tests, type:\n";
62 print " C:\\> perl t/test?.t Page_Pause_Time (0..5)\n";
63 print "See README and other documentation for additional information.\n\n";
64 TEST4
65
66 close DEFAULT;
67
68 unless (-d $INST_LIBDIR) {
69 File::Path::mkpath([ "$INST_LIBDIR" ],1,0777) or
70 die "ERROR creating directories: ($!)\n";
71 }
72 unless (-d $INST_HTMLDIR) {
73 File::Path::mkpath([ "$INST_HTMLDIR" ],1,0777) or
74 die "ERROR creating directories: ($!)\n";
75 }
76 File::Copy::copy($INST_FILES,$INST_LIBDIR) or
77 die "ERROR copying files: ($!)\n";
78
79 foreach $source (@HTML_FILES) {
80 pod2html(
81 "--norecurse",
82 "--infile=$source.pm",
83 "--outfile=$INST_HTMLDIR/$source.html"
84 );
85 }
86
87 $dfile = "install.pl";
88 unlink $dfile, "pod2html-itemcache","pod2html-dircache";
89 print "Creating new $dfile\n";
90 open (DEFAULT, "> $dfile") or die "Can't create $dfile: $!\n";
91
92 print DEFAULT <<"INST5";
93 # Created by Makefile.PL
94 # $INST_NAME Version $version
95 INST5
96
97 my $template = <<'INST5';
98
99 use Config qw(%Config);
100 use strict;
101 use ExtUtils::Install qw( install );
102
103 my $FULLEXT = "%s"; # $INST_NAME
104 my $INST_LIB = "./lib";
105 my $HTML_LIB = "./html";
106
107 my $html_dest = ""; # edit real html base here if autodetect fails
108
109 if (exists $Config{installhtmldir} ) {
110 $html_dest = "$Config{installhtmldir}";
111 }
112 elsif (exists $Config{installprivlib} ) {
113 $html_dest = "$Config{installprivlib}";
114 $html_dest =~ s%\\lib%\\html%;
115 }
116
117 if ( length ($html_dest) ) {
118 $html_dest .= '\lib\site';
119 }
120 else {
121 die "Can't find html base directory. Edit install.pl manually.\n";
122 }
123
124 install({
125 read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
126 write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
127 $INST_LIB => "$Config{installsitelib}",
128 $HTML_LIB => "$html_dest"
129 },1,0);
130
131 __END__
132 INST5
133
134 printf DEFAULT $template, $INST_NAME;
135 close DEFAULT;
136
137 # a low-fat version of parse_version from ExtUtils::MM_Unix.
138 sub simple_version {
139 my $parsefile = shift;
140 my $result;
141 open(FH,$parsefile) or die "Could not open '$parsefile': $!";
142 my $inpod = 0;
143 while (<FH>) {
144 $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
145 next if $inpod;
146 chop;
147 next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
148 my $eval = qq{
149 package ExtUtils::MakeMaker::_version;
150 no strict;
151
152 local $1$2;
153 \$$2=undef; do {
154 $_
155 }; \$$2
156 };
157 local($^W) = 0;
158 $result = eval($eval);
159 die "Could not eval '$eval' in $parsefile: $@" if $@;
160 $result = "undef" unless defined $result;
161 last;
162 }
163 close FH;
164 return $result;
165 }
+164
-0
README less more
0 MARC (manipulate MAchine Readable Cataloging)
1 VERSION=1.07, 23 April 2000
2
3 This is a cross-platform module. All of the files except README.txt
4 are LF-only terminations. You will need a better editor than Notepad
5 to read them on Win32. README.txt is README with CRLF.
6
7 DESCRIPTION:
8
9 MARC.pm is a Perl 5 module for reading in, manipulating, and outputting
10 bibliographic records in the USMARC format. You will need to have Perl
11 5.004 or greater for MARC.pm to work properly. Since it is a Perl module
12 you use MARC.pm from one of your own Perl scripts. It handles conversions
13 from MARC into ASCII (text), Library of Congress MARCMaker, HTML,
14 and ISBD. Input from MARCMaker format is also supported. Individual
15 records, fields, indicators, and subfields can be created, modified, and
16 deleted. It can extract URLs from the 856 field into HTML.
17
18 The MARC::XML module adds conversions to and from XML.
19
20 The MARC::Tie module adds another way to access this data.
21
22 MARC.pm can handle both single and batches of MARC records. The limit on
23 the number of records in a batch is determined by the memory capacity of
24 the machine you are running. If memory is an issue for you MARC.pm will
25 allow you to read in records from a batch gradually. MARC.pm also includes
26 a variety of tools for searching, removing, and even creating records from
27 scratch.
28
29 FILES:
30
31 Changes - for history lovers
32 Makefile.PL - the "starting point" for traditional reasons
33 MANIFEST - file list
34 README - this file for CPAN
35 README.txt - this file for DOS
36 MARC.pm - the reason you're reading this
37
38 t - test directory
39 t/marc.dat - two record data file for testing
40 t/marc4.dat - slightly different version of t/marc.dat
41 t/badmarc.dat - corrupt data file for testing
42 t/test1.t - basic tests, search, update
43 t/test2.t - MARCMaker format tests
44 t/test3.t - Inheritance version of test1.t
45 t/test4.t - tests for the *map* methods
46 t/test5.t - updatefirst/deletefirst tests
47 t/MARCopt.pm - Inheritance stub module
48 t/makrbrkr.mrc - LoC. MARCMaker reference records
49 t/makrtest.src - MARCMaker source for makrbrkr.mrc
50 t/brkrtest.ref - MARCBreaker output from makrbrkr.mrc
51 t/makrtest.bad - corrupt MARCMaker source file for testing
52
53 eg - test directory
54 eg/microlif.001 - eighteen record data file for demo
55 eg/addlocal.pl - simple modify/write demo with comments
56 eg/specials.001 - complex data file for fixlocal demo
57 eg/fixlocal.pl - multi-field search and replace demo with comments
58 and option templates
59 eg/uclocal.pl - complex modify/write demo with extensive use of
60 templates and tutorial comments
61
62 INSTALL and TEST:
63
64 On linux and Unix, this distribution uses Makefile.PL and the "standard"
65 install sequence for CPAN modules:
66 perl Makefile.PL
67 make
68 make test
69 make install
70
71 On Win32, Makefile.PL creates equivalent scripts for the "make-deprived"
72 and follows a similar sequence.
73 perl Makefile.PL
74 perl test.pl
75 perl install.pl
76
77 Both sequences create install files and directories. The test uses a
78 small sample input file and creates outputs in various formats. You can
79 specify an optional PAUSE (0..5 seconds) between pages of output. The
80 'perl t/test1.pl PAUSE' form works on all OS types. The test will
81 indicate if any unexpected errors occur (not ok).
82
83 Once you have installed, you can check if Perl can find it. Change to
84 some other directory and execute from the command line:
85
86 perl -e "use MARC"
87
88 No response that means everything is OK! If you get an error like
89 * Can't locate method "use" via package MARC *, then Perl is not
90 able to find MARC.pm--double check that the file copied it into the
91 right place during the install.
92
93 EXPERIMENTAL ELEMENTS:
94
95 A number of functions were added in Version 0.92 by Derek Lane to
96 support updating "000" and "008" fields. All of these are experimental
97 and may be subject to changes or syntax refinements. Here are his
98 comments:
99
100 (unpack_ldr): gets an updateable version of the LDR
101
102 (_unpack_ldr): This and other _ - series functions work fine on a
103 record-by-record basis. In general all official methods in the
104 (un)?pack.* series call corresponding _(un)?pack.* methods. The
105 official interfaces have to specify the records.
106
107 (_pack_ldr): Added in 0.95d
108
109 (bib_format): returns, e.g. BOOK or SERIAL. Don't confuse this
110 with usmarc vs XML.
111
112 (_bib_format): Suitable for record-by-record access.
113
114 (unpack_008): Returns updateable fixed field information.
115
116 (_unpack_008): Internal record-by-record equivalent.
117
118 (_pack_008): Added in 0.95d
119
120 COMPATIBILITY:
121
122 The length() method has been removed because it overrides a Perl builtin.
123 Use the new marc_count() method instead.
124
125 Version 0.93 adds character_set conversions to MarcMaker format reads and
126 writes. The usmarc/ustext character maps are used by default, so existing
127 files in that format will produce different results than earlier versions.
128
129 Starting with version 1.00, the XML conversions are moved to MARC::XML.
130
131 Version 1.05 no longer assumes fields with same tag are contiguous. This
132 is required for CJK characters and may introduce other changes from earlier
133 conversions. The addition of proper date stamp generation in the "005" field
134 may now create different output from the same source data.
135
136 NOTES:
137
138 Please let us know if you run into any difficulties using MARC.pm--
139 e'd be happy to try to help. Also, please contact us if you notice any
140 bugs, or if you would like to suggest an improvement/enhancement. Email
141 addresses are listed at the bottom of this page.
142
143 The module is provided in standard CPAN distribution format. Additional
144 documentation is created during the installation (html and man formats).
145
146 Download the latest version from CPAN or:
147
148 http://marcpm.sourceforge.net
149
150 AUTHORS:
151
152 Chuck Bearden cbearden@rice.edu
153 Bill Birthisel wcbirthisel@alum.mit.edu
154 Charles McFadden chuck@vims.edu
155 Ed Summers esummers@odu.edu
156 Derek Lane dereklane@pobox.com
157
158 COPYRIGHT
159
160 Copyright (C) 1999, 2000 Bearden, Birthisel, Lane, McFadden, and Summers.
161 All rights reserved. This module is free software; you can redistribute
162 it and/or modify it under the same terms as Perl itself.
163 Portions Copyright (C) 1999, 2000 Duke University, Lane.
+164
-0
README.txt less more
0 MARC (manipulate MAchine Readable Cataloging)
1 VERSION=1.07, 23 April 2000
2
3 This is a cross-platform module. All of the files except README.txt
4 are LF-only terminations. You will need a better editor than Notepad
5 to read them on Win32. README.txt is README with CRLF.
6
7 DESCRIPTION:
8
9 MARC.pm is a Perl 5 module for reading in, manipulating, and outputting
10 bibliographic records in the USMARC format. You will need to have Perl
11 5.004 or greater for MARC.pm to work properly. Since it is a Perl module
12 you use MARC.pm from one of your own Perl scripts. It handles conversions
13 from MARC into ASCII (text), Library of Congress MARCMaker, HTML,
14 and ISBD. Input from MARCMaker format is also supported. Individual
15 records, fields, indicators, and subfields can be created, modified, and
16 deleted. It can extract URLs from the 856 field into HTML.
17
18 The MARC::XML module adds conversions to and from XML.
19
20 The MARC::Tie module adds another way to access this data.
21
22 MARC.pm can handle both single and batches of MARC records. The limit on
23 the number of records in a batch is determined by the memory capacity of
24 the machine you are running. If memory is an issue for you MARC.pm will
25 allow you to read in records from a batch gradually. MARC.pm also includes
26 a variety of tools for searching, removing, and even creating records from
27 scratch.
28
29 FILES:
30
31 Changes - for history lovers
32 Makefile.PL - the "starting point" for traditional reasons
33 MANIFEST - file list
34 README - this file for CPAN
35 README.txt - this file for DOS
36 MARC.pm - the reason you're reading this
37
38 t - test directory
39 t/marc.dat - two record data file for testing
40 t/marc4.dat - slightly different version of t/marc.dat
41 t/badmarc.dat - corrupt data file for testing
42 t/test1.t - basic tests, search, update
43 t/test2.t - MARCMaker format tests
44 t/test3.t - Inheritance version of test1.t
45 t/test4.t - tests for the *map* methods
46 t/test5.t - updatefirst/deletefirst tests
47 t/MARCopt.pm - Inheritance stub module
48 t/makrbrkr.mrc - LoC. MARCMaker reference records
49 t/makrtest.src - MARCMaker source for makrbrkr.mrc
50 t/brkrtest.ref - MARCBreaker output from makrbrkr.mrc
51 t/makrtest.bad - corrupt MARCMaker source file for testing
52
53 eg - test directory
54 eg/microlif.001 - eighteen record data file for demo
55 eg/addlocal.pl - simple modify/write demo with comments
56 eg/specials.001 - complex data file for fixlocal demo
57 eg/fixlocal.pl - multi-field search and replace demo with comments
58 and option templates
59 eg/uclocal.pl - complex modify/write demo with extensive use of
60 templates and tutorial comments
61
62 INSTALL and TEST:
63
64 On linux and Unix, this distribution uses Makefile.PL and the "standard"
65 install sequence for CPAN modules:
66 perl Makefile.PL
67 make
68 make test
69 make install
70
71 On Win32, Makefile.PL creates equivalent scripts for the "make-deprived"
72 and follows a similar sequence.
73 perl Makefile.PL
74 perl test.pl
75 perl install.pl
76
77 Both sequences create install files and directories. The test uses a
78 small sample input file and creates outputs in various formats. You can
79 specify an optional PAUSE (0..5 seconds) between pages of output. The
80 'perl t/test1.pl PAUSE' form works on all OS types. The test will
81 indicate if any unexpected errors occur (not ok).
82
83 Once you have installed, you can check if Perl can find it. Change to
84 some other directory and execute from the command line:
85
86 perl -e "use MARC"
87
88 No response that means everything is OK! If you get an error like
89 * Can't locate method "use" via package MARC *, then Perl is not
90 able to find MARC.pm--double check that the file copied it into the
91 right place during the install.
92
93 EXPERIMENTAL ELEMENTS:
94
95 A number of functions were added in Version 0.92 by Derek Lane to
96 support updating "000" and "008" fields. All of these are experimental
97 and may be subject to changes or syntax refinements. Here are his
98 comments:
99
100 (unpack_ldr): gets an updateable version of the LDR
101
102 (_unpack_ldr): This and other _ - series functions work fine on a
103 record-by-record basis. In general all official methods in the
104 (un)?pack.* series call corresponding _(un)?pack.* methods. The
105 official interfaces have to specify the records.
106
107 (_pack_ldr): Added in 0.95d
108
109 (bib_format): returns, e.g. BOOK or SERIAL. Don't confuse this
110 with usmarc vs XML.
111
112 (_bib_format): Suitable for record-by-record access.
113
114 (unpack_008): Returns updateable fixed field information.
115
116 (_unpack_008): Internal record-by-record equivalent.
117
118 (_pack_008): Added in 0.95d
119
120 COMPATIBILITY:
121
122 The length() method has been removed because it overrides a Perl builtin.
123 Use the new marc_count() method instead.
124
125 Version 0.93 adds character_set conversions to MarcMaker format reads and
126 writes. The usmarc/ustext character maps are used by default, so existing
127 files in that format will produce different results than earlier versions.
128
129 Starting with version 1.00, the XML conversions are moved to MARC::XML.
130
131 Version 1.05 no longer assumes fields with same tag are contiguous. This
132 is required for CJK characters and may introduce other changes from earlier
133 conversions. The addition of proper date stamp generation in the "005" field
134 may now create different output from the same source data.
135
136 NOTES:
137
138 Please let us know if you run into any difficulties using MARC.pm--
139 e'd be happy to try to help. Also, please contact us if you notice any
140 bugs, or if you would like to suggest an improvement/enhancement. Email
141 addresses are listed at the bottom of this page.
142
143 The module is provided in standard CPAN distribution format. Additional
144 documentation is created during the installation (html and man formats).
145
146 Download the latest version from CPAN or:
147
148 http://marcpm.sourceforge.net
149
150 AUTHORS:
151
152 Chuck Bearden cbearden@rice.edu
153 Bill Birthisel wcbirthisel@alum.mit.edu
154 Charles McFadden chuck@vims.edu
155 Ed Summers esummers@odu.edu
156 Derek Lane dereklane@pobox.com
157
158 COPYRIGHT
159
160 Copyright (C) 1999, 2000 Bearden, Birthisel, Lane, McFadden, and Summers.
161 All rights reserved. This module is free software; you can redistribute
162 it and/or modify it under the same terms as Perl itself.
163 Portions Copyright (C) 1999, 2000 Duke University, Lane.
+102
-0
eg/addlocal.pl less more
0 #!/usr/bin/perl
1
2 # The following example automates a simple but time-consuming task for
3 # a librarian. Booksellers commonly include a disk containing standard
4 # bibliographical and catalogging data with their shipments to libraries.
5 # The data is in MAchine Readable Catalog (MARC) format. The MARC.pm
6 # module creates, reads, updates, and writes that data. Most library
7 # databases also import from and export into MARC format. But a library
8 # often must add to the data provided by the booksellers. We are going to
9 # add the Wisconsin inter-library loan code for the Clinton Public Library
10 # and the local call number to each MARC record (each catalog item).
11
12 # A record consists of a number of tags (data types) and each tag can have
13 # one or more subfields (data elements). Tags are designated by 3-digit
14 # identifiers (000-999) corresponding to specific data types (i.e. the 245
15 # tag is the Title Statement). In this example, we care about the 852 tag
16 # (Location) subfield 'h' (Dewey or similar Recommended Call Number) and
17 # the 900 and 999 tags (reserved for "local" use). We plan to append a 999
18 # field to each record based in part on the 852 tag subfield 'h'. We will
19 # also print a text listing of any records missing this subfield so the
20 # librarian can update those manually. Finally, we will insert the call
21 # number as a 900 tag.
22
23 use MARC 0.93;
24 my $infile = "microlif.001";
25 my $outfile = "output.002";
26 my $outfile2 = "output2.txt";
27 my $outtext = "output.txt";
28 unlink $outfile, $outtext, $outfile2;
29
30 # Your filenames will vary. You probably want absolute pathnames.
31 # In Clinton, WI, we have a shortcut to the newbooks.d directory and
32 # use these:
33 # my $infile = "a:\\microlif.001"; # floppy from vendor
34 # my $outfile = "d:\\microlif.002"; # file to import
35 # my $outfile2 = "d:\\newbooks.d\\updated.txt"; # ascii to check
36 # my $outtext = "d:\\newbooks.d\\missing.txt"; # needs attention
37
38 my $count = 0;
39 my $missing = 0;
40 $x = MARC->new;
41 $x->openmarc({file=>$infile,'format'=>"usmarc"}) || die;
42
43 # You may want a more informative failure routine if run from a GUI
44
45 # We process records one at a time for this operation. Multiple 852 fields
46 # are legal (for multiple copies) - the 'h' subfield should be the same.
47 # But a few percent of incoming materials do not include this subfield.
48
49 while ($x->nextmarc(1)) {
50 my ($callno) = $x->getvalue({record=>'1',field=>'852',subfield=>'h'});
51 $callno = "|" unless (defined $callno);
52
53 # A single 'fill character' ("|" eq 0x7c) is used for none.
54 # Some vendors don't like "empty" subfields
55
56 $x->addfield({record=>1,
57 field=>"999",
58 ordered=>"n",
59 i1=>" ", i2=>" ",
60 value=>[c=>"wL70",d=>"AR Clinton PL",f=>"$callno"]});
61
62 # Tag 999 subfield 'f' gets the Call Number. The others are constant in this
63 # example. Tag 999 is the last legal choice, so a simple append is fine.
64
65 $x->addfield({record=>1,
66 field=>"900",
67 ordered=>"y",
68 i1=>" ", i2=>" ",
69 value=>[a=>"$callno"]});
70
71 # Tag 900 subfield 'a' gets the Call Number. Since some records already
72 # have 9xx tags (e.g. 935), we want 'ordered' (which is also the default).
73
74 $x->output({file=>">>$outfile",'format'=>"usmarc"});
75 if ($callno eq "|") {
76 $x->output({file=>">>$outtext",'format'=>"ascii",
77 lineterm=>"\r\n"});
78 $missing++;
79 }
80 $x->output({file=>">>$outfile2",'format'=>"ascii",
81 lineterm=>"\r\n"});
82 $x->deletemarc(); #empty the object for reading in another
83 $count++;
84 }
85
86 # We write all the records to the output file in MARC format. Even the
87 # incomplete ones at least have added the fixed data. The ascii output
88 # in $outtext gives the librarian both a list of records requiring manual
89 # attention and all the Title, Author, Publication and related data needed
90 # to assign location based on standard references. This demo also writes
91 # an ascii version of its output as $outfile2 so the final MARC records
92 # can be viewed with the changes. Since Clinton runs on NT, we specify
93 # a Notepad-compatible line termination.
94
95 print "\nprocessed $count records\n";
96 print "$missing had missing call numbers\n\n";
97 print "press <Enter> to continue\n";
98 my $junk = <>;
99
100 # Allow results to be seen even when run from a GUI.
101
+137
-0
eg/fixlocal.pl less more
0 #!/usr/bin/perl
1
2 # The following example is an expanded version of "addlocal.pl" that
3 # checks and fixes existing records in addition to processing new ones.
4 # It first looks for a call number subfield 'h' of the 852 field (#852.h).
5 # If missing, it then checks #900.a and #999.f for the data. It puts the
6 # call number found into all of these locations including any repeated
7 # fields. It will create the locations if necessary.
8
9 use MARC 0.95;
10 my $infile = "specials.001";
11 my $outfile = "output.003";
12 my $outtext = "output3.txt";
13 my $outtext2 = "output4.txt";
14 unlink $outfile, $outtext, $outtext2;
15
16 sub fix_update {
17 my $subfield = shift;
18 my $value = shift;
19 my @f = ();
20 my $ff;
21 my $altered = 0;
22 my $fixed = 0;
23 while (@_) {
24 last unless defined ($ff = shift);
25 if ($ff eq "\036") {
26 unless ($fixed) {
27 push @f, $subfield, $value;
28 $altered++;
29 }
30 push @f, $ff;
31 $fixed = 0;
32 next;
33 }
34 push @f, $ff;
35 unless ($subfield eq $ff) {
36 push @f, shift;
37 next;
38 }
39 last unless defined ($ff = shift);
40 push @f, $value;
41 $fixed++;
42 if ($value ne $ff) { $altered++; }
43 }
44 return ($altered,@f);
45 }
46
47 my $loc852 = {record=>1, field=>'852', ordered=>'y'};
48 my $loc900 = {record=>1, field=>'900', ordered=>'y'};
49 my $loc999 = {record=>1, field=>'999', ordered=>'n'};
50
51 $x = MARC->new;
52 $x->openmarc({file=>$infile,'format'=>"usmarc"}) || die;
53
54 # We process records one at a time for this operation. Multiple 852 fields
55 # are legal (for multiple copies) - the 'h' subfield should be the same.
56 # But a few percent of incoming materials do not include this subfield.
57
58 while ($x->nextmarc(1)) {
59 my $from999 = "";
60 my $from900 = "";
61 my ($callno) = $x->getvalue($loc852,'subfield','h');
62 my $from852 = (1 == scalar $x->getvalue($loc852)) ? $callno : "";
63 unless ($callno) {
64 # "" and '0' are not legal call numbers
65 $callno = "";
66 ($from900) = $x->getvalue($loc900,'subfield','a');
67 if ($from900) {
68 $callno = $from900;
69 }
70 else {
71 ($from999) = $x->getvalue($loc999,'subfield','f');
72 if ($from999) {
73 $callno = $from999;
74 }
75 }
76 }
77 my $change = 0;
78
79 my ($found) = $x->searchmarc($loc999);
80 if (defined $found) {
81 my @m999 = $x->getupdate($loc999);
82 my @f999 = fix_update('f', $callno, @m999);
83 if (shift @f999) {
84 $change++;
85 $x->updaterecord ($loc999, @f999) || warn "999 update failed\n";
86 }
87 }
88 else {
89 $x->addfield($loc999,'i1',' ','i2',' ',
90 'c','wL70','d','AR Clinton PL','f',"$callno");
91 $change++;
92 }
93
94 ($found) = $x->searchmarc($loc900);
95 if (defined $found) {
96 my @m900 = $x->getupdate($loc900);
97 my @f900 = fix_update('a', $callno, @m900);
98 if (shift @f900) {
99 $change++;
100 $x->updaterecord ($loc900, @f900) || warn "900 update failed\n";
101 }
102 }
103 else {
104 $x->addfield($loc900,'i1',' ','i2',' ','a',"$callno");
105 $change++;
106 }
107
108 if ($callno && not $from852) {
109 ($found) = $x->searchmarc($loc852);
110 if (defined $found) {
111 my @m852 = $x->getupdate($loc852);
112 my @f852 = fix_update('h', $callno, @m852);
113 if (shift @f852) {
114 $change++;
115 $x->updaterecord ($loc852, @f852) || warn "852 update failed\n";
116 }
117 }
118 else {
119 $x->addfield($loc852,'i1','1','i2',' ','h',"$callno");
120 $change++;
121 }
122 }
123
124 $x->output({file=>">>$outfile",'format'=>"usmarc"});
125 $x->output({file=>">>$outtext",'format'=>"ascii"}) unless $callno;
126 $x->output({file=>">>$outtext2",'format'=>"ascii"}) if $change;
127 $x->deletemarc(); #empty the object for reading in another
128 }
129
130 # We write all the records to the output file in MARC format. Even the
131 # incomplete ones at least have added the fixed data. The ascii output
132 # in $outtext gives the librarian both a list of records requiring manual
133 # call number assignment and all the Title, Author, Publication and
134 # related data needed to assign location based on standard references.
135 # For checking, we write all the modified records to $outtext2.
136
+1
-0
eg/microlif.001 less more
0 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
+1
-0
eg/specials.001 less more
0 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@aR@e2@gARCPL aARCPLh823 Adap3CPL0000107980xFSC@aR@e1@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@aR aARCPLhJuv Alexanderp3CPL000004252Vt2xFSC@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@aR@c197908209p4.95 h635.04 Rogp3CPL0000157592t2xFSC@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@aR@c198706309p1.95 h574.5 Alep3CPL0000171790t1xFSC@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@aR@c198312309p4.00 aARCPLh929.4403 Modp3CPL000009421Yt1xFSC@aR@c19871030@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@aR@c199407309p5.95 aARCPLh649.124 Amep3CPL000002955$t1xFSC@aR@c19910228@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@aR@c19940730@gARCPL9p6.95 p3CPL000016050Ut1xFSC@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@aR9p12.00 hB Angeloup3CPL000014465 t1xFSC@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⏎
+217
-0
eg/uclocal.pl less more
0 #!/usr/bin/perl -w
1
2 # The following example is an expanded version of "addlocal.pl" that
3 # checks and fixes existing records in addition to processing new ones.
4 # It looks for a call number subfield 'h' of each 852 field (#852.h).
5 # It also checks #900.a and #999.f for the data. It then converts the
6 # call number fields to upper case and confirms they are all identical.
7 # For mismatches and missing 852 data, the records are not modified,
8 # but an ascii version is written so the librarian can determine what
9 # is correct. Missing 900 and 999 data is created. An ascii version of
10 # the altered records is written for checking. This is a somewhat
11 # contrived example. But it shows what can be done with manipulating
12 # field data and using option templates.
13
14 use MARC 0.98;
15 use strict;
16
17 my $infile = "specials.001";
18 my $outfile = "output.004"; # results in usmarc format
19 my $outtext = "output5.txt"; # original input in ascii for ok callno.
20 my $outtext2 = "output6.txt"; # changed records in ascii
21 my $outtext3 = "output7.txt"; # invalid or mismatched records in ascii
22 my $outtext4 = "output8.txt"; # ascii for all ok callno (change or not)
23 unlink $outfile, $outtext, $outtext2, $outtext3, $outtext4;
24
25 # This subroutine takes an array of all the call numbers found. It
26 # returns an upper-cased version if all compare or '' if not
27
28 sub check_callno {
29 my $num1 = uc(shift);
30 foreach (@_) {
31 return '' unless ($num1 eq uc($_));
32 }
33 return $num1;
34 }
35
36 # This subroutine does most of the dirty work. There are four required
37 # parameters: $marc, $template, $subfield, and $value. It will return
38 # "undef" unless all four are specified. Zero (0 or "0") is a possible
39 # $subfield or $value. Blank ('') can be used for the $value.
40
41 sub fix_subfield {
42 my $marc = shift || return;
43 my $template = shift || return;
44 my $subfield = shift;
45 my $value = shift;
46 return unless (defined $subfield and defined $value);
47 my $altered = 0;
48
49 # If the $subfield already exists, get the data in a format suitable
50 # for making updates. Note the use of $template.
51
52 my ($found) = $marc->searchmarc($template);
53 if (defined $found) {
54 my @u = $marc->getupdate($template);
55 my @f = ();
56 my $ff;
57 my $fixed = 0;
58
59 # $fixed accounts for the situation when the call number may be present
60 # in some of the 852 fields, but not all of them. $fixed gets set when
61 # the $subfield is found within a single field. If processing reaches
62 # the end of the field (the "\036" delimiter) without $fixed, then the
63 # $subfield and $value are appended to that field.
64
65 while (@u) {
66 last unless defined ($ff = shift @u);
67 if ($ff eq "\036") {
68 unless ($fixed) {
69 push @f, $subfield, $value;
70 $altered++;
71 }
72 push @f, $ff;
73 $fixed = 0;
74 next;
75 }
76 push @f, $ff;
77
78 # All subfields that don't match out target just get copied.
79
80 unless ($subfield eq $ff) {
81 push @f, shift @u;
82 next;
83 }
84 last unless defined ($ff = shift @u);
85
86 # Fix the target if necessary and set $altered if anything changed.
87
88 if ($value eq $ff) {
89 push @f, $ff;
90 }
91 else {
92 $altered++;
93 push @f, $value;
94 }
95 $fixed++;
96 }
97
98 # Actually fix the record if required. Again note the use of $template.
99
100 if ($altered) {
101 $marc->updaterecord ($template, @f)
102 || warn "update failed: $template->{field}, $subfield\n";
103 }
104 }
105
106 # This next part is tricky. If fix_subfield is called with just the
107 # four required parameters, you bypass the next step. The preceeding
108 # part is run if searchmarc() finds the field specified in the
109 # $template. But if the field does not exist, and there are optional
110 # parameters in the call to fix_subfield, those parameters are used
111 # as a series of subfields for an addfield(). In plain language, you
112 # can tell fix_subfield what to add if the field doesn't exist.
113
114 elsif (@_) {
115 $marc->addfield($template, @_)
116 || warn "addfield failed: $template->{field}, $subfield\n";
117 $altered++;
118 }
119 return $altered;
120 }
121
122 # The $template hashes for this example:
123
124 my $loc852 = {record=>1, field=>'852', ordered=>'y'};
125 my $loc900 = {record=>1, field=>'900', ordered=>'y'};
126 my $loc999 = {record=>1, field=>'999', ordered=>'n'};
127
128 # The create_if_not_found field specifications:
129
130 my @default900 = ('i1',' ','i2',' ','a');
131 my @default999 = ('i1',' ','i2',' ','c','wL70','d','AR Clinton PL','f');
132
133 my $invalid = 0;
134 my $updated = 0;
135 my $totalcount = 0;
136 my $x = MARC->new;
137 $x->openmarc({file=>$infile,'format'=>"usmarc"}) || die;
138
139 # We process records one at a time for this operation. Multiple 852 fields
140 # are legal (for multiple copies).
141
142 while ($x->nextmarc(1)) {
143 my $change = 0;
144 my @callno = $x->getvalue($loc852,'subfield','h');
145
146 # But multiple 900 and 999 fields are not permitted. So we force a
147 # miscompare if we discover one.
148
149 my ($from900, $dup900) = $x->getvalue($loc900,'subfield','a');
150 if (defined $from900) { push @callno, $from900; }
151 if (defined $dup900) { push @callno, ''; }
152 my ($from999, $dup999) = $x->getvalue($loc999,'subfield','f');
153 if (defined $from999) { push @callno, $from999; }
154 if (defined $dup999) { push @callno, ''; }
155
156 # We now have an array of all the call numbers found. The subroutine
157 # returns an upper-cased version if all compare or '' if not.
158
159 my $callno = check_callno(@callno);
160
161 # Write a "good" result back to everywhere that it should be. Keep track
162 # of which records were modified. And notice that a $template conveys
163 # a lot of repeated information.
164
165 if ($callno) {
166 $x->output({file=>">>$outtext",'format'=>"ascii"});
167
168 # $outtext is a "before" ascii file to compare changes with the "after"
169 # ascii file $outtext4.
170
171 if (fix_subfield($x,$loc852,'h',"$callno")) {
172 $change++;
173 }
174
175 # The 852 subfield passes just the four required parameters. Hence
176 # nothing is added if the 852 field is missing.
177
178 if (fix_subfield($x,$loc900,'a',"$callno",@default900,"$callno")) {
179 $change++;
180 }
181
182 # The 900 and 999 fields are created with default values if they
183 # do not already exist.
184
185 if (fix_subfield($x,$loc999,'f',"$callno",@default999,"$callno")) {
186 $change++;
187 }
188 $x->output({file=>">>$outfile",'format'=>"usmarc"});
189 $x->output({file=>">>$outtext2",'format'=>"ascii"}) if $change;
190 $x->output({file=>">>$outtext4",'format'=>"ascii"});
191 $updated++ if $change;
192 }
193
194 # Write the records with invalid or mismatched call numbers. In this
195 # example, they go into the same usmarc format file $outfile.
196
197 else {
198 $x->output({file=>">>$outfile",'format'=>"usmarc"});
199 $x->output({file=>">>$outtext3",'format'=>"ascii"});
200 $invalid++;
201 }
202 $x->deletemarc(); #empty the object for reading in another
203 $totalcount++;
204 }
205
206 # We write all the records to the output file in MARC format. The ascii
207 # output in $outtext3 gives the librarian both a list of records
208 # requiring manual call number assignment/resolution and all the Title,
209 # Author, Publication and related data needed to assign location based
210 # on standard references. For checking, we write all the modified
211 # records to $outtext2.
212
213 print "\nprocessed $totalcount records\n";
214 print "$updated had call numbers which were changed\n";
215 print "$invalid had missing or invalid call numbers\n";
216
+14
-0
t/MARCopt.pm less more
0 package MARCopt;
1 # Inheritance test for test3.t only
2
3 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
4 $VERSION = '1.04';
5 require Exporter;
6 use MARC;
7 @ISA = qw( Exporter MARC );
8 @EXPORT= qw();
9 @EXPORT_OK= @MARC::EXPORT_OK;
10 %EXPORT_TAGS = %MARC::EXPORT_TAGS;
11
12 print "MARCopt inherits from MARC\n";
13 1;
+1
-0
t/badmarc.dat less more
0 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
+156
-0
t/brkrtest.ref less more
0 =LDR 00000nam\\2200000\a\4500
1 =001 tes96000001\
2 =003 ViArRB
3 =005 19960221075055.7
4 =008 960221s1955\\\\dcuabcdjdbkoqu001\0deng\d
5 =040 \\$aViArRB$cViArRB
6 =050 \4$aPQ1234$b.T39 1955
7 =100 2\$aDeer-Doe, J.$q(Jane),$csaint,$d1355-1401,$cspirit.
8 =245 10$aNew test record number 1 with ordinary data$h[large print] /$cby Jane Deer-Doe ; edited by Patty O'Furniture.
9 =246 1\$aNew test record number one with ordinary data
10 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955-<1957>
11 =300 \\$av. 1-<5> :$bill., maps, ports., charts ;$c cm.
12 =440 \0$aTest record series ;$vno. 1
13 =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.
14 =500 \\$aThis is a test for the conversion of curly braces; the opening curly brace ({lcub}) and the closing curly brace ({rcub}).
15 =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
16 =500 \\$aIncludes index.
17 =650 \4$aTest record$xJuvenile.
18 =600 14$aDoe, John,$d1955- $xBiography.
19 =700 1\$aO'Furniture, Patty,$eed.
20
21 =LDR 00000nam\\2200000\a\4500
22 =001 tes96000002\
23 =003 ViArRB
24 =005 19960221075055.7
25 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
26 =020 \\$a8472236579
27 =040 \\$aViArRB$cViArRB
28 =050 \4$aPQ1234$b.T39 1955
29 =100 2\$aDeer-Doe, Jane,$d1957-
30 =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
31 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
32 =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm.
33 =440 \0$aTest record series ;$vno. 2
34 =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
35 =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
36 =500 \\$aIncludes index.
37 =650 \4$aTest record$xJuvenile.
38 =600 14$aDoe, John,$d1955- $xBiography.
39
40 =LDR 00000nam\\2200000\a\4500
41 =001 tes96000003\
42 =003 ViArRB
43 =005 19960221075055.7
44 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
45 =020 \\$a8472236579
46 =040 \\$aViArRB$cViArRB
47 =050 \4$aPQ1234$b.T39 1955
48 =100 2\$aDeer-Doe, Jane,$d1957-
49 =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
50 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
51 =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm.
52 =440 \0$aTest record series ;$vno. 3
53 =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
54 =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
55 =500 \\$aIncludes index.
56 =650 \4$aTest record$xJuvenile.
57 =600 14$aDoe, John,$d1955- $xBiography.
58
59 =LDR 00000nam\\2200000\a\4500
60 =001 tes96000004\
61 =003 ViArRB
62 =005 19960221075055.7
63 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
64 =020 \\$a8472236579
65 =040 \\$aViArRB$cViArRB
66 =050 \4$aPQ1234$b.T39 1955
67 =100 2\$aDeer-Doe, Jane,$d1957-
68 =245 10$aNew test record number 4 with newly-defined diacritics$h[large print] /$cby Jane Deer-Doe
69 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
70 =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm.
71 =440 \0$aTest record series ;$vno. 4
72 =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!.
73 =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
74 =500 \\$aIncludes index.
75 =650 \4$aTest record$xJuvenile.
76 =600 14$aDoe, John,$d1955- $xBiography.
77
78 =LDR 00000nam\\2200000\a\4500
79 =001 tes96000005\
80 =003 ViArRB
81 =005 19960221075055.7
82 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
83 =020 \\$a8472236579
84 =040 \\$aViArRB$cViArRB
85 =050 \4$aPQ1234$b.T39 1955
86 =100 2\$aDeer-Doe, Jane,$d1957-
87 =245 10$aNew test record number 5 for all diacritics$h[large print] /$cby Jane Deer-Doe
88 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
89 =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm.
90 =440 \0$aTest record series ;$vno. 5
91 =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
92 =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!.
93 =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
94 =500 \\$aIncludes index.
95 =650 \4$aTest record$xJuvenile.
96 =600 14$aDoe, John,$d1955- $xBiography.
97
98 =LDR 00000nam\\2200000\a\4500
99 =001 tes96000006\
100 =003 ViArRB
101 =005 19960221075055.7
102 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
103 =020 \\$a8472236579
104 =040 \\$aViArRB$cViArRB
105 =050 \4$aPQ1234$b.T39 1955
106 =100 2\$aDeer-Doe, Jane,$d1957-
107 =245 12$aA new ultimate test record for diacritics$h[large print] /$cby Jane Deer-Doe
108 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
109 =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm.
110 =440 \0$aTest record series ;$vno. 6
111 =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
112 =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!.
113 =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
114 =500 \\$aIncludes index.
115 =650 \4$aTest record$xJuvenile.
116 =600 14$aDoe, John,$d1955- $xBiography.
117
118 =LDR 00000nam\\2200000\a\4500
119 =001 tes96000007\
120 =003 ViArRB
121 =005 19960221075055.7
122 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
123 =020 \\$a8472236579
124 =040 \\$aViArRB$cViArRB
125 =050 \4$aPQ1234$b.T39 1955
126 =100 2\$aDeer-Doe, Jane,$d1957-
127 =245 12$aA check of the processing of unrecognized mnemonic strings like {zilch} which might be encountered in the MARCMakr input file.
128 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
129 =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm.
130 =440 \0$aTest record series ;$vno. 7
131 =500 \\$aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called ({bsol}).
132 =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews.
133 =500 \\$aIncludes index.
134 =650 \4$aTest record$xJuvenile.
135 =600 14$aDoe, John,$d1955- $xBiography.
136 =856 2\$aftp.loc.gov$d{bsol}pub{bsol}marc
137
138 =LDR 00000nam\\2200000\a\4500
139 =001 tes96000008\
140 =003 ViArRB
141 =005 19960221075055.7
142 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
143 =020 \\$a8472236579
144 =020 \\$a0777000008 :$c{dollar}35.99
145 =020 \\$a0777000008 :$c{dollar}35.99
146 =020 \\$z3777000008 (German ed.):$c{dollar}46.00
147 =040 \\$aViArRB$cViArRB
148 =050 \4$aPQ1234$b.T39 1955
149 =100 2\$aDeer-Doe, Jane,$d1957-
150 =245 12$aA check of the processing of the dollar sign and mnemonic strings used for real dollar signs (associated with prices).
151 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
152 =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm.
153 =440 \0$aTest record series ;$vno. 8
154 =500 \\$aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called ({bsol}).
155
+1
-0
t/makrbrkr.mrc less more
0 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 (\).⏎
+69
-0
t/makrtest.bad less more
0 =LDR 00000nam\\2200000\a\4500
1 =001 tes96000001\
2 =003 ViArRB
3 =005 199602210153555.7
4 =008 960221s1955\\\\dcuabcdjdbkoqu001\0deng\d
5 =040 \\$aViArRB$cViArRB
6 =050 \4$aPQ1234$b.T39 1955
7 =100 2 $aDeer-Doe, J.$q(Jane),$csaint,$d1355-1401,$cspirit.
8 =245 10$aNew test record number 1 with ordinary data$h[large print]
9 /$cby Jane Deer-Doe ; edited by Patty O'Furniture.
10 =246 1\$aNew test record number one with ordinary data
11 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955-<1957>
12 =300 \\$av. 1-<5>\:$bill., maps, ports., charts ;$c\cm.
13 =440 \0$aTest record series ;$vno. 1
14 =500 \\$aThis is a test of ordinary features like replacement of the
15 mnemonics for currency and dollar signs and backslashes (backsolidus {bsol})
16 used for blanks in certain areas.
17 =500 \\$aThis is a test for the conversion of curly braces; the opening
18 curly brace ({lcub}) and the closing curly brace ({rcub}).
19 =504 \\$aIncludes Bibliographies, discographies, filmographies,
20 and reviews.
21 =500 \\$aIncludes index.
22 =650 \4$aTest record$xJuvenile.
23 =600 14$aDoe, John,$d1955- $xBiography.
24 =700 1\$aO'Furniture, Patty,$eed.
25
26 =LDR 00000nam\\2200000\a\4500
27 =001 tes96000007\
28 =003 ViArRB
29 =005 19960221165955.9
30 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
31 =020 \\$a8472236579
32 =040 \\$aViArRB$cViArRB
33 =050 \4$aPQ1234$b.T39 1955
34 =100 2 $aDeer-Doe, Jane,$d1957-
35 =245 12$aA check of the processing of unrecognized mnemonic strings
36 like {zilch} which might be encountered in the MARCMakr input file.
37 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
38 =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
39 =440 \0$aTest record series ;$vno. 7
40 =500 \\$aThis is a test of mnemonic conversion, like a real
41 backslash or back solidus, as it is sometimes called ({bsol}).
42 =504 \\$aIncludes Bibliographies, discographies, filmographies,
43 and reviews.
44 =500 \\$aIncludes index.
45 =650 \4$aTest record$xJuvenile.
46 =600 14$aDoe, John,$d1955- $xBiography.
47 =856 2\$aftp.loc.gov$d{bsol}pub{bsol}marc
48
49 =bad 00000nam\\2200000\a\4500
50 =001 tes96000008\
51 =003 ViArRB
52 =005 19960221195511.9
53 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
54 =020 \\$a8472236579
55 =020 \\$a0777000008 :$c{24}35.99
56 =020 \\$a0777000008 :$c{curren}35.99
57 =020 \\$z3777000008 (German ed.):$c{dollar}46.00
58 =040 \\$aViArRB$cViArRB
59 =050 \4$aPQ1234$b.T39 1955
60 =100 2 $aDeer-Doe, Jane,$d1957-
61 =245 12$aA check of the processing of the dollar sign and mnemonic strings
62 used for real dollar signs (associated with prices).
63 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
64 =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
65 =440 \0$aTest record series ;$vno. 8
66 =500 \\$aThis is a test of mnemonic conversion, like a real
67 backslash or back solidus, as it is sometimes called ({bsol}).
68
+329
-0
t/makrtest.src less more
0 =LDR 00000nam\\2200000\a\4500
1 =001 tes96000001\
2 =003 ViArRB
3 =005 19960221075055.7
4 =008 960221s1955\\\\dcuabcdjdbkoqu001\0deng\d
5 =040 \\$aViArRB$cViArRB
6 =050 \4$aPQ1234$b.T39 1955
7 =100 2 $aDeer-Doe, J.$q(Jane),$csaint,$d1355-1401,$cspirit.
8 =245 10$aNew test record number 1 with ordinary data$h[large print]
9 /$cby Jane Deer-Doe ; edited by Patty O'Furniture.
10 =246 1\$aNew test record number one with ordinary data
11 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955-<1957>
12 =300 \\$av. 1-<5>\:$bill., maps, ports., charts ;$c\cm.
13 =440 \0$aTest record series ;$vno. 1
14 =500 \\$aThis is a test of ordinary features like replacement of the
15 mnemonics for currency and dollar signs and backslashes (backsolidus {bsol})
16 used for blanks in certain areas.
17 =500 \\$aThis is a test for the conversion of curly braces; the opening
18 curly brace ({lcub}) and the closing curly brace ({rcub}).
19 =504 \\$aIncludes Bibliographies, discographies, filmographies,
20 and reviews.
21 =500 \\$aIncludes index.
22 =650 \4$aTest record$xJuvenile.
23 =600 14$aDoe, John,$d1955- $xBiography.
24 =700 1\$aO'Furniture, Patty,$eed.
25
26 =LDR 00000nam\\2200000\a\4500
27 =001 tes96000002\
28 =003 ViArRB
29 =005 19960221075055.7
30 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
31 =020 \\$a8472236579
32 =040 \\$aViArRB$cViArRB
33 =050 \4$aPQ1234$b.T39 1955
34 =100 2 $aDeer-Doe, Jane,$d1957-
35 =245 10$aNew test record number 2 with currently defined
36 ANSEL characters (mostly diacritics) input with their real hexadecimal
37 values$h[large print] /$cby Jane Deer-Doe
38 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
39 =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
40 =440 \0$aTest record series ;$vno. 2
41 =500 \\$aThis is a test of diacritics like the uppercase Polish L in ¡âodâz,
42 the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro,
43 the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir,
44 the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot
45 in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª,
46 the plus or minus sign in «54%, the uppercase O-hook in B¬,
47 the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab,
48 the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in
49 K²benhavn, the lowercase d with crossbar in ³avola, the lowercase
50 Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase
51 digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless
52 i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur,
53 the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase
54 u-hook in T½ D½c, the pseudo question mark in càui, the grave accent
55 in tráes, the acute accent in dâesirâee, the circumflex in cãote, the
56 tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot
57 above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek)
58 in écrny, the circle above (angstrom) in êarbok, the ligature first and
59 second halves in dëiìadëiìa, the high comma off center in rozdelíovac,
60 the double acute in idîoszaki, the candrabindu (breve with dot above)
61 in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña,
62 the dot below in teòda, the double dot below in ököhuótbah, the circle
63 below in Saòmskôrta, the double underscore in õGhulam, the left hook
64 in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the
65 upadhmaniya (half circle below) in ùhumantués, double tilde, first and
66 second halves in únûgalan, high comma (centered) in gþeotermika
67 =504 \\$aIncludes Bibliographies, discographies, filmographies,
68 and reviews.
69 =500 \\$aIncludes index.
70 =650 \4$aTest record$xJuvenile.
71 =600 14$aDoe, John,$d1955- $xBiography.
72
73 =LDR 00000nam\\2200000\a\4500
74 =001 tes96000003
75 =003 ViArRB
76 =005 19960221075055.7
77 =008 960221s1955\\ dcuabcdjdbkoqu001 0dspa d
78 =020 \\$a8472236579
79 =040 \\$aViArRB$cViArRB
80 =050 4$aPQ1234$b.T39 1955
81 =100 2 $aDeer-Doe, Jane,$d1957-
82 =245 10$aNew test record number 3 with currently defined
83 ANSEL characters (mostly diacritics) input with mnemonic strings
84 $h[large print] /$cby Jane Deer-Doe
85 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
86 =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm.
87 =440 0$aTest record series ;$vno. 3
88 =500 \\$aThis is a test of diacritics like the uppercase
89 Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia
90 O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro,
91 the uppercase Icelandic thorn in {THORN}ann, the uppercase
92 digraph AE in {AElig}gir, the uppercase digraph OE in
93 {OElig}uvres, the soft sign in rech{softsign}, the middle
94 dot in col{middot}lecci{acute}o, the musical flat in F
95 {flat}, the patent mark in Frizbee{reg}, the plus or minus
96 sign in {plusmn}54%, the uppercase O-hook in B{Ohorn},
97 the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah,
98 the ayn in {mllhring}arab, the lowercase Polish l in W
99 {lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K
100 {ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola,
101 the lowercase Icelandic thorn in {thorn}ann, the lowercase
102 digraph ae in v{aelig}re, the lowercase digraph oe in c
103 {oelig}ur, the lowercase hardsign in s{hardsign}ezd, the
104 Turkish dotless i in masal{inodot}, the British pound sign
105 in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase
106 o-hook (with pseudo question mark) in S{hooka}{ohorn},
107 the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo
108 question mark in c{hooka}ui, the grave accent in tr{grave}es,
109 the acute accent in d{acute}esir{acute}ee, the circumflex
110 in c{circ}ote, the tilde in ma{tilde}nana, the macron in
111 T{macr}okyo, the breve in russki{breve}i, the dot above
112 in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au,
113 the caron (hachek) in {caron}crny, the circle above (angstrom)
114 in {ring}arbok, the ligature first and second halves in
115 d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center
116 in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki,
117 the candrabindu (breve with dot above) in Ali{candra}iev,
118 the cedilla in {cedil}ca va comme {cedil}ca, the right
119 hook in viet{ogon}a, the dot below in te{dotb}da, the double
120 dot below in {under}k{under}hu{dbldotb}tbah, the circle
121 below in Sa{dotb}msk{ringb}rta, the double underscore in
122 {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa,
123 the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya
124 (half circle below) in {breveb}humantu{caron}s, double
125 tilde, first and second halves in {ldbltil}n{rdbltil}galan,
126 high comma (centered) in g{commaa}eotermika
127 =504 \\$aIncludes Bibliographies, discographies, filmographies,
128 and reviews.
129 =500 \\$aIncludes index.
130 =650 4$aTest record$xJuvenile.
131 =600 14$aDoe, John,$d1955- $xBiography.
132
133 =LDR 00000nam\\2200000\a\4500
134 =001 tes96000004\
135 =003 ViArRB
136 =005 19960221075055.7
137 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
138 =020 \\$a8472236579
139 =040 \\$aViArRB$cViArRB
140 =050 \4$aPQ1234$b.T39 1955
141 =100 2 $aDeer-Doe, Jane,$d1957-
142 =245 10$aNew test record number 4 with newly-defined diacritics
143 $h[large print] /$cby Jane Deer-Doe
144 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
145 =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
146 =440 \0$aTest record series ;$vno. 4
147 =500 \\$aThis field tests the 13 new USMARC characters
148 which include the spacing circumflex "^", the spacing underscore
149 in "file_name", the grave "`", the spacing tilde "~", and
150 the opening and closing curly brackets, {lcub}text{rcub},
151 also included are new extended characters degree sign 98.6
152 {deg}, small script l in 45{scriptl}, the phono copyright
153 mark in {phono}1994, the copyright mark in {copy}1955,
154 the musical sharp in concerto in F{sharp} major, the inverted
155 question mark in {iquest}Que pas{acute}o?, and the inverted
156 exclamation mark in {iexcl}Ay caramba!.
157 =504 \\$aIncludes Bibliographies, discographies, filmographies,
158 and reviews.
159 =500 \\$aIncludes index.
160 =650 \4$aTest record$xJuvenile.
161 =600 14$aDoe, John,$d1955- $xBiography.
162
163 =LDR 00000nam\\2200000\a\4500
164 =001 tes96000005\
165 =003 ViArRB
166 =005 19960221075055.7
167 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
168 =020 \\$a8472236579
169 =040 \\$aViArRB$cViArRB
170 =050 \4$aPQ1234$b.T39 1955
171 =100 2 $aDeer-Doe, Jane,$d1957-
172 =245 10$aNew test record number 5 for all diacritics$h[large print]
173 /$cby Jane Deer-Doe
174 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
175 =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
176 =440 \0$aTest record series ;$vno. 5
177 =500 \\$aThis is a test of diacritics like the uppercase Polish L in ¡âodâz,
178 the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro,
179 the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir,
180 the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot
181 in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª,
182 the plus or minus sign in «54%, the uppercase O-hook in B¬,
183 the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab,
184 the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in
185 K²benhavn, the lowercase d with crossbar in ³avola, the lowercase
186 Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase
187 digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless
188 i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur,
189 the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase
190 u-hook in T½ D½c, the pseudo question mark in càui, the grave accent
191 in tráes, the acute accent in dâesirâee, the circumflex in cãote, the
192 tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot
193 above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek)
194 in écrny, the circle above (angstrom) in êarbok, the ligature first and
195 second halves in dëiìadëiìa, the high comma off center in rozdelíovac,
196 the double acute in idîoszaki, the candrabindu (breve with dot above)
197 in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña,
198 the dot below in teòda, the double dot below in ököhuótbah, the circle
199 below in Saòmskôrta, the double underscore in õGhulam, the left hook
200 in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the
201 upadhmaniya (half circle below) in ùhumantués, double tilde, first and
202 second halves in únûgalan, high comma (centered) in gþeotermika
203 =500 \\$aThis field tests the 13 new USMARC characters which include the
204 spacing circumflex "^", the spacing underscore in "file_name", the
205 grave "`", the spacing tilde "~", and the opening and closing curly
206 brackets, {lcub}text{rcub}; also included are new extended characters
207 degree sign 98.6À, small script l in 45Á, the phono copyright mark in
208 Á1994, the copyright mark in Â1955, the musical sharp in concerto in
209 FÃ major, the inverted question mark in ÅQue pasâo?, and the inverted
210 exclamation mark in ÆAy caramba!.
211 =504 \\$aIncludes Bibliographies, discographies, filmographies,
212 and reviews.
213 =500 \\$aIncludes index.
214 =650 \4$aTest record$xJuvenile.
215 =600 14$aDoe, John,$d1955- $xBiography.
216
217 =LDR 00000nam\\2200000\a\4500
218 =001 tes96000006\
219 =003 ViArRB
220 =005 19960221075055.7
221 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
222 =020 \\$a8472236579
223 =040 \\$aViArRB$cViArRB
224 =050 \4$aPQ1234$b.T39 1955
225 =100 2 $aDeer-Doe, Jane,$d1957-
226 =245 12$aA new ultimate test record for diacritics$h[large print]
227 /$cby Jane Deer-Doe
228 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
229 =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
230 =440 \0$aTest record series ;$vno. 6
231 =500 \\$aThis is a test of diacritics like the uppercase
232 Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia
233 O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro,
234 the uppercase Icelandic thorn in {THORN}ann, the uppercase
235 digraph AE in {AElig}gir, the uppercase digraph OE in
236 {OElig}uvres, the soft sign in rech{softsign}, the middle
237 dot in col{middot}lecci{acute}o, the musical flat in F
238 {flat}, the patent mark in Frizbee{reg}, the plus or minus
239 sign in {plusmn}54%, the uppercase O-hook in B{Ohorn},
240 the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah,
241 the ayn in {mllhring}arab, the lowercase Polish l in W
242 {lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K
243 {ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola,
244 the lowercase Icelandic thorn in {thorn}ann, the lowercase
245 digraph ae in v{aelig}re, the lowercase digraph oe in c
246 {oelig}ur, the lowercase hardsign in s{hardsign}ezd, the
247 Turkish dotless i in masal{inodot}, the British pound sign
248 in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase
249 o-hook (with pseudo question mark) in S{hooka}{ohorn},
250 the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo
251 question mark in c{hooka}ui, the grave accent in tr{grave}es,
252 the acute accent in d{acute}esir{acute}ee, the circumflex
253 in c{circ}ote, the tilde in ma{tilde}nana, the macron in
254 T{macr}okyo, the breve in russki{breve}i, the dot above
255 in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au,
256 the caron (hachek) in {caron}crny, the circle above (angstrom)
257 in {ring}arbok, the ligature first and second halves in
258 d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center
259 in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki,
260 the candrabindu (breve with dot above) in Ali{candra}iev,
261 the cedilla in {cedil}ca va comme {cedil}ca, the right
262 hook in viet{ogon}a, the dot below in te{dotb}da, the double
263 dot below in {under}k{under}hu{dbldotb}tbah, the circle
264 below in Sa{dotb}msk{ringb}rta, the double underscore in
265 {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa,
266 the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya
267 (half circle below) in {breveb}humantu{caron}s, double
268 tilde, first and second halves in {ldbltil}n{rdbltil}galan,
269 high comma (centered) in g{commaa}eotermika
270 =500 \\$aThis field tests the 13 new USMARC characters
271 which include the spacing circumflex "^", the spacing underscore
272 in "file_name", the grave "`", the spacing tilde "~", and
273 the opening and closing curly brackets, {lcub}text{rcub},
274 also included are new extended characters degree sign 98.6
275 {deg}, small script l in 45{scriptl}, the phono copyright
276 mark in {phono}1994, the copyright mark in {copy}1955,
277 the musical sharp in concerto in F{sharp} major, the inverted
278 question mark in {iquest}Que pas{acute}o?, and the inverted
279 exclamation mark in {iexcl}Ay caramba!.
280 =504 \\$aIncludes Bibliographies, discographies, filmographies,
281 and reviews.
282 =500 \\$aIncludes index.
283 =650 \4$aTest record$xJuvenile.
284 =600 14$aDoe, John,$d1955- $xBiography.
285
286 =LDR 00000nam\\2200000\a\4500
287 =001 tes96000007\
288 =003 ViArRB
289 =005 19960221075055.7
290 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
291 =020 \\$a8472236579
292 =040 \\$aViArRB$cViArRB
293 =050 \4$aPQ1234$b.T39 1955
294 =100 2 $aDeer-Doe, Jane,$d1957-
295 =245 12$aA check of the processing of unrecognized mnemonic strings
296 like {zilch} which might be encountered in the MARCMakr input file.
297 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
298 =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
299 =440 \0$aTest record series ;$vno. 7
300 =500 \\$aThis is a test of mnemonic conversion, like a real
301 backslash or back solidus, as it is sometimes called ({bsol}).
302 =504 \\$aIncludes Bibliographies, discographies, filmographies,
303 and reviews.
304 =500 \\$aIncludes index.
305 =650 \4$aTest record$xJuvenile.
306 =600 14$aDoe, John,$d1955- $xBiography.
307 =856 2\$aftp.loc.gov$d{bsol}pub{bsol}marc
308
309 =LDR 00000nam\\2200000\a\4500
310 =001 tes96000008\
311 =003 ViArRB
312 =005 19960221075055.7
313 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d
314 =020 \\$a8472236579
315 =020 \\$a0777000008 :$c{24}35.99
316 =020 \\$a0777000008 :$c{curren}35.99
317 =020 \\$z3777000008 (German ed.):$c{dollar}46.00
318 =040 \\$aViArRB$cViArRB
319 =050 \4$aPQ1234$b.T39 1955
320 =100 2 $aDeer-Doe, Jane,$d1957-
321 =245 12$aA check of the processing of the dollar sign and mnemonic strings
322 used for real dollar signs (associated with prices).
323 =260 \\$aWashington, DC :$bLibrary of Congress,$c1955.
324 =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm.
325 =440 \0$aTest record series ;$vno. 8
326 =500 \\$aThis is a test of mnemonic conversion, like a real
327 backslash or back solidus, as it is sometimes called ({bsol}).
328
+1
-0
t/marc.dat less more
0 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⏎
+1
-0
t/marc4.dat less more
0 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⏎
+473
-0
t/test1.t less more
0 #!/usr/bin/perl -w
1
2 # Before `make install' is performed this script should be runnable with
3 # `make test'. After `make install' it should work as `perl test1.t'
4
5 use lib '.','./t'; # for inheritance and Win32 test
6
7 ######################### We start with some black magic to print on failure.
8
9 BEGIN { $| = 1; print "1..187\n"; }
10 END {print "not ok 1\n" unless $loaded;}
11 use MARC 1.03;
12 $loaded = 1;
13 print "ok 1\n";
14
15 ######################### End of black magic.
16 #
17 #Added tests should have an comment matching /# \d/
18 #If so, the following will renumber all the tests
19 #to match Perl's idea of test:
20 #perl -pe 'BEGIN{$i=1};if (/# \d/){ $i++};s/# \d+/# $i/' test1.t > test1.t1
21 #
22 ######################### End of test renumber.
23
24 use strict;
25
26 my $tc = 2; # next test number
27
28 sub is_ok {
29 my $result = shift;
30 printf (($result ? "" : "not ")."ok %d\n",$tc++);
31 return $result;
32 }
33
34 sub is_zero {
35 my $result = shift;
36 if (defined $result) {
37 return is_ok ($result == 0);
38 }
39 else {
40 printf ("not ok %d\n",$tc++);
41 }
42 }
43
44 sub is_bad {
45 my $result = shift;
46 printf (($result ? "not " : "")."ok %d\n",$tc++);
47 return (not $result);
48 }
49
50 sub filestring {
51 my $file = shift;
52 local $/ = undef;
53 unless (open(YY, $file)) {warn "Can't open file $file: $!\n"; return;}
54 binmode YY;
55 my $yy = <YY>;
56 unless (close YY) {warn "Can't close file $file: $!\n"; return;}
57 return $yy;
58 }
59
60 my $file = "marc.dat";
61 my $file2 = "badmarc.dat";
62 my $testdir = "t";
63 if (-d $testdir) {
64 $file = "$testdir/$file";
65 $file2 = "$testdir/$file2";
66 }
67 unless (-e $file) {
68 die "No MARC sample file found\n";
69 }
70 unless (-e $file2) {
71 die "Missing bad sample file for MARC tests: $file2\n";
72 }
73
74 my $naptime = 0; # pause between output pages
75 if (@ARGV) {
76 $naptime = shift @ARGV;
77 unless ($naptime =~ /^[0-5]$/) {
78 die "Usage: perl test?.t [ page_delay (0..5) ]";
79 }
80 }
81
82 my $x;
83 unlink 'output.txt', 'output.html', 'output.xml', 'output.isbd',
84 'output.urls', 'output2.html', 'output.mkr';
85
86 # Create the new MARC object. You can use any variable name you like...
87 # Read the MARC file into the MARC object.
88
89 unless (is_ok ($x = MARC->new ($file))) { # 2
90 printf "could not create MARC from $file\n";
91 exit 1;
92 # next test would die at runtime without $x
93 }
94
95 is_ok (2 == $x->marc_count); # 3
96
97 #Output the MARC object to an ascii file
98 is_ok ($x->output({file=>">output.txt",'format'=>"ASCII"})); # 4
99
100 #Output the MARC object to an html file
101 is_ok ($x->output({file=>">output.html",'format'=>"HTML"})); # 5
102
103 #Try to output the MARC object to an xml file
104 my $quiet = $^W;
105 $^W = 0;
106 is_bad ($x->output({file=>">output.xml",'format'=>"XML"})); # 6
107 $^W = $quiet;
108
109 #Output the MARC object to an url file
110 is_ok ($x->output({file=>">output.urls",'format'=>"URLS"})); # 7
111
112 #Output the MARC object to an isbd file
113 is_ok ($x->output({file=>">output.isbd",'format'=>"ISBD"})); # 8
114
115 #Output the MARC object to a marcmaker file
116 is_ok ($x->output({file=>">output.mkr",'format'=>"marcmaker"})); # 9
117
118 #Output the MARC object to an html file with titles
119 is_ok ($x->output({file=>">output2.html",
120 'format'=>"HTML","245"=>"TITLE:"})); # 10
121
122 is_ok (-s 'output.txt'); # 11
123 is_ok (-s 'output.html'); # 12
124 is_bad (-e 'output.xml'); # 13
125 is_ok (-s 'output.urls'); # 14
126
127 #Append the MARC object to an html file with titles
128 is_ok ($x->output({file=>">>output2.html",
129 'format'=>"HTML","245"=>"TITLE:"})); # 15
130
131 #Append to an html file with titles incrementally
132 is_ok ($x->output({file=>">output.html",'format'=>"HTML_START"})); # 16
133 is_ok ($x->output({file=>">>output.html",
134 'format'=>"HTML_BODY","245"=>"TITLE:"})); # 17
135 is_ok ($x->output({file=>">>output.html",'format'=>"HTML_FOOTER"})); # 18
136
137 my ($y1, $y2, $yy);
138 is_ok ($y1 = $x->output({'format'=>"HTML","245"=>"TITLE:"})); # 19
139 $y2 = "$y1$y1";
140 is_ok ($yy = filestring ("output2.html")); # 20
141 is_ok ($yy eq $y2); # 21
142
143 if ($naptime) {
144 print "++++ page break\n";
145 sleep $naptime;
146 }
147
148 is_ok ($yy = filestring ("output.html")); # 22
149 is_ok ($y1 eq $yy); # 23
150
151 #Simple test of (un)?pack.*
152 my $mldr = $x->ldr(1);
153 my $rhldr = $x->unpack_ldr(1);
154 is_ok('c' eq ${$rhldr}{RecStat}); # 24
155 is_ok('a' eq ${$rhldr}{Type}); # 25
156 is_ok('m' eq ${$rhldr}{BLvl}); # 26
157
158 my $rhff = $x->unpack_008(1);
159 is_ok('741021' eq ${$rhff}{Entered}); # 27
160 is_ok('s' eq ${$rhff}{DtSt}); # 28
161 is_ok('1884' eq ${$rhff}{Date1}); # 29
162
163 my ($m000) = $x->getvalue({field=>'000',record=>1});
164 my ($m001) = $x->getvalue({field=>'001',record=>1});
165 my ($m003) = $x->getvalue({field=>'003',record=>1});
166 my ($m005) = $x->getvalue({field=>'005',record=>1});
167 my ($m008) = $x->getvalue({field=>'008',record=>1});
168
169 is_ok($m000 eq "00901cam 2200241Ia 45e0"); # 30
170 is_ok($m001 eq "ocm01047729 "); # 31
171 is_ok($m003 eq "OCoLC"); # 32
172 is_ok($m005 eq "19990808143752.0"); # 33
173 is_ok($m008 eq "741021s1884 enkaf 000 1 eng d"); # 34
174
175 is_ok($x->_pack_ldr($rhldr) eq $m000); # 35
176 is_ok($x->_pack_ldr($rhldr) eq $x->ldr(1)); # 36
177 is_ok($x->_pack_008($m000,$rhff) eq $m008); # 37
178
179 $x->pack_ldr(1);
180 is_ok($x->ldr(1) eq $mldr); # 38
181 $x->pack_008(1);
182 my ($cmp008) = $x->getvalue({field=>'008',record=>1});
183 is_ok($cmp008 eq $m008); # 39
184
185 my ($indi1) = $x->getvalue({field=>'245',record=>1,subfield=>'i1'});
186 my ($indi2) = $x->getvalue({field=>'245',record=>1,subfield=>'i2'});
187 my ($indi12) = $x->getvalue({field=>'245',record=>1,subfield=>'i12'});
188
189 is_ok($indi1 eq "1"); # 40
190 is_ok($indi2 eq "4"); # 41
191 is_ok($indi12 eq "14"); # 42
192
193 my ($m100a) = $x->getvalue({field=>'100',record=>1,subfield=>'a'});
194 my ($m100d) = $x->getvalue({field=>'100',record=>1,subfield=>'d'});
195 my ($m100e) = $x->getvalue({field=>'100',record=>1,subfield=>'e'});
196
197 if ($naptime) {
198 print "++++ page break\n";
199 sleep $naptime;
200 }
201
202 is_ok($m100a eq "Twain, Mark,"); # 43
203 is_ok($m100d eq "1835-1910."); # 44
204 is_bad(defined $m100e); # 45
205
206 my @ind12 = $x->getvalue({field=>'246',record=>2,subfield=>'i12'});
207 is_ok(3 == scalar @ind12); # 46
208 is_ok($ind12[0] eq "30"); # 47
209 is_ok($ind12[1] eq "3 "); # 48
210 is_ok($ind12[2] eq "30"); # 49
211
212 my @m246a = $x->getvalue({field=>'246',record=>2,subfield=>'a'});
213 is_ok(3 == scalar @m246a); # 50
214 is_ok($m246a[0] eq "Photo archive"); # 51
215 is_ok($m246a[1] eq "Associated Press photo archive"); # 52
216 is_ok($m246a[2] eq "AP photo archive"); # 53
217
218 my @records=$x->searchmarc({field=>"245"});
219 is_ok(2 == scalar @records); # 54
220 is_ok($records[0] == 1); # 55
221 is_ok($records[1] == 2); # 56
222
223 @records=$x->searchmarc({field=>"245",subfield=>"a"});
224 is_ok(2 == scalar @records); # 57
225 is_ok($records[0] == 1); # 58
226 is_ok($records[1] == 2); # 59
227
228 @records=$x->searchmarc({field=>"245",subfield=>"b"});
229 is_ok(1 == scalar @records); # 60
230 is_ok($records[0] == 1); # 61
231
232 @records=$x->searchmarc({field=>"245",subfield=>"h"});
233 is_ok(1 == scalar @records); # 62
234 is_ok($records[0] == 2); # 63
235
236 if ($naptime) {
237 print "++++ page break\n";
238 sleep $naptime;
239 }
240
241 @records=$x->searchmarc({field=>"246",subfield=>"a"});
242 is_ok(1 == scalar @records); # 64
243 is_ok($records[0] == 2); # 65
244
245 @records=$x->searchmarc({field=>"245",regex=>"/huckleberry/i"});
246 is_ok(1 == scalar @records); # 66
247 is_ok($records[0] == 1); # 67
248
249 @records=$x->searchmarc({field=>"260",subfield=>"c",regex=>"/19../"});
250 is_ok(1 == scalar @records); # 68
251 is_ok($records[0] == 2); # 69
252
253 @records=$x->searchmarc({field=>"245",notregex=>"/huckleberry/i"});
254 is_ok(1 == scalar @records); # 70
255 is_ok($records[0] == 2); # 71
256
257 @records=$x->searchmarc({field=>"260",subfield=>"c",notregex=>"/19../"});
258 is_ok(1 == scalar @records); # 72
259 is_ok($records[0] == 1); # 73
260
261 @records=$x->searchmarc({field=>"900",subfield=>"c"});
262 is_ok(0 == scalar @records); # 74
263 is_bad(defined $records[0]); # 75
264
265 @records=$x->searchmarc({field=>"999"});
266 is_ok(0 == scalar @records); # 76
267 is_bad(defined $records[0]); # 77
268
269 is_ok (-s 'output.isbd'); # 78
270 is_ok (-s 'output.mkr'); # 79
271
272 my $update246 = {field=>'246',record=>2,ordered=>'y'};
273 my @u246 = $x->getupdate($update246);
274 is_ok(21 == @u246); # 80
275
276 is_ok(1 == $x->searchmarc($update246)); # 81
277 is_ok(3 == $x->deletemarc($update246)); # 82
278
279 if ($naptime) {
280 print "++++ page break\n";
281 sleep $naptime;
282 }
283
284 is_ok($u246[0] eq "i1"); # 83
285 is_ok($u246[1] eq "3"); # 84
286 is_ok($u246[2] eq "i2"); # 85
287 is_ok($u246[3] eq "0"); # 86
288 is_ok($u246[4] eq "a"); # 87
289 is_ok($u246[5] eq "Photo archive"); # 88
290 is_ok($u246[6] eq "\036"); # 89
291
292 is_ok($u246[7] eq "i1"); # 90
293 is_ok($u246[8] eq "3"); # 91
294 is_ok($u246[9] eq "i2"); # 92
295 is_ok($u246[10] eq " "); # 93
296 is_ok($u246[11] eq "a"); # 94
297 is_ok($u246[12] eq "Associated Press photo archive"); # 95
298 is_ok($u246[13] eq "\036"); # 96
299
300 is_ok($u246[14] eq "i1"); # 97
301 is_ok($u246[15] eq "3"); # 98
302 is_ok($u246[16] eq "i2"); # 99
303 is_ok($u246[17] eq "0"); # 100
304 is_ok($u246[18] eq "a"); # 101
305 is_ok($u246[19] eq "AP photo archive"); # 102
306 is_ok($u246[20] eq "\036"); # 103
307
308 if ($naptime) {
309 print "++++ page break\n";
310 sleep $naptime;
311 }
312
313 is_ok ($y1 = $x->output({'format'=>"HTML_HEADER"})); # 104
314 my $header = "Content-type: text/html\015\012\015\012";
315 is_ok ($y1 eq $header); # 105
316
317 is_ok ($y1 = $x->output({'format'=>"HTML_START"})); # 106
318 $header = "<html><body>";
319 is_ok ($y1 eq $header); # 107
320
321 is_ok ($y1 = $x->output({'format'=>"HTML_START",'title'=>"Testme"})); # 108
322 $header = "<html><head><title>Testme</title></head>\n<body>";
323 is_ok ($y1 eq $header); # 109
324
325 is_ok ($y1 = $x->output({'format'=>"HTML_FOOTER"})); # 110
326 $header = "\n</body></html>\n";
327 is_ok ($y1 eq $header); # 111
328
329 is_ok(0 == $x->searchmarc($update246)); # 112
330 @records = $x->getupdate($update246);
331 is_ok(0 == @records); # 113
332
333 # prototype setupdate()
334 @records = ();
335 foreach $y1 (@u246) {
336 unless ($y1 eq "\036") {
337 push @records, $y1;
338 next;
339 }
340 $x->addfield($update246, @records) || warn "not added\n";
341 @records = ();
342 }
343
344 @u246 = $x->getupdate($update246);
345 is_ok(21 == @u246); # 114
346
347 is_ok($u246[0] eq "i1"); # 115
348 is_ok($u246[1] eq "3"); # 116
349 is_ok($u246[2] eq "i2"); # 117
350 is_ok($u246[3] eq "0"); # 118
351 is_ok($u246[4] eq "a"); # 119
352 is_ok($u246[5] eq "Photo archive"); # 120
353 is_ok($u246[6] eq "\036"); # 121
354
355 is_ok($u246[7] eq "i1"); # 122
356 is_ok($u246[8] eq "3"); # 123
357
358 if ($naptime) {
359 print "++++ page break\n";
360 sleep $naptime;
361 }
362
363 is_ok($u246[9] eq "i2"); # 124
364 is_ok($u246[10] eq " "); # 125
365 is_ok($u246[11] eq "a"); # 126
366 is_ok($u246[12] eq "Associated Press photo archive"); # 127
367 is_ok($u246[13] eq "\036"); # 128
368
369 is_ok($u246[14] eq "i1"); # 129
370 is_ok($u246[15] eq "3"); # 130
371 is_ok($u246[16] eq "i2"); # 131
372 is_ok($u246[17] eq "0"); # 132
373 is_ok($u246[18] eq "a"); # 133
374
375 is_ok($u246[19] eq "AP photo archive"); # 134
376 is_ok($u246[20] eq "\036"); # 135
377
378 @records = $x->searchmarc({field=>'900'});
379 is_ok(0 == @records); # 136
380 @records = $x->searchmarc({field=>'999'});
381 is_ok(0 == @records); # 137
382
383 is_ok($x->addfield({record=>1, field=>"999", ordered=>"n",
384 i1=>"5", i2=>"3", value=>[c=>"wL70",
385 d=>"AR Clinton PL",f=>"53525"]})); # 138
386
387 is_ok($x->addfield({record=>1, field=>"900", ordered=>"y",
388 i1=>"6", i2=>"7", value=>[z=>"part 1",
389 z=>"part 2",z=>"part 3"]})); # 139
390
391 is_ok($x->addfield({record=>2, field=>"900", ordered=>"y",
392 i1=>"9", i2=>"8", value=>[z=>"part 4"]})); # 140
393
394 @records = $x->searchmarc({field=>'900'});
395 is_ok(2 == @records); # 141
396 @records = $x->searchmarc({field=>'999'});
397 is_ok(1 == @records); # 142
398
399 @records = $x->getupdate({field=>'900',record=>1});
400 is_ok(11 == @records); # 143
401
402 is_ok($records[0] eq "i1"); # 144
403 is_ok($records[1] eq "6"); # 145
404
405 if ($naptime) {
406 print "++++ page break\n";
407 sleep $naptime;
408 }
409
410 is_ok($records[2] eq "i2"); # 146
411 is_ok($records[3] eq "7"); # 147
412 is_ok($records[4] eq "z"); # 148
413 is_ok($records[5] eq "part 1"); # 149
414 is_ok($records[6] eq "z"); # 150
415 is_ok($records[7] eq "part 2"); # 151
416 is_ok($records[8] eq "z"); # 152
417 is_ok($records[9] eq "part 3"); # 153
418 is_ok($records[10] eq "\036"); # 154
419
420 @records = $x->getupdate({field=>'900',record=>2});
421 is_ok(7 == @records); # 155
422
423 is_ok($records[0] eq "i1"); # 156
424 is_ok($records[1] eq "9"); # 157
425 is_ok($records[2] eq "i2"); # 158
426 is_ok($records[3] eq "8"); # 159
427 is_ok($records[4] eq "z"); # 160
428
429 is_ok($records[5] eq "part 4"); # 161
430 is_ok($records[6] eq "\036"); # 162
431
432 @records = $x->getupdate({field=>'999',record=>1});
433 is_ok(11 == @records); # 163
434
435 is_ok($records[0] eq "i1"); # 164
436 is_ok($records[1] eq "5"); # 165
437 is_ok($records[2] eq "i2"); # 166
438 is_ok($records[3] eq "3"); # 167
439
440 if ($naptime) {
441 print "++++ page break\n";
442 sleep $naptime;
443 }
444
445 is_ok($records[4] eq "c"); # 168
446 is_ok($records[5] eq "wL70"); # 169
447 is_ok($records[6] eq "d"); # 170
448 is_ok($records[7] eq "AR Clinton PL"); # 171
449 is_ok($records[8] eq "f"); # 172
450 is_ok($records[9] eq "53525"); # 173
451 is_ok($records[10] eq "\036"); # 174
452
453 @records = $x->getupdate({field=>'999',record=>2});
454 is_ok(0 == @records); # 175
455
456 @records = $x->getupdate({field=>'001',record=>2});
457 is_ok(2 == @records); # 176
458 is_ok($records[0] eq "ocm40139019 "); # 177
459 is_ok($records[1] eq "\036"); # 178
460
461 is_ok(2 == $x->deletemarc()); # 179
462 is_zero($x->marc_count); # 180
463
464 $MARC::TEST = 1;
465 is_ok('0 but true' eq $x->openmarc({file=>$file2,
466 'format'=>"usmarc"})); # 181
467 is_ok(-1 == $x->nextmarc(2)); # 182
468 is_ok(1 == $x->marc_count); # 183
469 is_bad(defined $x->nextmarc(1)); # 184
470 is_ok(1 == $x->nextmarc(2)); # 185
471 is_ok(2 == $x->marc_count); # 186
472 is_ok($x->closemarc); # 187
+241
-0
t/test2.t less more
0 #!/usr/bin/perl -w
1
2 # Before `make install' is performed this script should be runnable with
3 # `make test'. After `make install' it should work as `perl test1.t'
4
5 use lib '.','./t'; # for inheritance and Win32 test
6
7 ######################### We start with some black magic to print on failure.
8
9 BEGIN { $| = 1; print "1..65\n"; }
10 END {print "not ok 1\n" unless $loaded;}
11 use MARC 1.04;
12 $loaded = 1;
13 print "ok 1\n";
14
15 ######################### End of black magic.
16
17 use strict;
18
19 my $tc = 2; # next test number
20
21 use strict;
22 use File::Compare;
23
24 sub out_cmp {
25 my $outfile = shift;
26 my $reffile = shift;
27 if (-s $outfile && -s $reffile) {
28 return is_zero (compare($outfile, $reffile));
29 }
30 printf ("not ok %d\n",$tc++);
31 }
32
33 sub is_zero {
34 my $result = shift;
35 if (defined $result) {
36 return is_ok ($result == 0);
37 }
38 printf ("not ok %d\n",$tc++);
39 }
40
41 sub is_ok {
42 my $result = shift;
43 printf (($result ? "" : "not ")."ok %d\n",$tc++);
44 return $result;
45 }
46
47 sub is_bad {
48 my $result = shift;
49 printf (($result ? "not " : "")."ok %d\n",$tc++);
50 return (not $result);
51 }
52
53 my $file = "makrbrkr.mrc";
54 my $file2 = "brkrtest.ref";
55 my $file3 = "makrtest.src";
56 my $file4 = "makrtest.bad";
57
58 my $testdir = "t";
59 if (-d $testdir) {
60 $file = "$testdir/$file";
61 $file2 = "$testdir/$file2";
62 $file3 = "$testdir/$file3";
63 $file4 = "$testdir/$file4";
64 }
65 unless (-e $file) {
66 die "Missing sample file for MARCMaker tests: $file\n";
67 }
68 unless (-e $file2) {
69 die "Missing results file for MARCBreaker tests: $file2\n";
70 }
71 unless (-e $file3) {
72 die "Missing source file for MARCMaker tests: $file3\n";
73 }
74 unless (-e $file4) {
75 die "Missing bad source file for MARCMaker tests: $file4\n";
76 }
77
78 my $naptime = 0; # pause between output pages
79 if (@ARGV) {
80 $naptime = shift @ARGV;
81 unless ($naptime =~ /^[0-5]$/) {
82 die "Usage: perl test?.t [ page_delay (0..5) ]";
83 }
84 }
85
86 my $x;
87 unlink 'output.txt', 'output.html', 'output.xml', 'output.isbd',
88 'output.urls', 'output2.bkr', 'output.mkr', 'output.bkr';
89
90 # Create the new MARC object. You can use any variable name you like...
91 # Read the MARC file into the MARC object.
92
93 unless (is_ok ($x = MARC->new($file3,"marcmaker"))) { # 2
94 die "could not create MARC from $file3\n";
95 # next test would die at runtime without $x
96 }
97
98 $MARC::TEST = 1; # so outputs have known dates for 005
99 is_ok (8 == $x->marc_count); # 3
100
101 #Output the MARC object to a marcmaker file with nolinebreak
102 is_ok ($x->output({file=>">output.bkr",'format'=>"marcmaker",
103 nolinebreak=>'y'})); # 4
104 out_cmp ("output.bkr", $file2); # 5
105
106 my $y;
107 is_ok ($y = $x->output()); # 6
108
109 #Output the MARC object to an ascii file
110 is_ok ($x->output({file=>">output.txt",'format'=>"ASCII"})); # 7
111
112 #Output the MARC object to a marcmaker file
113 is_ok ($x->output({file=>">output2.bkr",'format'=>"marcmaker"})); # 8
114
115 #Output the MARC object to a marc file
116 is_ok ($x->output({file=>">output.mkr",'format'=>"marc"})); # 9
117
118 out_cmp ("output.mkr", $file); # 10
119
120 $MARC::TEST = 0; #minimal impact
121 $^W = 0;
122 my ($m000) = $x->getvalue({record=>'1',field=>'000'});
123 my ($m001) = $x->getvalue({record=>'1',field=>'001'});
124 is_ok ($m000 eq "01200nam 2200253 a 4500"); # 11
125 is_ok ($m001 eq "tes96000001 "); # 12
126
127 my ($m002) = $x->getvalue({record=>'1',field=>'002'});
128 my ($m003) = $x->getvalue({record=>'1',field=>'003'});
129 is_bad (defined $m002); # 13
130 is_ok ($m003 eq "ViArRB"); # 14
131
132 my ($m004) = $x->getvalue({record=>'1',field=>'004'});
133 my ($m005) = $x->getvalue({record=>'1',field=>'005'});
134 is_bad (defined $m004); # 15
135 is_ok ($m005 eq "19960221075055.7"); # 16
136
137 my ($m006) = $x->getvalue({record=>'1',field=>'006'});
138 my ($m007) = $x->getvalue({record=>'1',field=>'007'});
139 is_bad (defined $m006); # 17
140 is_bad (defined $m007); # 18
141
142 my ($m008) = $x->getvalue({record=>'1',field=>'008'});
143 my ($m009) = $x->getvalue({record=>'1',field=>'009'});
144 is_ok ($m008 eq "960221s1955 dcuabcdjdbkoqu001 0deng d"); # 19
145 is_bad (defined $m009); # 20
146
147 if ($naptime) {
148 print "++++ page break\n";
149 sleep $naptime;
150 }
151
152 my ($m260a) = $x->getvalue({record=>'8',field=>'260',subfield=>'a'});
153 my ($m260b) = $x->getvalue({record=>'8',field=>'260',subfield=>'b'});
154 my ($m260c) = $x->getvalue({record=>'8',field=>'260',subfield=>'c'});
155 is_ok ($m260a eq "Washington, DC :"); # 21
156 is_ok ($m260b eq "Library of Congress,"); # 22
157 is_ok ($m260c eq "1955."); # 23
158
159 my @m260 = $x->getvalue({record=>'8',field=>'260'});
160 is_ok ($m260[0] eq "Washington, DC : Library of Congress, 1955. "); # 24
161
162 my ($m245i1) = $x->getvalue({record=>'8',field=>'245',subfield=>'i1'});
163 my ($m245i2) = $x->getvalue({record=>'8',field=>'245',subfield=>'i2'});
164 my ($m245i12) = $x->getvalue({record=>'8',field=>'245',subfield=>'i12'});
165 is_ok ($m245i1 eq "1"); # 25
166 is_ok ($m245i2 eq "2"); # 26
167 is_ok ($m245i12 eq "12"); # 27
168
169 is_ok (3 == $x->selectmarc(["1","7-8"])); # 28
170 is_ok (3 == $x->marc_count); # 29
171
172 my @records=$x->searchmarc({field=>"020"});
173 is_ok(2 == scalar @records); # 30
174 is_ok($records[0] == 2); # 31
175 is_ok($records[1] == 3); # 32
176
177 @records=$x->searchmarc({field=>"020",subfield=>"c"});
178 is_ok(1 == scalar @records); # 33
179 is_ok($records[0] == 3); # 34
180
181 @records = $x->getupdate({field=>'020',record=>2});
182 is_ok(7 == @records); # 35
183
184 is_ok($records[0] eq "i1"); # 36
185 is_ok($records[1] eq " "); # 37
186 is_ok($records[2] eq "i2"); # 38
187 is_ok($records[3] eq " "); # 39
188 is_ok($records[4] eq "a"); # 40
189 is_ok($records[5] eq "8472236579"); # 41
190 is_ok($records[6] eq "\036"); # 42
191
192 if ($naptime) {
193 print "++++ page break\n";
194 sleep $naptime;
195 }
196
197 is_ok(1 == $x->deletemarc({field=>'020',record=>2})); # 43
198 $records[6] = "c";
199 $records[7] = "new data";
200 is_ok($x->addfield({field=>'020',record=>2}, @records)); # 44
201
202 @records=$x->searchmarc({field=>"020",subfield=>"c"});
203 is_ok(2 == scalar @records); # 45
204 is_ok($records[0] == 2); # 46
205 is_ok($records[1] == 3); # 47
206
207 @records = $x->getvalue({record=>'2',field=>'020',delimiter=>'|'});
208 is_ok(1 == scalar @records); # 48
209 is_ok($records[0] eq "|a8472236579|cnew data"); # 49
210
211 is_ok(1 == $x->deletemarc({field=>'020',record=>2,subfield=>'c'})); # 50
212 @records=$x->searchmarc({field=>"020",subfield=>"c"});
213 is_ok(1 == scalar @records); # 51
214 is_ok($records[0] == 3); # 52
215
216 @records = $x->getvalue({record=>'2',field=>'020',delimiter=>'|'});
217 is_ok(1 == scalar @records); # 53
218 is_ok($records[0] eq "|a8472236579"); # 54
219
220 is_ok(3 == $x->deletemarc()); # 55
221 is_zero($x->marc_count); # 56
222
223 $MARC::TEST = 1;
224 is_ok('0 but true' eq $x->openmarc({file=>$file4,
225 'format'=>"marcmaker"})); # 57
226 is_ok(-2 == $x->nextmarc(4)); # 58
227 is_ok(2 == $x->marc_count); # 59
228 is_ok($x->closemarc); # 60
229 is_ok(2 == $x->deletemarc()); # 61
230
231 if ($naptime) {
232 print "++++ page break\n";
233 sleep $naptime;
234 }
235
236 is_ok(2 == $x->openmarc({file=>$file4, increment=>2,
237 'format'=>"marcmaker"})); # 62
238 is_bad(defined $x->nextmarc(1)); # 63
239 is_ok(2 == $x->marc_count); # 64
240 is_ok($x->closemarc); # 65
+255
-0
t/test3.t less more
0 #!/usr/bin/perl -w
1
2 # Before `make install' is performed this script should be runnable with
3 # `make test'. After `make install' it should work as `perl test1.t'
4
5 use lib '.','./t'; # for inheritance and Win32 test
6
7 ######################### We start with some black magic to print on failure.
8
9 BEGIN { $| = 1; print "1..79\n"; }
10 END {print "not ok 1\n" unless $loaded;}
11 use MARCopt; # check inheritance & export
12 $loaded = 1;
13 print "ok 1\n";
14
15 ######################### End of black magic.
16
17 use strict;
18
19 my $tc = 2; # next test number
20
21 sub is_ok {
22 my $result = shift;
23 printf (($result ? "" : "not ")."ok %d\n",$tc++);
24 return $result;
25 }
26
27 sub is_zero {
28 my $result = shift;
29 if (defined $result) {
30 return is_ok ($result == 0);
31 }
32 else {
33 printf ("not ok %d\n",$tc++);
34 }
35 }
36
37 sub is_bad {
38 my $result = shift;
39 printf (($result ? "not " : "")."ok %d\n",$tc++);
40 return (not $result);
41 }
42
43 sub filestring {
44 my $file = shift;
45 local $/ = undef;
46 unless (open(YY, $file)) {warn "Can't open file $file: $!\n"; return;}
47 binmode YY;
48 my $yy = <YY>;
49 unless (close YY) {warn "Can't close file $file: $!\n"; return;}
50 return $yy;
51 }
52
53 my $file = "marc.dat";
54 my $testfile = "t/marc.dat";
55 if (-e $testfile) {
56 $file = $testfile;
57 }
58 unless (-e $file) {
59 die "No MARC sample file found\n";
60 }
61
62 my $naptime = 0; # pause between output pages
63 if (@ARGV) {
64 $naptime = shift @ARGV;
65 unless ($naptime =~ /^[0-5]$/) {
66 die "Usage: perl test?.t [ page_delay (0..5) ]";
67 }
68 }
69
70 my $x;
71 unlink 'output.txt', 'output.html', 'output.xml', 'output.isbd',
72 'output.urls', 'output2.html', 'output.mkr';
73
74 # Create the new MARCopt object. You can use any variable name you like...
75 # Read the MARC file into the MARCopt object.
76
77 unless (is_ok ($x = MARCopt->new ($file))) { # 2
78 printf "could not create MARCopt from $file\n";
79 exit 1;
80 # next test would die at runtime without $x
81 }
82
83 is_ok (2 == $x->marc_count); # 3
84
85 #Output the MARCopt object to an ascii file
86 is_ok ($x->output({file=>">output.txt",'format'=>"ASCII"})); # 4
87
88 #Output the MARCopt object to an html file
89 is_ok ($x->output({file=>">output.html",'format'=>"HTML"})); # 5
90
91 #Try to output the MARCopt object to an xml file
92 my $quiet = $^W;
93 $^W = 0;
94 is_bad ($x->output({file=>">output.xml",'format'=>"XML"})); # 6
95 $^W = $quiet;
96
97 #Output the MARCopt object to an url file
98 is_ok ($x->output({file=>">output.urls",'format'=>"URLS"})); # 7
99
100 #Output the MARCopt object to an isbd file
101 is_ok ($x->output({file=>">output.isbd",'format'=>"ISBD"})); # 8
102
103 #Output the MARCopt object to a marcmaker file
104 is_ok ($x->output({file=>">output.mkr",'format'=>"marcmaker"})); # 9
105
106 #Output the MARCopt object to an html file with titles
107 is_ok ($x->output({file=>">output2.html",
108 'format'=>"HTML","245"=>"TITLE:"})); # 10
109
110 is_ok (-s 'output.txt'); # 11
111 is_ok (-s 'output.html'); # 12
112 is_bad (-e 'output.xml'); # 13
113 is_ok (-s 'output.urls'); # 14
114
115 #Append the MARCopt object to an html file with titles
116 is_ok ($x->output({file=>">>output2.html",
117 'format'=>"HTML","245"=>"TITLE:"})); # 15
118
119 #Append to an html file with titles incrementally
120 is_ok ($x->output({file=>">output.html",'format'=>"HTML_START"})); # 16
121 is_ok ($x->output({file=>">>output.html",
122 'format'=>"HTML_BODY","245"=>"TITLE:"})); # 17
123 is_ok ($x->output({file=>">>output.html",'format'=>"HTML_FOOTER"})); # 18
124
125 my ($y1, $y2, $yy);
126 is_ok ($y1 = $x->output({'format'=>"HTML","245"=>"TITLE:"})); # 19
127 $y2 = "$y1$y1";
128 is_ok ($yy = filestring ("output2.html")); # 20
129 is_ok ($yy eq $y2); # 21
130
131 if ($naptime) {
132 print "++++ page break\n";
133 sleep $naptime;
134 }
135
136 is_ok ($yy = filestring ("output.html")); # 22
137 is_ok ($y1 eq $yy); # 23
138
139 #Simple test of (un)?pack.*
140 my $rhldr = $x->unpack_ldr(1);
141 is_ok('c' eq ${$rhldr}{RecStat}); # 24
142 is_ok('a' eq ${$rhldr}{Type}); # 25
143 is_ok('m' eq ${$rhldr}{BLvl}); # 26
144
145 my $rhff = $x->unpack_008(1);
146 is_ok('741021' eq ${$rhff}{Entered}); # 27
147 is_ok('s' eq ${$rhff}{DtSt}); # 28
148 is_ok('1884' eq ${$rhff}{Date1}); # 29
149
150 my ($m000) = $x->getvalue({field=>'000',record=>1});
151 my ($m001) = $x->getvalue({field=>'001',record=>1});
152 my ($m003) = $x->getvalue({field=>'003',record=>1});
153 my ($m005) = $x->getvalue({field=>'005',record=>1});
154 my ($m008) = $x->getvalue({field=>'008',record=>1});
155
156 is_ok($m000 eq "00901cam 2200241Ia 45e0"); # 30
157 is_ok($m001 eq "ocm01047729 "); # 31
158 is_ok($m003 eq "OCoLC"); # 32
159 is_ok($m005 eq "19990808143752.0"); # 33
160 is_ok($m008 eq "741021s1884 enkaf 000 1 eng d"); # 34
161
162 is_ok($x->_pack_ldr($rhldr) eq $m000); # 35
163 is_ok($x->_pack_ldr($rhldr) eq $x->ldr(1)); # 36
164 is_ok($x->_pack_008($m000,$rhff) eq $m008); # 37
165
166 my ($indi1) = $x->getvalue({field=>'245',record=>1,subfield=>'i1'});
167 my ($indi2) = $x->getvalue({field=>'245',record=>1,subfield=>'i2'});
168 my ($indi12) = $x->getvalue({field=>'245',record=>1,subfield=>'i12'});
169
170 is_ok($indi1 eq "1"); # 38
171 is_ok($indi2 eq "4"); # 39
172 is_ok($indi12 eq "14"); # 40
173
174 if ($naptime) {
175 print "++++ page break\n";
176 sleep $naptime;
177 }
178
179 my ($m100a) = $x->getvalue({field=>'100',record=>1,subfield=>'a'});
180 my ($m100d) = $x->getvalue({field=>'100',record=>1,subfield=>'d'});
181 my ($m100e) = $x->getvalue({field=>'100',record=>1,subfield=>'e'});
182
183 is_ok($m100a eq "Twain, Mark,"); # 41
184 is_ok($m100d eq "1835-1910."); # 42
185 is_bad(defined $m100e); # 43
186
187 my @ind12 = $x->getvalue({field=>'246',record=>2,subfield=>'i12'});
188 is_ok(3 == scalar @ind12); # 44
189 is_ok($ind12[0] eq "30"); # 45
190 is_ok($ind12[1] eq "3 "); # 46
191 is_ok($ind12[2] eq "30"); # 47
192
193 my @m246a = $x->getvalue({field=>'246',record=>2,subfield=>'a'});
194 is_ok(3 == scalar @m246a); # 48
195 is_ok($m246a[0] eq "Photo archive"); # 49
196 is_ok($m246a[1] eq "Associated Press photo archive"); # 50
197 is_ok($m246a[2] eq "AP photo archive"); # 51
198
199 my @records=$x->searchmarc({field=>"245"});
200 is_ok(2 == scalar @records); # 52
201 is_ok($records[0] == 1); # 53
202 is_ok($records[1] == 2); # 54
203
204 @records=$x->searchmarc({field=>"245",subfield=>"a"});
205 is_ok(2 == scalar @records); # 55
206 is_ok($records[0] == 1); # 56
207 is_ok($records[1] == 2); # 57
208
209 @records=$x->searchmarc({field=>"245",subfield=>"b"});
210 is_ok(1 == scalar @records); # 58
211 is_ok($records[0] == 1); # 59
212
213 @records=$x->searchmarc({field=>"245",subfield=>"h"});
214 is_ok(1 == scalar @records); # 60
215 is_ok($records[0] == 2); # 61
216
217 if ($naptime) {
218 print "++++ page break\n";
219 sleep $naptime;
220 }
221
222 @records=$x->searchmarc({field=>"246",subfield=>"a"});
223 is_ok(1 == scalar @records); # 62
224 is_ok($records[0] == 2); # 63
225
226 @records=$x->searchmarc({field=>"245",regex=>"/huckleberry/i"});
227 is_ok(1 == scalar @records); # 64
228 is_ok($records[0] == 1); # 65
229
230 @records=$x->searchmarc({field=>"260",subfield=>"c",regex=>"/19../"});
231 is_ok(1 == scalar @records); # 66
232 is_ok($records[0] == 2); # 67
233
234 @records=$x->searchmarc({field=>"245",notregex=>"/huckleberry/i"});
235 is_ok(1 == scalar @records); # 68
236 is_ok($records[0] == 2); # 69
237
238 @records=$x->searchmarc({field=>"260",subfield=>"c",notregex=>"/19../"});
239 is_ok(1 == scalar @records); # 70
240 is_ok($records[0] == 1); # 71
241
242 @records=$x->searchmarc({field=>"900",subfield=>"c"});
243 is_ok(0 == scalar @records); # 72
244 is_bad(defined $records[0]); # 73
245
246 @records=$x->searchmarc({field=>"999"});
247 is_ok(0 == scalar @records); # 74
248 is_bad(defined $records[0]); # 75
249
250 is_ok (-s 'output.isbd'); # 76
251 is_ok (-s 'output.mkr'); # 77
252
253 is_ok ($y1 = $x->output({'format'=>"HTML_HEADER"})); # 78
254 is_ok ($y1 eq "Content-type: text/html\015\012\015\012"); # 79
+355
-0
t/test4.t less more
0 #!/usr/bin/perl -w
1
2 # Before `make install' is performed this script should be runnable with
3 # `make test'. After `make install' it should work as `perl test1.t'
4
5 use lib '.','./t'; # for inheritance and Win32 test
6
7 ######################### We start with some black magic to print on failure.
8
9 BEGIN { $| = 1; print "1..116\n"; }
10 END {print "not ok 1\n" unless $loaded;}
11 use MARC 1.03;
12 $loaded = 1;
13 print "ok 1\n";
14
15 ######################### End of black magic.
16 #
17 #Added tests should have an comment matching /# \d/
18 #If so, the following will renumber all the tests
19 #to match Perl's idea of test:
20 #perl -pi.bak -e 'BEGIN{$i=1};if (/# \d/){ $i++};s/# \d+/# $i/' test4.t
21 #
22 ######################### End of test renumber.
23
24 use strict;
25
26 my $tc = 2; # next test number
27 my $WCB = 0;
28
29 sub is_ok {
30 my $result = shift;
31 printf (($result ? "" : "not ")."ok %d\n",$tc++);
32 return $result;
33 }
34
35 sub is_zero {
36 my $result = shift;
37 if (defined $result) {
38 return is_ok ($result == 0);
39 }
40 else {
41 printf ("not ok %d\n",$tc++);
42 }
43 }
44
45 sub is_bad {
46 my $result = shift;
47 printf (($result ? "not " : "")."ok %d\n",$tc++);
48 return (not $result);
49 }
50
51 sub filestring {
52 my $file = shift;
53 local $/ = undef;
54 unless (open(YY, $file)) {warn "Can't open file $file: $!\n"; return;}
55 binmode YY;
56 my $yy = <YY>;
57 unless (close YY) {warn "Can't close file $file: $!\n"; return;}
58 return $yy;
59 }
60
61 sub array_eq_str {
62 my ($ra1,$ra2)=@_;
63 my @a1= @$ra1;
64 my @a2= @$ra2;
65 return 0 unless (scalar(@a1) == scalar(@a2));
66 for my $i (0..scalar(@a1)-1) {
67 print "WCB: a1 = $a1[$i]...\n" if $WCB;
68 print "WCB: a2 = $a2[$i]...\n" if $WCB;
69 return 0 unless ($a1[$i] eq $a2[$i]);
70 }
71 return 1;
72 }
73 sub printarr {
74 my @b=@_;
75 print "(",(join ", ",grep {s/^/'/;s/$/'/} @b),")";
76 }
77
78 my $file = "marc.dat";
79 my $testfile = "t/marc.dat";
80 if (-e $testfile) {
81 $file = $testfile;
82 }
83 unless (-e $file) {
84 die "No MARC sample file found\n";
85 }
86
87 my $naptime = 0; # pause between output pages
88 if (@ARGV) {
89 $naptime = shift @ARGV;
90 unless ($naptime =~ /^[0-5]$/) {
91 die "Usage: perl test?.t [ page_delay (0..5) ]";
92 }
93 }
94
95 my $x;
96 unlink 'output4.txt','output4.mkr','output4a.txt';
97
98 # Create the new MARC object. You can use any variable name you like...
99 # Read the MARC file into the MARC object.
100
101 unless (is_ok ($x = MARC->new ($file))) { # 2
102 printf "could not create MARC from $file\n";
103 exit 1;
104 # next test would die at runtime without $x
105 }
106
107 #Output the MARC object to an ascii file
108 is_ok ($x->output({file=>">output4.txt",'format'=>"ASCII"})); # 3
109
110 #Output the MARC object to a marcmaker file
111 is_ok ($x->output({file=>">output4.mkr",'format'=>"marcmaker"})); # 4
112
113 is_ok (-s 'output4.txt'); # 5
114 is_ok (-s 'output4.mkr'); # 6
115 my @a1 = ('1',2,'b');
116 my @a2 = (1,2,'b');
117 my @b1 = ('1',2);
118 my @b2 = ('1',2,'c');
119 is_ok ( array_eq_str(\@a1,\@a2) ); # 7
120 is_bad( array_eq_str(\@a1,\@b1) ); # 8
121 is_bad( array_eq_str(\@a1,\@b2) ); # 9
122
123
124 delete $x->[1]{500};
125
126 for (@{$x->[1]{array}}) {
127 $x->add_map(1,$_) if $_->[0] eq '500';
128 }
129
130 is_ok(${$x->[1]{500}{'a'}[0]} eq 'First English ed.'); # 10
131 ${$x->[1]{500}{'a'}[0]} ="boo";
132 is_ok(${$x->[1]{500}{'a'}[0]} eq 'boo'); # 11
133 my @new500=(500,'x','y',a=>"foo",b=>"bar");
134 $x->add_map(1,[@new500]);
135
136 is_ok( array_eq_str($x->[1]{500}{field}[4],\@new500) ); # 12
137 $x->rebuild_map(1,500);
138 my @add008 = ('008',"abcde");
139 $x->add_map(1,[@add008]);
140
141 is_ok( array_eq_str($x->[1]{'008'}{field}[1],\@add008) ); # 13
142 #delete $x->[1]{'008'};
143 $x->rebuild_map(1,'008');
144 my @m008 = ('008', '741021s1884 enkaf 000 1 eng d');
145 is_ok( array_eq_str($x->[1]{'008'}{field}[0],\@m008) ); # 14
146
147 is_ok( !defined($x->[1]{'008'}{field}[1])); # 15
148
149 my @m5000 = (500, ' ', ' ', a=> 'boo');
150 is_ok( array_eq_str($x->[1]{'500'}{field}[0],\@m5000) ); # 16
151
152 my @m5001 = (500, ' ', ' ', a=>'State B; gatherings saddle-stitched with wire staples.');
153 is_ok( array_eq_str($x->[1]{'500'}{field}[1],\@m5001) ); # 17
154
155 my @m5002 = (500, ' ', ' ', a=> 'Advertisements on p. [1]-32 at end.');
156 is_ok( array_eq_str($x->[1]{'500'}{field}[2],\@m5002) ); # 18
157
158 my @m5003 = (500, ' ', ' ', a=> 'Bound in red S cloth; stamped in black and gold.');
159 is_ok( array_eq_str($x->[1]{'500'}{field}[3],\@m5003) ); # 19
160
161 is_ok( $x->deletefirst({field=>'500',record=>1}) ); # 20
162 $x->updatefirst({field=>'247',record=>1, rebuild_map =>0},
163 ('xxx',1," ", a =>"Photo marchive"));
164
165 $x->updatefirst({field=>'500',record=>1, rebuild_map =>0},
166 ('xxx',1," ", a =>"First English Fed."));
167
168 is_ok( $x->updatefirst({field=>'500',subfield=>"h",record=>1, rebuild_map =>0},
169 ('xxx',1," ", a =>"First English Fed.",h=>"foobar,the fed")) ); # 21
170 is_ok( $x->updatefirst({field=>'500',subfield=>"k",record=>1, rebuild_map =>0},
171 ('xxx',1," ", a =>"First English Fed.",k=>"koobar,the fed")) ); # 22
172
173 if ($naptime) {
174 print "++++ page break\n";
175 sleep $naptime;
176 }
177
178 ## is_ok($m008 eq "741021s1884 enkaf 000 1 eng d");
179
180 my ($m100a) = $x->getvalue({field=>'100',record=>1,subfield=>'a'});
181 my ($m100d) = $x->getvalue({field=>'100',record=>1,subfield=>'d'});
182 my ($m100e) = $x->getvalue({field=>'100',record=>1,subfield=>'e'});
183
184 is_ok($m100a eq "Twain, Mark,"); # 23
185 is_ok($m100d eq "1835-1910."); # 24
186 is_bad(defined $m100e); # 25
187
188 my @m246a = $x->getvalue({field=>'246',record=>2,subfield=>'a'});
189 is_ok(3 == scalar @m246a); # 26
190 is_ok($m246a[0] eq "Photo archive"); # 27
191 is_ok($m246a[1] eq "Associated Press photo archive"); # 28
192 is_ok($m246a[2] eq "AP photo archive"); # 29
193
194 is_ok ($x->output({file=>">output4a.txt",'format'=>"ASCII"})); # 30
195
196 my $update246 = {field=>'246',record=>2,ordered=>'y'};
197 my @u246 = $x->getupdate($update246);
198 is_ok(21 == @u246); # 31
199
200
201 is_ok($u246[0] eq "i1"); # 32
202 is_ok($u246[1] eq "3"); # 33
203 is_ok($u246[2] eq "i2"); # 34
204 is_ok($u246[3] eq "0"); # 35
205 is_ok($u246[4] eq "a"); # 36
206 is_ok($u246[5] eq "Photo archive"); # 37
207 is_ok($u246[6] eq "\036"); # 38
208
209
210 is_ok($u246[7] eq "i1"); # 39
211 is_ok($u246[8] eq "3"); # 40
212 is_ok($u246[9] eq "i2"); # 41
213 is_ok($u246[10] eq " "); # 42
214 is_ok($u246[11] eq "a"); # 43
215 is_ok($u246[12] eq "Associated Press photo archive"); # 44
216
217 if ($naptime) {
218 print "++++ page break\n";
219 sleep $naptime;
220 }
221
222 is_ok($u246[13] eq "\036"); # 45
223 is_ok($u246[14] eq "i1"); # 46
224 is_ok($u246[15] eq "3"); # 47
225 is_ok($u246[16] eq "i2"); # 48
226 is_ok($u246[17] eq "0"); # 49
227 is_ok($u246[18] eq "a"); # 50
228 is_ok($u246[19] eq "AP photo archive"); # 51
229 is_ok($u246[20] eq "\036"); # 52
230
231 is_ok(3 == $x->deletemarc($update246)); # 53
232 my @records = ();
233 foreach my $y1 (@u246) {
234 unless ($y1 eq "\036") {
235 push @records, $y1;
236 next;
237 }
238 $x->addfield($update246, @records) || warn "not added\n";
239 @records = ();
240 }
241
242 @u246 = $x->getupdate($update246);
243 is_ok(21 == @u246); # 54
244
245 is_ok($u246[0] eq "i1"); # 55
246 is_ok($u246[1] eq "3"); # 56
247 is_ok($u246[2] eq "i2"); # 57
248 is_ok($u246[3] eq "0"); # 58
249 is_ok($u246[4] eq "a"); # 59
250 is_ok($u246[5] eq "Photo archive"); # 60
251 is_ok($u246[6] eq "\036"); # 61
252
253 is_ok($u246[7] eq "i1"); # 62
254 is_ok($u246[8] eq "3"); # 63
255 is_ok($u246[9] eq "i2"); # 64
256 is_ok($u246[10] eq " "); # 65
257 is_ok($u246[11] eq "a"); # 66
258
259 if ($naptime) {
260 print "++++ page break\n";
261 sleep $naptime;
262 }
263
264 is_ok($u246[12] eq "Associated Press photo archive"); # 67
265 is_ok($u246[13] eq "\036"); # 68
266
267 is_ok($u246[14] eq "i1"); # 69
268 is_ok($u246[15] eq "3"); # 70
269 is_ok($u246[16] eq "i2"); # 71
270 is_ok($u246[17] eq "0"); # 72
271 is_ok($u246[18] eq "a"); # 73
272
273 is_ok($u246[19] eq "AP photo archive"); # 74
274 is_ok($u246[20] eq "\036"); # 75
275
276
277 is_ok($x->addfield({record=>1, field=>"999", ordered=>"n",
278 i1=>"5", i2=>"3", value=>[c=>"wL70",
279 d=>"AR Clinton PL",f=>"53525"]})); # 76
280
281 is_ok($x->addfield({record=>1, field=>"900", ordered=>"y",
282 i1=>"6", i2=>"7", value=>[z=>"part 1",
283 z=>"part 2",z=>"part 3"]})); # 77
284
285 is_ok($x->addfield({record=>2, field=>"900", ordered=>"y",
286 i1=>"9", i2=>"8", value=>[z=>"part 4"]})); # 78
287
288 @records = $x->searchmarc({field=>'900'});
289 is_ok(2 == @records); # 79
290 @records = $x->searchmarc({field=>'999'});
291 is_ok(1 == @records); # 80
292
293 @records = $x->getupdate({field=>'900',record=>1});
294 is_ok(11 == @records); # 81
295
296 is_ok($records[0] eq "i1"); # 82
297 is_ok($records[1] eq "6"); # 83
298 is_ok($records[2] eq "i2"); # 84
299 is_ok($records[3] eq "7"); # 85
300 is_ok($records[4] eq "z"); # 86
301 is_ok($records[5] eq "part 1"); # 87
302 is_ok($records[6] eq "z"); # 88
303
304 if ($naptime) {
305 print "++++ page break\n";
306 sleep $naptime;
307 }
308
309 is_ok($records[7] eq "part 2"); # 89
310 is_ok($records[8] eq "z"); # 90
311 is_ok($records[9] eq "part 3"); # 91
312 is_ok($records[10] eq "\036"); # 92
313
314 @records = $x->getupdate({field=>'900',record=>2});
315 is_ok(7 == @records); # 93
316
317 is_ok($records[0] eq "i1"); # 94
318 is_ok($records[1] eq "9"); # 95
319 is_ok($records[2] eq "i2"); # 96
320 is_ok($records[3] eq "8"); # 97
321 is_ok($records[4] eq "z"); # 98
322
323 is_ok($records[5] eq "part 4"); # 99
324 is_ok($records[6] eq "\036"); # 100
325
326 @records = $x->getupdate({field=>'999',record=>1});
327 is_ok(11 == @records); # 101
328
329 is_ok($records[0] eq "i1"); # 102
330 is_ok($records[1] eq "5"); # 103
331 is_ok($records[2] eq "i2"); # 104
332 is_ok($records[3] eq "3"); # 105
333 is_ok($records[4] eq "c"); # 106
334 is_ok($records[5] eq "wL70"); # 107
335 is_ok($records[6] eq "d"); # 108
336 is_ok($records[7] eq "AR Clinton PL"); # 109
337 is_ok($records[8] eq "f"); # 110
338
339 if ($naptime) {
340 print "++++ page break\n";
341 sleep $naptime;
342 }
343
344 is_ok($records[9] eq "53525"); # 111
345 is_ok($records[10] eq "\036"); # 112
346
347 @records = $x->getupdate({field=>'999',record=>2});
348 is_ok(0 == @records); # 113
349
350 @records = $x->getupdate({field=>'001',record=>2});
351 is_ok(2 == @records); # 114
352 is_ok($records[0] eq "ocm40139019 "); # 115
353 is_ok($records[1] eq "\036"); # 116
354
+433
-0
t/test5.t less more
0 #!/usr/bin/perl -w
1
2 # Before `make install' is performed this script should be runnable with
3 # `make test'. After `make install' it should work as `perl test1.t'
4
5 use lib '.','./t'; # for inheritance and Win32 test
6
7 ######################### We start with some black magic to print on failure.
8
9 BEGIN { $| = 1; print "1..109\n"; }
10 END {print "not ok 1\n" unless $loaded;}
11 use MARC 1.07;
12 $loaded = 1;
13 print "ok 1\n";
14
15 ######################### End of black magic.
16 #
17 #Added tests should have an comment matching /# \d/
18 #If so, the following will renumber all the tests
19 #to match Perl's idea of test:
20 #perl -pi.bak -e 'BEGIN{$i=1};next if /^#/;if (/# \d/){ $i++};s/# \d+/# $i/' test5.t
21 #
22 ######################### End of test renumber.
23
24 use strict;
25
26 my $tc = 2; # next test number
27
28 sub is_ok {
29 my $result = shift;
30 printf (($result ? "" : "not ")."ok %d\n",$tc++);
31 return $result;
32 }
33
34 sub is_zero {
35 my $result = shift;
36 if (defined $result) {
37 return is_ok ($result == 0);
38 }
39 else {
40 printf ("not ok %d\n",$tc++);
41 }
42 }
43
44 sub is_bad {
45 my $result = shift;
46 printf (($result ? "not " : "")."ok %d\n",$tc++);
47 return (not $result);
48 }
49
50 sub filestring {
51 my $file = shift;
52 local $/ = undef;
53 unless (open(YY, $file)) {warn "Can't open file $file: $!\n"; return;}
54 binmode YY;
55 my $yy = <YY>;
56 unless (close YY) {warn "Can't close file $file: $!\n"; return;}
57 return $yy;
58 }
59
60 sub array_eq_str {
61 my ($ra1,$ra2)=@_;
62 my @a1= @$ra1;
63 my @a2= @$ra2;
64 return 0 unless (scalar(@a1) == scalar(@a2));
65 for my $i (0..scalar(@a1)-1) {
66 return 0 unless ($a1[$i] eq $a2[$i]);
67 }
68 return 1;
69 }
70 sub printarr {
71 my @b=@_;
72 print "(",(join ", ",grep {s/^/'/;s/$/'/} @b),")";
73 }
74
75 my $file = "marc4.dat";
76 my $testfile = "t/marc4.dat";
77 if (-e $testfile) {
78 $file = $testfile;
79 }
80 unless (-e $file) {
81 die "No MARC sample file found\n";
82 }
83
84 my $naptime = 0; # pause between output pages
85 if (@ARGV) {
86 $naptime = shift @ARGV;
87 unless ($naptime =~ /^[0-5]$/) {
88 die "Usage: perl test?.t [ page_delay (0..5) ]";
89 }
90 }
91
92 my $x;
93 unlink 'output4.txt','output4.mkr';
94
95 # Create the new MARC object. You can use any variable name you like...
96 # Read the MARC file into the MARC object.
97
98 unless (is_ok ($x = MARC->new ($file))) { # 2
99 printf "could not create MARC from $file\n";
100 exit 1;
101 # next test would die at runtime without $x
102 }
103
104 #Output the MARC object to an ascii file
105 is_ok ($x->output({file=>">output4.txt",'format'=>"ASCII"})); # 3
106
107 #Output the MARC object to a marcmaker file
108 is_ok ($x->output({file=>">output4.mkr",'format'=>"marcmaker"})); # 4
109
110 is_ok (-s 'output4.txt'); # 5
111 is_ok (-s 'output4.mkr'); # 6
112 my @a1 = ('1',2,'b');
113 my @a2 = (1,2,'b');
114 my @b1 = ('1',2);
115 my @b2 = ('1',2,'c');
116 is_ok ( array_eq_str(\@a1,\@a2) ); # 7
117 is_bad( array_eq_str(\@a1,\@b1) ); # 8
118 is_bad( array_eq_str(\@a1,\@b2) ); # 9
119
120 # I have found updatefirst/deletefirst functionality very tricky to
121 # implement. And this is the second time I have implemented it. There
122 # are several semantics that can go either way. These tests are
123 # intended to cover all semantic choices and data dependencies,
124 # providing reasonable evidence that any straightforward
125 # implementation is correct.
126
127 # Note to implementors. You should maintain a couple of obvious
128 # invariants by construction. Don't change any but the current record
129 # and don't change any but the current field (and subfield if it
130 # exists). Not hard to do, but someone has to say it.... If you need
131 # to violate the subfield constraint (possible if you put extra
132 # information in the field to reflect workflow) do it in updatehook().
133
134 ## 9. Tests are for "all significant variations", which we
135 # split by function: deletion or update
136 # Given deletion the variations are:
137 # da. tag < or > 10, (tags 1 090)
138 # db. 0,1, or more matches (tags 2 11 3 49 500)
139 # dc. subfield spec or not (tags 5 245)
140 # dd. indicator or not in the subfield spec (tag > 10)
141 # de. last subfield or not (tags 3 049)
142 # df. match in the first field or not. (tags 500 subfield c and a)
143
144 # Given update the variations are:
145 # ua. to be tag < or > 10, (tags 1 3 5 8)
146 # ub. 0,1, or more matches (tags 2 11 3 49 500)
147 # uc. subfield spec or not (tags 4
148 # ud. indicator or not in the subfield spec
149 # uf. match in the first field or not. (tags 500 subfield c and a)
150
151 # This gives an upper bound of 2*3*2*2*2*2 + 2*3*2*2*2 = 96+48 = 148
152 # tests. (There is some collapse possible, so we may get away with
153 # (much) less.) (Currently we have 16 deletes and 14 updates. Better...)
154
155
156 ## 9. What needs to be tested.
157 # We must check that only the affected fields and subfields are
158 # touched. Therefore we need to check, e.g. the 008 field when
159 # we are munging the 245's. From the structure of current code
160 # this is provably correct, but subclasses my override this...
161
162 my ($m008) = $x->getvalue({field=>'008',record=>1,delimeter=>"\c_"});
163
164 # Deletion.
165 #da1.db3 not currently tested. Check with a repeat 006 sometime.
166 #da1.db1.dc1
167 #da1.db1.dc2
168 #da1.db2.dc1
169 #da1.db2.dc2
170
171 #da2.db1.dc1.dd1
172 #da2.db1.dc1.dd2
173 #da2.db1.dc2
174
175 #da2.db2.dc1.dd1
176 #da2.db2.dc1.dd2.de1
177 #da2.db2.dc1.dd2.de2
178 #da2.db2.dc2
179 #da2.db3.dc1.dd1
180 #da2.db3.dc1.dd2
181 #da2.db3.dc1.dd2.de1
182 #da2.db3.dc1.dd2.de2.df1
183 #da2.db3.dc1.dd2.de2.df2
184
185 # Update.
186 #ua1.ub3 not currently tested. Check with a repeat 006 sometime.
187 #ua1.ub1.uc1
188 #ua1.ub1.uc2
189 #ua1.ub2.uc1
190 #ua1.ub2.uc2
191
192 #ua2.ub1.uc1.ud1
193 #ua2.ub1.uc1.ud2
194 #ua2.ub1.uc2
195
196 #ua2.ub2.uc1.ud1
197 #ua2.ub2.uc1.ud2
198 #ua2.ub2.uc2
199 #ua2.ub3.uc1.ud1
200 #ua2.ub3.uc1.ud2.uf1
201 #ua2.ub3.uc1.ud2.uf2
202
203 my %o=();
204 for (qw(001 002 005 049 090 245 247 500)) {
205 my @tmp = $x->getupdate({record=>1,field=>$_});
206 $o{$_}=\@tmp;
207 }
208
209 my $templc1d1 = {record=>1,field=>245,subfield=>'i1'};
210 my $templc1d2 = {record=>1,field=>245,subfield=>'a'};
211 my $templc2 = {record=>1,field=>245};
212 my $subfieldf1 = 'a';
213 my $subfieldf2 = 'c';
214 my $fieldf = 500;
215
216 #F u a1.b1.c2 002 a
217 my $ftempl = {record=>1,field=>'002'};
218 my $templ = {record=>1,field=>'002'};
219 $templ->{subfield}= 'a';
220 undef $@;
221 eval{$x->updatefirst($templ,('002',"x","y", a =>"zz"));};
222 is_ok( $@ =~/Cannot update subfields of control fields/); # 10
223 my @new =$x->getupdate($ftempl);
224 my $ranew = \@new;
225
226 my ($indi1) = $x->getvalue({field=>'245',record=>1,subfield=>'i1'});
227 my ($indi2) = $x->getvalue({field=>'245',record=>1,subfield=>'i2'});
228
229 is_ok($indi1 eq "1"); # 11
230 is_ok($indi2 eq "4"); # 12
231
232 my @m245 = $x->getvalue({field=>'245',record=>1,subfield=>'a',delimiter=>"\c_"});
233 my @m247 = $x->getvalue({field=>'245',record=>1,subfield=>'a',delimiter=>"\c_"});
234 my @m500 = $x->getvalue({field=>'245',record=>1,subfield=>'a',delimiter=>"\c_"});
235
236 $x->updatefirst({field=>'245',record=>1,subfield => 'a'}, ('245','a','b', a=>'foo'));
237
238 ($indi1) = $x->getvalue({field=>'245',record=>1,subfield=>'i1'});
239 ($indi2) = $x->getvalue({field=>'245',record=>1,subfield=>'i2'});
240
241 is_ok($indi1 eq "1"); # 13
242 is_ok($indi2 eq "4"); # 14
243 my ($m245_a) = $x->getvalue({field=>'245',record=>1,subfield=>'a'});
244
245 $x->deletefirst({field=>'500',record=>1});
246 $x->updatefirst({field=>'247',record=>1},
247 (i1=>1,i2=>" ", a =>"Photo marchive"));
248
249 $x->updatefirst({field=>'500',record=>1},
250 (i1=>1,i2=>" ", a =>"First English Fed."));
251
252 is_ok($m008 eq "741021s1884 enkaf 000 1 eng d"); # 15
253
254
255
256 my ($m100a) = $x->getvalue({field=>'100',record=>1,subfield=>'a'});
257 my ($m100d) = $x->getvalue({field=>'100',record=>1,subfield=>'d'});
258 my ($m100e) = $x->getvalue({field=>'100',record=>1,subfield=>'e'});
259
260 is_ok($m100a eq "Twain, Mark,"); # 16
261 is_ok($m100d eq "1835-1910."); # 17
262 is_bad(defined $m100e); # 18
263
264 my @m246a = $x->getvalue({field=>'246',record=>2,subfield=>'a'});
265 is_ok(3 == scalar @m246a); # 19
266 is_ok($m246a[0] eq "Photo archive"); # 20
267 is_ok($m246a[1] eq "Associated Press photo archive"); # 21
268 is_ok($m246a[2] eq "AP photo archive"); # 22
269
270 if ($naptime) {
271 print "++++ page break\n";
272 sleep $naptime;
273 }
274
275 my $update246 = {field=>'246',record=>2,ordered=>'y'};
276 my @u246 = $x->getupdate($update246);
277 is_ok(21 == @u246); # 23
278
279
280 is_ok($u246[0] eq "i1"); # 24
281 is_ok($u246[1] eq "3"); # 25
282 is_ok($u246[2] eq "i2"); # 26
283 is_ok($u246[3] eq "0"); # 27
284 is_ok($u246[4] eq "a"); # 28
285 is_ok($u246[5] eq "Photo archive"); # 29
286 is_ok($u246[6] eq "\036"); # 30
287
288
289 is_ok($u246[7] eq "i1"); # 31
290 is_ok($u246[8] eq "3"); # 32
291 is_ok($u246[9] eq "i2"); # 33
292 is_ok($u246[10] eq " "); # 34
293 is_ok($u246[11] eq "a"); # 35
294 is_ok($u246[12] eq "Associated Press photo archive"); # 36
295 is_ok($u246[13] eq "\036"); # 37
296
297 is_ok($u246[14] eq "i1"); # 38
298 is_ok($u246[15] eq "3"); # 39
299 is_ok($u246[16] eq "i2"); # 40
300 is_ok($u246[17] eq "0"); # 41
301 is_ok($u246[18] eq "a"); # 42
302 is_ok($u246[19] eq "AP photo archive"); # 43
303 is_ok($u246[20] eq "\036"); # 44
304
305 if ($naptime) {
306 print "++++ page break\n";
307 sleep $naptime;
308 }
309
310 is_ok(3 == $x->deletemarc($update246)); # 45
311 my @records = ();
312 foreach my $y1 (@u246) {
313 unless ($y1 eq "\036") {
314 push @records, $y1;
315 next;
316 }
317 $x->addfield($update246, @records) || warn "not added\n";
318 @records = ();
319 }
320
321 @u246 = $x->getupdate($update246);
322 is_ok(21 == @u246); # 46
323
324 is_ok($u246[0] eq "i1"); # 47
325 is_ok($u246[1] eq "3"); # 48
326 is_ok($u246[2] eq "i2"); # 49
327 is_ok($u246[3] eq "0"); # 50
328 is_ok($u246[4] eq "a"); # 51
329 is_ok($u246[5] eq "Photo archive"); # 52
330 is_ok($u246[6] eq "\036"); # 53
331
332 is_ok($u246[7] eq "i1"); # 54
333 is_ok($u246[8] eq "3"); # 55
334 is_ok($u246[9] eq "i2"); # 56
335 is_ok($u246[10] eq " "); # 57
336 is_ok($u246[11] eq "a"); # 58
337 is_ok($u246[12] eq "Associated Press photo archive"); # 59
338 is_ok($u246[13] eq "\036"); # 60
339
340 is_ok($u246[14] eq "i1"); # 61
341 is_ok($u246[15] eq "3"); # 62
342 is_ok($u246[16] eq "i2"); # 63
343 is_ok($u246[17] eq "0"); # 64
344 is_ok($u246[18] eq "a"); # 65
345
346 if ($naptime) {
347 print "++++ page break\n";
348 sleep $naptime;
349 }
350
351 is_ok($u246[19] eq "AP photo archive"); # 66
352 is_ok($u246[20] eq "\036"); # 67
353
354
355 is_ok($x->addfield({record=>1, field=>"999", ordered=>"n",
356 i1=>"5", i2=>"3", value=>[c=>"wL70",
357 d=>"AR Clinton PL",f=>"53525"]})); # 68
358
359 is_ok($x->addfield({record=>1, field=>"900", ordered=>"y",
360 i1=>"6", i2=>"7", value=>[z=>"part 1",
361 z=>"part 2",z=>"part 3"]})); # 69
362
363 is_ok($x->addfield({record=>2, field=>"900", ordered=>"y",
364 i1=>"9", i2=>"8", value=>[z=>"part 4"]})); # 70
365
366 @records = $x->searchmarc({field=>'900'});
367 is_ok(2 == @records); # 71
368 @records = $x->searchmarc({field=>'999'});
369 is_ok(1 == @records); # 72
370
371 @records = $x->getupdate({field=>'900',record=>1});
372 is_ok(11 == @records); # 73
373
374 is_ok($records[0] eq "i1"); # 74
375 is_ok($records[1] eq "6"); # 75
376 is_ok($records[2] eq "i2"); # 76
377 is_ok($records[3] eq "7"); # 77
378 is_ok($records[4] eq "z"); # 78
379 is_ok($records[5] eq "part 1"); # 79
380 is_ok($records[6] eq "z"); # 80
381 is_ok($records[7] eq "part 2"); # 81
382 is_ok($records[8] eq "z"); # 82
383 is_ok($records[9] eq "part 3"); # 83
384 is_ok($records[10] eq "\036"); # 84
385
386 @records = $x->getupdate({field=>'900',record=>2});
387 is_ok(7 == @records); # 85
388
389 is_ok($records[0] eq "i1"); # 86
390 is_ok($records[1] eq "9"); # 87
391
392 if ($naptime) {
393 print "++++ page break\n";
394 sleep $naptime;
395 }
396
397 is_ok($records[2] eq "i2"); # 88
398 is_ok($records[3] eq "8"); # 89
399 is_ok($records[4] eq "z"); # 90
400
401 is_ok($records[5] eq "part 4"); # 91
402 is_ok($records[6] eq "\036"); # 92
403
404 @records = $x->getupdate({field=>'999',record=>1});
405 is_ok(11 == @records); # 93
406
407 is_ok($records[0] eq "i1"); # 94
408 is_ok($records[1] eq "5"); # 95
409 is_ok($records[2] eq "i2"); # 96
410 is_ok($records[3] eq "3"); # 97
411 is_ok($records[4] eq "c"); # 98
412 is_ok($records[5] eq "wL70"); # 99
413 is_ok($records[6] eq "d"); # 100
414 is_ok($records[7] eq "AR Clinton PL"); # 101
415 is_ok($records[8] eq "f"); # 102
416 is_ok($records[9] eq "53525"); # 103
417 is_ok($records[10] eq "\036"); # 104
418
419 is_ok($MARC::VERSION == $MARC::Rec::VERSION); # 105
420
421 @records = $x->getupdate({field=>'999',record=>2});
422 is_ok(0 == @records); # 106
423
424 @records = $x->getupdate({field=>'001',record=>2});
425 is_ok(2 == @records); # 107
426 is_ok($records[0] eq "ocm40139019 "); # 108
427 is_ok($records[1] eq "\036"); # 109
428 my $string_rec = $x->[1]->as_string();
429 my $tmp_rec=$x->[0]{proto_rec}->copy_struct();
430 $tmp_rec->from_string($string_rec);
431 1;# for debug
432