line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package MARC::Moose::Formater::AuthorityUnimarcToMarc21; |
2
|
|
|
|
|
|
|
$MARC::Moose::Formater::AuthorityUnimarcToMarc21::VERSION = '1.0.44'; |
3
|
|
|
|
|
|
|
# ABSTRACT: Convert authority record from UNIMARC to MARC21 |
4
|
4
|
|
|
4
|
|
33
|
use Moose; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
29
|
|
5
|
|
|
|
|
|
|
|
6
|
4
|
|
|
4
|
|
25868
|
use Modern::Perl; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
38
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
extends 'MARC::Moose::Formater'; |
9
|
|
|
|
|
|
|
|
10
|
4
|
|
|
4
|
|
754
|
use MARC::Moose::Field::Control; |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
102
|
|
11
|
4
|
|
|
4
|
|
33
|
use MARC::Moose::Field::Std; |
|
4
|
|
|
|
|
50
|
|
|
4
|
|
|
|
|
2697
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# List of moved fields unchanged |
16
|
|
|
|
|
|
|
my @unchanged; |
17
|
|
|
|
|
|
|
push @unchanged, [$_, 500] for 300..315; |
18
|
|
|
|
|
|
|
push @unchanged, [317, 561], |
19
|
|
|
|
|
|
|
[320, 504], |
20
|
|
|
|
|
|
|
[321, 500], |
21
|
|
|
|
|
|
|
[322, 508], |
22
|
|
|
|
|
|
|
[323, 511], |
23
|
|
|
|
|
|
|
[324, 500], |
24
|
|
|
|
|
|
|
[328, 502], |
25
|
|
|
|
|
|
|
[330, 520], |
26
|
|
|
|
|
|
|
[332, 524], |
27
|
|
|
|
|
|
|
[333, 521], |
28
|
|
|
|
|
|
|
[337, 538], |
29
|
|
|
|
|
|
|
[686, '084']; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Tags with non-filing indicator (pos 1 or 2) |
32
|
|
|
|
|
|
|
my $nonfiling_tags = [ |
33
|
|
|
|
|
|
|
[ qw/130 630 730 740 830/ ], |
34
|
|
|
|
|
|
|
[ qw/240 242 243 245 440 830/ ], |
35
|
|
|
|
|
|
|
]; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# NSB/NSE characters |
38
|
|
|
|
|
|
|
my $ns_characters = [ |
39
|
|
|
|
|
|
|
[ "\x08", "\x09" ], |
40
|
|
|
|
|
|
|
[ "\x88", "\x89" ] |
41
|
|
|
|
|
|
|
]; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $equivals = [ |
45
|
|
|
|
|
|
|
[ qw/ 200 100 / ], |
46
|
|
|
|
|
|
|
[ qw/ 210 110 / ], |
47
|
|
|
|
|
|
|
[ qw/ 215 151 / ], |
48
|
|
|
|
|
|
|
[ qw/ 220 120 / ], |
49
|
|
|
|
|
|
|
[ qw/ 225 125 / ], |
50
|
|
|
|
|
|
|
[ qw/ 230 130 / ], |
51
|
|
|
|
|
|
|
[ qw/ 240 140 / ], |
52
|
|
|
|
|
|
|
[ qw/ 250 150 / ], |
53
|
|
|
|
|
|
|
[ qw/ 415 451 / ], |
54
|
|
|
|
|
|
|
[ qw/ 515 551 / ], |
55
|
|
|
|
|
|
|
]; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
override 'format' => sub { |
58
|
|
|
|
|
|
|
my ($self, $unimarc) = @_; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
my $record = MARC::Moose::Record->new(); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
$record->_leader(" nam a22 7a 4500"); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# First, copy as it is |
65
|
|
|
|
|
|
|
$record->append( grep { 1 } @{$unimarc->fields} ); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
for (@$equivals) { |
68
|
|
|
|
|
|
|
my ($from, $to) = @$_; |
69
|
|
|
|
|
|
|
for my $field ($record->field($from)) { |
70
|
|
|
|
|
|
|
$field->tag($to); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# On intervertit $z et $y |
75
|
|
|
|
|
|
|
for my $field ( $record->field('1..|4..|5..') ) { |
76
|
|
|
|
|
|
|
$field->subf( [ map { |
77
|
|
|
|
|
|
|
my ($letter, $value) = @$_; |
78
|
|
|
|
|
|
|
$letter = $letter eq 'y' ? 'z' : |
79
|
|
|
|
|
|
|
$letter eq 'z' ? 'y' : $letter; |
80
|
|
|
|
|
|
|
[ $letter, $value ]; |
81
|
|
|
|
|
|
|
} @{$field->subf} ] ); |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# Clean non-filing characters in all fields |
85
|
|
|
|
|
|
|
for my $field (@{$record->fields}) { |
86
|
|
|
|
|
|
|
next if $field->tag lt '010'; |
87
|
|
|
|
|
|
|
for (@{$field->subf} ) { |
88
|
|
|
|
|
|
|
next if $_->[0] !~ /[a-z0-9]/; |
89
|
|
|
|
|
|
|
$_->[1] =~ s/\x08|\x09//g; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
return $record; |
94
|
|
|
|
|
|
|
}; |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
1; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
__END__ |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=pod |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=encoding UTF-8 |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=head1 NAME |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
MARC::Moose::Formater::AuthorityUnimarcToMarc21 - Convert authority record from UNIMARC to MARC21 |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head1 VERSION |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
version 1.0.44 |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head1 SYNOPSYS |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
Read a authorities UNIMARC ISO2709 file and dump it to STDOUT in text |
117
|
|
|
|
|
|
|
transformed into MARC21: |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
my $reader = MARC::Moose::Reader::File::Iso2709->new( |
120
|
|
|
|
|
|
|
file => 'authority-unimarc.iso' ); |
121
|
|
|
|
|
|
|
my $formater = MARC::Moose::Formater::AuthorityUnimarcToMarc21->new(); |
122
|
|
|
|
|
|
|
while ( my $unimarc = $reader->read() ) { |
123
|
|
|
|
|
|
|
my $marc21 = $formater->format($unimarc); |
124
|
|
|
|
|
|
|
print $marc21->as('Text'); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
Same with shortcut: |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
my $reader = MARC::Moose::Reader::File::Iso2709->new( |
130
|
|
|
|
|
|
|
file => 'authority-unimarc.iso' ); |
131
|
|
|
|
|
|
|
while ( my $unimarc = $reader->read() ) { |
132
|
|
|
|
|
|
|
print $unimarc->as('AuthorityUnimarcToMarc21')->as('Text'); |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head1 COMMAND LINE |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
If you don't want to write a Perl script, you can use the L<marcmoose> command. |
138
|
|
|
|
|
|
|
This way, you can for example convert a ISO 2709 authorities UNIMARC file named |
139
|
|
|
|
|
|
|
C<unimarc.iso> into a ISO 2709 MARC21 file named C<marc.iso>: |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
marcmoose --parser iso2709 --formater iso2709 --converter authorityunimarctomarc21 |
142
|
|
|
|
|
|
|
--output marc.iso unimarc.iso |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=head1 AUTHOR |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Frédéric Demians <f.demians@tamil.fr> |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
This software is copyright (c) 2021 by Frédéric Demians. |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
153
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=cut |