1 | package MARC::Batch;
|
---|
2 |
|
---|
3 | =head1 NAME
|
---|
4 |
|
---|
5 | MARC::Batch - Perl module for handling files of MARC::Record objects
|
---|
6 |
|
---|
7 | =cut
|
---|
8 |
|
---|
9 | use strict;
|
---|
10 | use integer;
|
---|
11 | eval 'use warnings' if $] >= 5.006;
|
---|
12 |
|
---|
13 | =head1 VERSION
|
---|
14 |
|
---|
15 | Version 1.10
|
---|
16 |
|
---|
17 | $Id: Batch.pm 3430 2002-09-24 05:17:39Z jrm21 $
|
---|
18 |
|
---|
19 | =cut
|
---|
20 |
|
---|
21 | use vars '$VERSION'; $VERSION = '1.10';
|
---|
22 |
|
---|
23 | =head1 SYNOPSIS
|
---|
24 |
|
---|
25 | MARC::Batch hides all the file handling of files of C<MARC::Record>s.
|
---|
26 | C<MARC::Record> still does the file I/O, but C<MARC::Batch> handles the
|
---|
27 | multiple-file aspects.
|
---|
28 |
|
---|
29 | use MARC::Batch;
|
---|
30 |
|
---|
31 | my $batch = new MARC::Batch( 'USMARC', @files );
|
---|
32 | while ( my $marc = $batch->next ) {
|
---|
33 | print $marc->subfield(245,"a"), "\n";
|
---|
34 | }
|
---|
35 |
|
---|
36 | =head1 EXPORT
|
---|
37 |
|
---|
38 | None. Everything is a class method.
|
---|
39 |
|
---|
40 | =head1 METHODS
|
---|
41 |
|
---|
42 | =head2 new( $type, [@files] )
|
---|
43 |
|
---|
44 | Create a C<MARC::Batch> object that will process C<@files>.
|
---|
45 |
|
---|
46 | C<$type> must be either "USMARC" or "MicroLIF". If you want to specify
|
---|
47 | "MARC::File::USMARC" or "MARC::File::MicroLIF", that's OK, too.
|
---|
48 |
|
---|
49 | =cut
|
---|
50 |
|
---|
51 | sub new {
|
---|
52 | my $class = shift;
|
---|
53 | my $type = shift;
|
---|
54 |
|
---|
55 | my $marcclass = ($type =~ /^MARC::File/) ? $type : "MARC::File::$type";
|
---|
56 |
|
---|
57 | eval "require $marcclass";
|
---|
58 | die $@ if $@;
|
---|
59 |
|
---|
60 | my @files = @_;
|
---|
61 |
|
---|
62 | my $self = {
|
---|
63 | filelist => [@files],
|
---|
64 | filestack => [@files],
|
---|
65 | filename => undef,
|
---|
66 | marcclass => $marcclass,
|
---|
67 | file => undef,
|
---|
68 | };
|
---|
69 |
|
---|
70 | bless $self, $class;
|
---|
71 |
|
---|
72 | return $self;
|
---|
73 | } # new()
|
---|
74 |
|
---|
75 |
|
---|
76 | =head2 next()
|
---|
77 |
|
---|
78 | Read the next record from the files. If the current file is at EOF, close
|
---|
79 | it and open the next one.
|
---|
80 |
|
---|
81 | =cut
|
---|
82 |
|
---|
83 | sub next {
|
---|
84 | my $self = shift;
|
---|
85 |
|
---|
86 | # If we have an open file, just use it and go.
|
---|
87 | if ( $self->{file} ) {
|
---|
88 | my $rec = $self->{file}->next();
|
---|
89 | return $rec if $rec;
|
---|
90 | }
|
---|
91 |
|
---|
92 | $self->{file} = undef;
|
---|
93 |
|
---|
94 | # Get the next file off the stack, if there is one
|
---|
95 | $self->{filename} = shift @{$self->{filestack}} or return undef;
|
---|
96 |
|
---|
97 | # Instantiate a filename for it
|
---|
98 | my $marcclass = $self->{marcclass};
|
---|
99 | $self->{file} = $marcclass->in( $self->{filename} ) or return undef;
|
---|
100 |
|
---|
101 | return $self->{file}->next();
|
---|
102 | }
|
---|
103 |
|
---|
104 | =head2 filename()
|
---|
105 |
|
---|
106 | Returns the currently open filename
|
---|
107 |
|
---|
108 | =cut
|
---|
109 |
|
---|
110 | sub filename {
|
---|
111 | my $self = shift;
|
---|
112 |
|
---|
113 | return $self->{filename};
|
---|
114 | }
|
---|
115 |
|
---|
116 | =head2 warnings()
|
---|
117 |
|
---|
118 | Returns any warnings that have accumulated while processing a particular
|
---|
119 | batch file. As a side effect the warning buffer will be cleared.
|
---|
120 |
|
---|
121 | =cut
|
---|
122 |
|
---|
123 | sub warnings {
|
---|
124 | my $self = shift;
|
---|
125 | my $file = $self->{file};
|
---|
126 | return(undef) if !$file;
|
---|
127 | return ($file->warnings());
|
---|
128 | }
|
---|
129 |
|
---|
130 |
|
---|
131 | 1;
|
---|
132 |
|
---|
133 | __END__
|
---|
134 |
|
---|
135 | =head1 RELATED MODULES
|
---|
136 |
|
---|
137 | L<MARC::Record>, L<MARC::Lint>
|
---|
138 |
|
---|
139 | =head1 TODO
|
---|
140 |
|
---|
141 | None yet. Send me your ideas and needs.
|
---|
142 |
|
---|
143 | =head1 LICENSE
|
---|
144 |
|
---|
145 | This code may be distributed under the same terms as Perl itself.
|
---|
146 |
|
---|
147 | Please note that these modules are not products of or supported by the
|
---|
148 | employers of the various contributors to the code.
|
---|
149 |
|
---|
150 | =head1 AUTHOR
|
---|
151 |
|
---|
152 | Andy Lester, E<lt>[email protected]<gt> or E<lt>[email protected]<gt>
|
---|
153 |
|
---|
154 | =cut
|
---|
155 |
|
---|