← Back to branch summary

~ubuntu-branches/ubuntu/utopic/libmarc-xml-perl/utopic-proposed

« back to all changes in this revision

Viewing changes to lib/MARC/File/SAX.pm

  • Committer: Package Import Robot
  • Author(s): Florian Schlichting, gregor herrmann, Salvatore Bonaccorso, Florian Schlichting
  • Date: 2013-03-29 22:47:18 UTC
  • mfrom: (1.2.4)
  • Revision ID: package-import@ubuntu.com-20130329224718-us3eiil2mn4mnsmr
Tags: 1.0.1-1
[ gregor herrmann ]
* debian/control: update {versioned,alternative} (build) dependencies.

[ Salvatore Bonaccorso ]
* Change Vcs-Git to canonical URI (git://anonscm.debian.org)
* Change search.cpan.org based URIs to metacpan.org based URIs

[ Florian Schlichting ]
* Import Upstream version 1.0.1.
* Update (build)dependencies: XML::LibXML instead of XML::SAX.
* Bump Standards-Version to 3.9.4 (no change).
* Email change: Florian Schlichting -> fsfs@debian.org.
* Refresh suppress_test_warning.patch.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/MARC/File/SAX.pm
1
 
package MARC::File::SAX;
2
 
 
3
 
=head1 NAME
4
 
 
5
 
MARC::File::SAX - SAX handler for parsing MARCXML
6
 
 
7
 
=cut 
8
 
 
9
 
use strict;
10
 
use XML::SAX;
11
 
use base qw( XML::SAX::Base );
12
 
use Data::Dumper;
13
 
use MARC::Record;
14
 
use MARC::Charset qw(utf8_to_marc8);
15
 
use Carp qw(croak);
16
 
 
17
 
=head2 new()
18
 
 
19
 
Create the handler.
20
 
 
21
 
=cut
22
 
 
23
 
sub new {
24
 
    my $class = shift;
25
 
    return bless {records => []}, ref($class) || $class;
26
 
}
27
 
 
28
 
=head2 records()
29
 
 
30
 
Get all the MARC::Records that were parsed out of the XML.
31
 
 
32
 
=cut
33
 
 
34
 
sub records {
35
 
    return shift->{records};
36
 
}
37
 
 
38
 
=head2 record()
39
 
 
40
 
In some contexts you might only expect there to be one record parsed. This
41
 
is a shorthand for getting it.
42
 
 
43
 
=cut 
44
 
 
45
 
sub record {
46
 
    return shift->{records}[0];
47
 
}
48
 
 
49
 
sub start_element {
50
 
    my ( $self, $element ) = @_;
51
 
    my $name = $element->{ LocalName };
52
 
    if ( $name eq 'record' ) {
53
 
        $self->{ record } = MARC::Record->new();
54
 
    } elsif ( $name eq 'collection' ) {
55
 
        # ignore collection wrappers
56
 
    } elsif ( defined $self->{ record } ) {
57
 
        if ( $name eq 'leader' ) { 
58
 
            $self->{ tag } = 'LDR';
59
 
        } elsif ( $name eq 'controlfield' ) {
60
 
            $self->{ tag } = $element->{ Attributes }{ '{}tag' }{ Value };
61
 
        } elsif ( $name eq 'datafield' ) { 
62
 
            $self->{ tag } = $element->{ Attributes }{ '{}tag' }{ Value };
63
 
            $self->{ i1 } = $element->{ Attributes }{ '{}ind1' }{ Value };
64
 
            $self->{ i2 } = $element->{ Attributes }{ '{}ind2' }{ Value };
65
 
        } elsif ( $name eq 'subfield' ) { 
66
 
            $self->{ subcode } = $element->{ Attributes }{ '{}code' }{ Value };
67
 
        }
68
 
    } else {
69
 
        # we've reached a new element but haven't started populating
70
 
        # a MARC::Record yet.  This either means that we've encountered
71
 
        # some non-MARC21slim stuff or the caller's given us an invalid
72
 
        # doc that doesn't include a <record> element.
73
 
        # In the first case, we'll just ignore the element; in the second
74
 
        # case, we'll thow an exception with a better description.
75
 
        #
76
 
        # TODO: to be more consistent with how MARC::File::USMARC handles
77
 
        #        parse errors, rather than throwing an exception we could
78
 
        #        instantiate an empty MARC::Record and set its warnings
79
 
        #        array.
80
 
        #
81
 
        if ( $name eq 'leader' || $name eq 'controlfield' || $name eq 'datafield' || $name eq 'subfield' ) {
82
 
            croak("found MARCXML element $name, but the <record> wrapper is missing");
83
 
        }
84
 
    }
85
 
}
86
 
 
87
 
sub end_element { 
88
 
    my ( $self, $element ) = @_;
89
 
    my $name = $element->{ LocalName };
90
 
    if ( $name eq 'subfield' ) { 
91
 
        push @{ $self->{ subfields } }, $self->{ subcode };
92
 
 
93
 
        if ($self->{ transcode }) {
94
 
            push @{ $self->{ subfields } }, utf8_to_marc8($self->{ chars });
95
 
        } else {
96
 
            push @{ $self->{ subfields } }, $self->{ chars } ;
97
 
        }
98
 
 
99
 
        $self->{ chars } = '';
100
 
        $self->{ subcode } = '';
101
 
    } elsif ( $name eq 'controlfield' ) { 
102
 
        $self->{ record }->append_fields(
103
 
            MARC::Field->new( $self->{ tag }, $self->{ chars } )
104
 
        );
105
 
        $self->{ chars } = '';
106
 
        $self->{ tag } = '';
107
 
    } elsif ( $name eq 'datafield' ) { 
108
 
        $self->{ record }->append_fields( 
109
 
            MARC::Field->new( 
110
 
                $self->{ tag }, 
111
 
                $self->{ i1 }, 
112
 
                $self->{ i2 },
113
 
                @{ $self->{ subfields } }
114
 
            )
115
 
        );
116
 
        $self->{ tag } = '';
117
 
        $self->{ i1 } = '';
118
 
        $self->{ i2 } = '';
119
 
        $self->{ subfields } = [];
120
 
        $self->{ chars } = '';
121
 
    } elsif ( $name eq 'leader' ) { 
122
 
        my $ldr = $self->{ chars };
123
 
 
124
 
        $self->{ transcode }++
125
 
            if (substr($ldr,9,1) eq 'a' and $self->{toMARC8});
126
 
 
127
 
        substr($ldr,9,1,' ') if ($self->{ transcode });
128
 
 
129
 
        $self->{ record }->leader( $ldr );
130
 
        $self->{ chars } = '';
131
 
        $self->{ tag } = '';
132
 
    } elsif ( $name eq 'record' ) {
133
 
        push(@{ $self->{ records } }, $self->{ record });
134
 
        undef $self->{ record };
135
 
    }
136
 
}
137
 
 
138
 
sub characters {
139
 
    my ( $self, $chars ) = @_;
140
 
    if (
141
 
        ( exists $self->{ subcode } && $self->{ subcode } ne '')
142
 
        || ( $self->{ tag } && ( $self->{ tag } eq 'LDR' || $self->{ tag } < 10 ))
143
 
    ) { 
144
 
        $self->{ chars } .= $chars->{ Data };
145
 
    } 
146
 
}
147
 
 
148
 
1;