File Coverage

blib/lib/MARC/Moose/Formater/UnimarcToMarc21.pm
Criterion Covered Total %
statement 17 45 37.7
branch 0 22 0.0
condition 0 3 0.0
subroutine 6 8 75.0
pod 0 1 0.0
total 23 79 29.1


line stmt bran cond sub pod time code
1             package MARC::Moose::Formater::UnimarcToMarc21;
2             $MARC::Moose::Formater::UnimarcToMarc21::VERSION = '1.0.45';
3             # ABSTRACT: Convert biblio record from UNIMARC to MARC21
4 4     4   33 use Moose;
  4         8  
  4         29  
5              
6 4     4   27138 use 5.010;
  4         15  
7 4     4   38 use utf8;
  4         10  
  4         34  
8              
9             extends 'MARC::Moose::Formater';
10              
11 4     4   190 use List::Util qw/ first /;
  4         20  
  4         335  
12 4     4   27 use MARC::Moose::Field::Control;
  4         9  
  4         133  
13 4     4   24 use MARC::Moose::Field::Std;
  4         9  
  4         38971  
14              
15              
16             # Equivalence UNIMARC author type code > MARC21
17             # Each UNIMARC code points to a array ref which first entry contains MARC21
18             # code and second MARC21 author type description. The second entry isn't used
19             # yet.
20             my %authcode = map { /^(\d*) (\w*) (.*)$/; $1 => [$2, $3] } split /\n/, <<EOS;
21             005 act actor
22             010 adp adapter
23             020 ann annotator
24             030 arr arranger
25             040 art artist
26             050 asg assignee
27             060 asn associated name
28             065 auc auctioneer
29             070 aut author
30             072 aqt author in quotations or text abstract
31             075 aft author of afterword, colophon, etc.
32             080 aui author of introd
33             090 aus author of screenplay
34             100 ant bibl. antecedent
35             110 bnd binder
36             120 bdd binding designer
37             130 bkd book designer
38             140 bjd bkjacket designer
39             150 bpd bkplate designer
40             160 bsl bookseller
41             170 cll calligrapher
42             180 ctg cartographer
43             190 cns censor
44             200 chr choreographer
45             205 clb collaborator
46             210 cmm commentator
47             212 cwt commentator for written text
48             220 com compiler
49             230 cmp composer
50             240 cmt compositor
51             245 ccp conceptor
52             250 cnd conductor
53             255 csp consultant to a project
54             260 cph copyright holder
55             270 crr corrector
56             273 cur curator
57             275 dnc dancer
58             280 dte dedicatee
59             290 dto dedicator
60             295 dgg degree grantor
61             300 drt director
62             305 dis dissertant
63             310 dst distributor
64             320 dnr donor
65             330 dub dubious author
66             340 edt editor
67             350 egr engraver
68             360 etr etcher
69             365 exp expert
70             370 flm film editor
71             380 frg forger
72             390 fmo former owner
73             400 fnd funder
74             410 grt graphic technician
75             420 hnr honoree
76             430 ilu illuminator
77             440 ill illustrator
78             450 ins inscriber
79             460 ive interviewee
80             470 ivr interviewer
81             480 lbt librettist
82             490 lse licensee
83             500 lso licensor
84             510 ltg lithographer
85             520 lyr lyricist
86             530 mte metal engraver
87             540 mon monitor/contractor
88             545 mus musician
89             550 nrt narrator
90             555 opn opponent
91             557 orm organizer of meeting
92             560 org originator
93             570 oth other
94             580 ppm papermaker
95             582 pta patent applicant
96             584 inv inventor
97             587 pth patent holder
98             590 prf performer
99             595 res research
100             600 pht photographer
101             610 prt printer
102             620 pop printer of plates
103             630 pro producer
104             635 prg programmer
105             640 pfr proofreader
106             650 pbl publisher
107             651 pbd publishing director
108             660 rcp recipient
109             670 rce recording engineer
110             673 rth research team head
111             675 rev reviewer
112             677 rtm research team member
113             680 rbr rubricator
114             690 sce scenarist
115             695 sad scientific advisor
116             700 scr scribe
117             705 scl sulptor
118             710 sec secretary
119             720 sgn signer
120             721 sng singer
121             723 spn sponsor
122             725 stn standards body
123             727 ths thesis advisor
124             730 trl translator
125             740 tyd type designer
126             750 tyg typographer
127             755 voc vocalist
128             760 wde wood engraver
129             770 wam writer of accompanying material
130             EOS
131              
132             # UNIMARC 100 Type of pub
133             my %typeofpub = map { /(\w) (\w)/; $1 => $2; } split /\n/, <<EOS;
134             a c
135             b d
136             c u
137             d s
138             e r
139             f q
140             g m
141             h t
142             i p
143             j e
144             EOS
145              
146             # UNIMARC 100 Target Audience Code
147             my %target_audience = map { /(\w|\|) (\w|\|)/; $1 => $2; } split /\n/, <<EOS;
148             b a
149             c b
150             a j
151             d c
152             e d
153             k e
154             m g
155             | |
156             EOS
157              
158             # List of moved fields unchanged
159             my @unchanged;
160             push @unchanged, [$_, 500] for 300..315;
161             push @unchanged, [317, 561],
162             [320, 504],
163             [321, 500],
164             [322, 508],
165             [323, 511],
166             [324, 500],
167             [328, 502],
168             [330, 520],
169             [332, 524],
170             [333, 521],
171             [337, 538],
172             [686, '084'];
173              
174             # Tags with non-filing indicator (pos 1 or 2)
175             my $nonfiling_tags = [
176             [ qw/130 630 730 740 830/ ],
177             [ qw/240 242 243 245 440 830/ ],
178             ];
179              
180             # NSB/NSE characters
181             my $ns_characters = [
182             [ "\x08", "\x09" ],
183             [ "\x88", "\x89" ]
184             ];
185              
186              
187              
188             # Procedure 4 Title
189             sub procedure_title {
190 0     0 0   my ($self, $subf) = @_;
191              
192 0           my @sf;
193 0           my ($h_index) = (-1);
194 0           my @equivals = (
195             [ 'a', 'a' ],
196             [ 'j', 'f' ],
197             [ 'n', 'g' ],
198             [ 'h', 'n', '.' ],
199             [ 'k', 'f', '.' ],
200             [ 'l', 'k', '.' ],
201             [ 'm', 'l', '.' ],
202             [ 'q', 's', '.' ],
203             [ 'r', 'r', ',' ],
204             [ 's', 's', ',' ],
205             [ 't', 'o', ';' ],
206             [ 'u', 'r', ',' ],
207             [ 'x', 'x', ',' ],
208             );
209 0           for ( @$subf ) {
210 0           my ($letter, $value) = @$_;
211 0 0   0     if ( my $equival = first { $_->[0] eq $letter } @equivals ) {
  0            
212 0           my ($from, $to, $sep) = @$equival;
213 0 0 0       if ( $sep && @sf ) {
214 0           my $match = $sep;
215 0 0         $match = '\.' if $match eq '.';
216 0 0         if ( $sf[-1]->[0] !~ /$match$/ ) {
217 0           $sf[-1]->[1] .= $sep;
218             }
219             }
220 0           push @sf, [ $to => $value ];
221             }
222             else {
223 0           for ($letter) {
224 0 0         if ( /e/ ) {
    0          
225 0 0         next unless @sf; #FIXME warning required
226 0 0         if ( $sf[-1][0] =~ /a|n|p/ ) {
227 0           $sf[-1]->[1] .= ' :';
228 0           push @sf, [ b => $value ];
229             }
230             else {
231 0           $sf[-1]->[1] .= " : $value";
232             }
233             }
234             elsif ( /i/ ) {
235 0 0         if ( @sf ) {
236 0 0         if ( $sf[-1]->[0] eq 'h' ) {
237 0 0         $sf[-1]->[1] .= ',' if $sf[-1]->[1] !~ /,$/;
238             }
239             else {
240 0           $sf[-1]->[1] .= '.';
241             }
242             }
243 0           push @sf, [ p => $value ];
244             }
245             }
246             }
247             }
248              
249 0           return \@sf;
250             }
251              
252              
253             override 'format' => sub {
254             my ($self, $unimarc) = @_;
255              
256             my $record = MARC::Moose::Record->new();
257              
258             $record->_leader(" nam a22 7a 4500");
259              
260             my $code008 = '120130t xxu||||| |||| 00| 0 ||| d';
261              
262             my @sf040;
263              
264             # 001 => 001
265             for my $field ( $unimarc->field('001' ) ) {
266             $record->append($field->clone());
267             }
268              
269             # ISBN 010 => 020
270             for my $field ( $unimarc->field('010') ) {
271             my @sf;
272             for ( @{$field->subf} ) {
273             my ($letter, $value) = @$_;
274             for ($letter) {
275             if ( /a|z/ ) {
276             $value =~ s/-//g;
277             push @sf, [ $letter => $value ];
278             }
279             elsif ( /b/ ) {
280             $value = "($value)" unless $value =~ /^\(/;
281             if (@sf) {
282             $sf[-1]->[1] .= " $value";
283             }
284             else {
285             push @sf, [ c => $value ];
286             }
287             }
288             elsif ( /d/ ) {
289             if (@sf) {
290             $sf[-1]->[1] .= " :";
291             }
292             push @sf, [ c => $value ];
293             }
294             }
295             }
296             $record->append( MARC::Moose::Field::Std->new(
297             tag => '020', subf => \@sf ) );
298             }
299              
300             # ISSN 011 => 022
301             # Except 011$b$d => 365
302             for my $field ( $unimarc->field('011') ) {
303             my (@sf, @price);
304             for ( @{$field->subf} ) {
305             my ($letter, $value) = @$_;
306             for ($letter) {
307             if ( /a/ ) {
308             $value =~ s/-//g;
309             push @sf, [ a => $value ];
310             }
311             elsif ( /z/ ) {
312             $value =~ s/-//g;
313             push @sf, [ y => $value ];
314             }
315             elsif ( /b|d/ ) {
316             $value = "($value)" unless $value =~ /^\(/;
317             my $newlet = $letter eq 'b' ? 'b' : 'd';
318             push @price, [ $newlet => $value ];
319             }
320             }
321             }
322             $record->append( MARC::Moose::Field::Std->new(
323             tag => '022', subf => \@sf ) ) if @sf;
324             $record->append(MARC::Moose::Field::Std->new(
325             tag => '365', subf => \@price ) ) if @price;
326             }
327              
328             # EAN 076 => 024. Get only $a subfield
329             for my $field ( $unimarc->field('073') ) {
330             my $value = $field->subfield('a');
331             next unless $value;
332             $record->append( MARC::Moose::Field::Std->new(
333             tag => '024', subf => [ [ a => $value ] ] ) );
334             }
335              
336             # 100 => 008
337             if ( my $field = $unimarc->field('100') ) {
338             my $code100 = $field->subfield('a');
339             if ( $code100 && length($code100) > 20 ) {
340             # Date entered on file
341             substr $code008, 0, 6, substr($code100, 2, 6);
342              
343             # Type of publication date
344             my $value = substr($code100, 8, 1);
345             $value = $typeofpub{$value} || ' ';
346             substr $code008, 6, 1, $value;
347              
348             # Date 1
349             $value = substr($code100, 9, 4);
350             if ( 1 ) { #FIXME Determine if it's a serials
351             # Not serials
352             my $count = 0;
353             for ( split //, $value ) { $count++ if / /; }
354             $value =~ s/ /0/g if $count <= 3;
355             }
356             else {
357             # A serials
358             $value =~ s/ /u/g;
359             }
360             substr $code008, 7, 4, $value;
361              
362             # Date 2
363             $value = substr($code100, 13, 4);
364             if ( 1 ) { #FIXME Determine if it's a serials
365             # Not serials
366             my $count = 0;
367             for ( split //, $value ) { $count++ if / /; }
368             $value =~ s/ /0/g if $count <= 3;
369             }
370             else {
371             # A serials
372             $value =~ s/ /u/g;
373             }
374             substr $code008, 11, 4, $value;
375              
376             # 3 positions for target audience
377             $value = substr($code100, 17, 3);
378             for (my $i=0; $i < 3; $i++) {
379             $value = substr($code100, 17+$i, 1);
380             $value = $target_audience{$value} || ' ';
381             substr $code008, 17+$i, 1, $value;
382             }
383            
384             # Language of cataloging
385             push @sf040, [ b => substr($code100, 22, 3) ];
386              
387             # Alphabet of title, converted if serials
388             # FIXME
389             if ( 0 ) {
390             substrr $code008, 33, 1, substr($code100,34,1);
391             }
392             }
393             }
394              
395             # Language 101 => 041 and 008
396             if ( my $field = $unimarc->field('101') ) {
397             # FIXME: à virer
398             if ( ref($field) eq 'MARC::Moose::Field::Control' ) {
399             say $unimarc->as('Text');
400             exit;
401             }
402             my @all = @{$field->subf};
403             my $count_a = 0;
404             my (@sf, @sf_b);
405             for (@all) {
406             my ($letter, $value) = @$_;
407             for ($letter) {
408             if ( /a/ ) {
409             next if $count_a >= 6;
410             $count_a++;
411             if ( $count_a == 1 ) {
412             $value .= ' ';
413             $value = substr($value, 0, 3);
414             substr $code008, 35, 3, $value;
415             }
416             push @sf, [ a => $value];
417             }
418             elsif ( /c/ ) { push @sf, [ h => $value ]; }
419             elsif ( /b/ ) { push @sf_b, $value; }
420             elsif ( /d/ ) { push @sf, [ b => $value ]; }
421             elsif ( /e/ ) { push @sf, [ f => $value ]; }
422             elsif ( /f|g/ ) { }
423             elsif ( /j/ ) { push @sf, [ b => $value ]; }
424             elsif ( /h/ ) { push @sf, [ e => $value ]; }
425             elsif ( /i/ ) { push @sf, [ g => $value ]; }
426             }
427             }
428             if ( @sf_b ) {
429             for ( @sf ) {
430             if ($_->[0] eq 'h') {
431             $_->[1] .= ' ' . join(' ', @sf_b);
432             last;
433             }
434             }
435             }
436             my $ind1 = $field->ind1;
437             $ind1 = '0' if $ind1 eq ' ';
438             $ind1 = '1' if $ind1 eq '2';
439             $record->append( MARC::Moose::Field::Std->new(
440             tag => '041',
441             ind1 => $ind1,
442             subf => \@sf ) );
443             }
444             else {
445             substr($code008, 35, 3) = '|||';
446             }
447              
448             # 125 => 008
449             # FIXME: 125$b isn't handled at all
450             if ( my $field = $unimarc->field('125') ) {
451             my $value = $field->subfield('a');
452             my ($pos0, $pos1);
453             $pos0 = substr($value, 0, 1) if $value && length($value) >= 1;
454             $pos1 = substr($value, 1, 1) if $value && length($value) >= 2;
455             $pos0 ||= '|';
456             $pos0 = 'n' if $pos0 eq 'x';
457             $pos1 ||= '|';
458             $pos1 = 'n' if $pos1 eq 'x';
459             $pos1 = ' ' if $pos1 eq 'y';
460             substr($code008, 20, 2) = $pos0 . $pos1;
461             }
462              
463             $record->append( MARC::Moose::Field::Control->new(
464             tag => '008', value => $code008 ) );
465              
466             # Title
467             for my $field ( $unimarc->field('200') ) {
468             my @sf;
469             my ($a_index, $h_index) = (-1, -1);
470             SUBFIELD200:
471             for ( @{$field->subf} ) {
472             my ($letter, $value) = @$_;
473             for ($letter) {
474             if ( /a/ ) {
475             if ( $a_index == -1 ) {
476             push @sf, [ a => $value ];
477             $a_index = $#sf;
478             }
479             else {
480             $sf[$a_index]->[1] .= " ; $value";
481             }
482             }
483             elsif ( /b/) {
484             if ( $h_index == -1 ) {
485             push @sf, [ h => $value ];
486             $h_index = $#sf;
487             }
488             else {
489             if ( $#sf == $h_index ) {
490             $sf[$h_index]->[1] .= " + $value";
491             }
492             else {
493             $sf[-1]->[1] .= " ($value)";
494             }
495             }
496             }
497             elsif ( /c/ ) {
498             next SUBFIELD200 unless @sf; #FIXME warning required
499             $sf[-1]->[1] .= ". $value";
500             }
501             elsif ( /d/ ) {
502             next SUBFIELD200 unless @sf; #FIXME warning required
503             if ( $sf[-1]->[0] =~ /a|n|p/ ) {
504             $sf[-1]->[1] .= ' =';
505             $value =~ s/^= //;
506             push @sf, [ b => $value ];
507             }
508             else {
509             $sf[-1]->[1] .= " = $value";
510             }
511             }
512             elsif ( /e/ ) {
513             next SUBFIELD200 unless @sf; #FIXME warning required
514             if ( $sf[-1]->[0] =~ /a|n|p/ ) {
515             $sf[-1]->[1] .= ' :';
516             push @sf, [ b => $value ];
517             }
518             else {
519             $sf[-1]->[1] .= " : $value";
520             }
521             }
522             elsif ( /f/) {
523             next SUBFIELD200 unless @sf; #FIXME warning required
524             if ( $sf[-1]->[0] =~ /a|b|n|p/ ) {
525             $sf[-1]->[1] .= ' /';
526             push @sf, [ c => $value ];
527             }
528             else {
529             $sf[-1]->[1] .= " / $value";
530             }
531             }
532             elsif ( /g/) {
533             next SUBFIELD200 unless @sf; #FIXME warning required
534             $sf[-1]->[1] .= " ; $value";
535             }
536             elsif ( /h/ ) {
537             next SUBFIELD200 unless @sf; #FIXME warning required
538             if ( $sf[-1]->[0] =~ /a|n|p/ ) {
539             $sf[-1]->[1] .= '.';
540             push @sf, [ n => $value ];
541             }
542             else {
543             #$sf[-1]->[1] .= ". $value";
544             push @sf, [ n => $value ];
545             }
546             }
547             elsif ( /i/ ) {
548             next SUBFIELD200 unless @sf; #FIXME warning required
549             if ( @sf && $sf[-1]->[0] =~ /a|n|p/ ) {
550             $sf[-1]->[1] .= ',';
551             push @sf, [ p => $value ];
552             }
553             else {
554             $sf[-1]->[1] .= ". $value";
555             }
556             }
557             elsif ( /v|z|5|6|7/ ) { next SUBFIELD200 }
558             }
559             }
560             next unless @sf;
561             $sf[$h_index]->[1] = '[' . $sf[$h_index]->[1] . ']' unless $h_index == -1;
562             # Point final
563             $sf[-1][1] = $sf[-1][1] . '.' if @sf;
564              
565             # Indicators
566             my ($ind1, $ind2) = ($field->ind1, 0);
567             for ($ind1) {
568             if ( /0/ ) { }
569             elsif ( /1/ ) {
570             #FIXME Test marc21 100/110/111/130 presence
571             $ind1 = $unimarc->field('700|710' ) ? 1 : 0;
572             }
573             else { $ind1 = 1; }
574             }
575             $record->append( MARC::Moose::Field::Std->new(
576             tag => '245', ind1 => $ind1, ind2 => $ind2,
577             subf => \@sf ) );
578             }
579            
580             # TODO 204
581              
582             # 205 => 250
583             for my $field ($unimarc->field('205') ) {
584             my @sf;
585             my ($a_index, $b_index) = (-1, -1);
586             for ( @{$field->subf} ) {
587             my ($letter, $value) = @$_;
588             for ($letter) {
589             if ( /a/ ) {
590             if ( $a_index == -1 ) {
591             push @sf, [ a => $value ];
592             $a_index = $#sf;
593             }
594             else {
595             $sf[$a_index]->[1] .= ", $value";
596             }
597             }
598             elsif ( /b/ ) {
599             if ( @sf ) {
600             $sf[-1]->[1] .= ", $value";
601             }
602             else {
603             push @sf, [ a => $value ];
604             $a_index = $#sf;
605             }
606             }
607             elsif ( /d/ ) {
608             if ( $b_index == -1 ) {
609             push @sf, [ b => $value];
610             $b_index = $#sf;
611             }
612             else {
613             $sf[-1]->[1] .= " $value";
614             }
615             }
616             elsif ( /f/ ) {
617             if ( $b_index == -1 ) {
618             $sf[-1]->[1] .= " / " if @sf;
619             push @sf, [ b => $value];
620             $b_index = $#sf;
621             }
622             else {
623             $sf[-1]->[1] .= " / $value";
624             }
625             }
626             elsif ( /g/ ) {
627             if ( @sf ) { $sf[-1]->[1] .= " / $value"; }
628             else { push @sf, [ a => $value ] }
629             }
630             }
631             }
632             next unless @sf;
633             if ( $b_index >= 1 ) {
634             my $value = $sf[$b_index]->[1];
635             if ( $value =~ /= $/ ) {
636             $value =~ s/= $//;
637             $sf[$b_index]->[1] = $value;
638             $sf[$b_index-1]->[1] .= '= ';
639             }
640             }
641             # Point final
642             $sf[-1][1] = $sf[-1][1] . '.' if @sf && $sf[-1][1] !~ /\.$/;
643             $record->append( MARC::Moose::Field::Std->new(
644             tag => '250', ind1 => $field->ind1, ind2 => $field->ind2,
645             subf => \@sf ) );
646             }
647              
648             # TODO 206
649              
650             # 207 => 362
651             for my $field ($unimarc->field('207') ) {
652             my @sf;
653             my $a_index = -1;
654             for ( @{$field->subf} ) {
655             my ($letter, $value) = @$_;
656             for ($letter) {
657             if ( /a/ ) {
658             if ( $a_index == -1 ) {
659             push @sf, [ a => $value ];
660             $a_index = $#sf;
661             }
662             else {
663             my $prev = $sf[$a_index]->[1];
664             $prev =~ s/ *$//;
665             $prev =~ s/;$//;
666             $prev =~ s/ *$//;
667             $sf[$a_index]->[1] = "$prev ; $value";
668             }
669             }
670             elsif ( /v/ ) {
671             push @sf, [ z => $value ];
672             }
673             }
674             }
675             next unless @sf;
676             # Point at the end
677             $sf[-1][1] = $sf[-1][1] . '.' if @sf && $sf[-1][1] !~ /\.$/;
678             $record->append( MARC::Moose::Field::Std->new(
679             tag => '362', ind2 => $field->ind1,
680             subf => \@sf ) );
681             }
682              
683             #TODO 208
684              
685             # 210/214 => 260
686             for my $field ( $unimarc->field('210|214') ) {
687             my @sf;
688             for ( @{$field->subf} ) {
689             my ($letter, $value) = @$_;
690             $value =~ s/^ *//, $value =~ s/ *$//;
691             my %found;
692             for ($letter) {
693             if ( /a/ ) {
694             push @sf, [ a => $value ];
695             }
696             elsif ( /b/ ) {
697             $value = "($value)" if $value !~ /^\(/;
698             if ( @sf ) {
699             $sf[-1]->[1] .= " $value";
700             }
701             else {
702             push @sf, [ a => $value ];
703             }
704             }
705             elsif ( /c/ ) {
706             push @sf, [ b => $value ];
707             }
708             elsif ( /d/ ) {
709             push @sf, [ c => $value ];
710             }
711             elsif ( /e/ ) {
712             push @sf, [ e => $value ];
713             }
714             elsif ( /f/ ) {
715             unless ( $found{$letter} ) {
716             $found{$letter} = 1;
717             $sf[-1]->[1] .= ", $value" if @sf;
718             }
719             }
720             elsif ( /g/ ) {
721             unless ( $found{$letter} ) {
722             $found{$letter} = 1;
723             push @sf, [ f => $value ];
724             }
725             }
726             elsif ( /h/ ) {
727             unless ( $found{$letter} ) {
728             $found{$letter} = 1;
729             push @sf, [ g => $value ];
730             }
731             }
732             elsif ( /j/ ) {
733             $record->append( MARC::Moose::Field::Std->new(
734             tag => '265', subf => [ a => $value ] ) );
735             }
736             elsif ( /k/ ) {
737             $record->append( MARC::Moose::Field::Std->new(
738             tag => '265', ind1 => '0', ind2 => '0',
739             subf => [ a => $value ] ) );
740             }
741             elsif ( /l/ ) {
742             $record->append( MARC::Moose::Field::Std->new(
743             tag => '265', ind1 => '1', ind2 => '0',
744             subf => [ [ a => $value ] ] ) );
745             }
746             elsif ( /m/ ) {
747             $record->append( MARC::Moose::Field::Std->new(
748             tag => '265', ind1 => '2', ind2 => '0',
749             subf => [ a => $value ] ) );
750             }
751             }
752             }
753             next unless @sf;
754             # Ponctuation
755             for (my $i=0; $i < @sf; $i++) {
756             my ($letter, $value) = @{$sf[$i]};
757             for ($letter) {
758             if ( /a/ ) {
759             $sf[$i-1]->[1] .= ' ;' if $i;
760             }
761             elsif ( /b|f/ ) {
762             $sf[$i-1]->[1] .= ' :' if $i;
763             }
764             elsif ( /c|g/ ) {
765             $sf[$i-1]->[1] .= ',' if $i;
766             }
767             }
768             $value = "($value)" if $letter =~ /e|f|g/;
769             if ( $value =~ /^= / ) {
770             $value =~ s/^= //;
771             $sf[$i-1]->[1] .= ' =' if $i;
772             }
773             $sf[$i]->[1] = $value;
774             }
775             $sf[-1][1] = $sf[-1][1] . '.' if @sf && $sf[-1][1] !~ /\.$/;
776             $record->append( MARC::Moose::Field::Std->new( tag => '260', subf => \@sf ) );
777             }
778              
779             # TODO 211 => 263
780              
781             # 215 => 300
782             for my $field ( $unimarc->field('215') ) {
783             my @sf;
784             SUBFIELD215:
785             for ( @{$field->subf} ) {
786             my ($letter, $value) = @$_;
787             $value =~ s/^ *//, $value =~ s/ *$//;
788             for ($letter) {
789             if ( /c/ ) { $letter = 'b'; }
790             elsif ( /d/ ) { $letter = 'c'; }
791             elsif ( /6|7/ ) { next SUBFIELD215; }
792             }
793             push @sf, [ $letter => $value ];
794             }
795             next unless @sf;
796             # Ponctuation
797             for (my $i=1; $i < @sf; $i++) {
798             my ($letter, $value) = @{$sf[$i]};
799             for ($letter) {
800             if ( /b/ ) { $sf[$i-1]->[1] .= ' :'; }
801             elsif ( /c/ ) { $sf[$i-1]->[1] .= ' ;'; }
802             elsif ( /e/ ) { $sf[$i-1]->[1] .= ' + '; }
803             }
804             }
805             $sf[-1][1] = $sf[-1][1] . '.' if $sf[-1][1] !~ /\.$/;
806             $record->append( MARC::Moose::Field::Std->new( tag => '300', subf => \@sf ) );
807             }
808              
809             # 225 => 490
810             for my $field ( $unimarc->field('225') ) {
811             my (@sf, @a, @vx);
812             my $prev_letter = '';
813             for ( @{$field->subf} ) {
814             my ($letter, $value) = @$_;
815             $value =~ s/^ *//, $value =~ s/ *$//;
816             $value =~ s/\x88//g, $value =~ s/\x89//;
817             for ($letter) {
818             if ( /a/ ) { push @a, $value; }
819             elsif ( /d/ ) { push @a, " = $value" }
820             elsif ( /e/ ) { push @a, " : $value" }
821             elsif ( /f/ ) { push @a, " / $value" }
822             elsif ( /h/ ) { push @a, ". $value" }
823             elsif ( /i/ ) {
824             push @a, $prev_letter eq 'h' ? ", $value " : ". $value";
825             }
826             elsif ( /v|x/ ) { push @vx, [ $letter => $value ] }
827             }
828             $prev_letter = $letter;
829             }
830             next unless @a;
831             push @sf, [ a => join('', @a) ];
832             push @sf, @vx;
833             $record->append( MARC::Moose::Field::Std->new(
834             tag => '490',
835             ind1 => $field->ind1 =~ /0|2/ ? 1 : 0,
836             subf => \@sf ) );
837             }
838              
839             # 230 => 256
840             for my $field ( $unimarc->field('230') ) {
841             $record->append($field->clone('256'));
842             }
843              
844             # Unchanged fields
845             for my $fromto ( @unchanged ) {
846             my ($from, $to) = @$fromto;
847             for my $field ( $unimarc->field($from) ) {
848             $record->append($field->clone($to));
849             }
850             }
851              
852             # 325 => 533
853             for my $field ( $unimarc->field('325') ) {
854             $record->append( MARC::Moose::Field::Std->new(
855             tag => '533',
856             subf => [ [ n => $field->subfield('a') ] ] ) );
857             }
858              
859             # 326 => 533
860             for my $field ( $unimarc->field('326') ) {
861             # FIXME Should be done depending on biblio record type:
862             # MAP, SERIALS
863             my $type = 'SERIALS';
864             my $new_field;
865             if ( $type =~ /SERIALS/ ) {
866             $new_field = $field->clone('310');
867             }
868             $record->append($new_field);
869             }
870              
871             # 327 => 505
872             for my $field ( $unimarc->field('327') ) {
873             my $ind1 = $field->ind1;
874             $ind1 = 0 if $ind1 =~ /1/;
875             $ind1 = 1 if $ind1 =~ /0/;
876             my @a = map { $_->[1] } @{$field->subf};
877             $record->append( MARC::Moose::Field::Std->new(
878             tag => '505', ind1 => $ind1,
879             subf => [ [ a => join(' ', @a) ] ] ) );
880             }
881              
882             # 329 => 505
883             # This is French (CCfr) specific field without equivalent in MARC21
884             # Concatained into 505 field
885             for my $field ( $unimarc->field('359') ) {
886             my @a = map { $_->[1] } @{$field->subf};
887             $record->append( MARC::Moose::Field::Std->new(
888             tag => '505', ind1 => '0',
889             subf => [ [ a => join(' -- ', @a) ] ] ) );
890             }
891              
892              
893             # 336 => 500
894             for my $field ( $unimarc->field('336') ) {
895             $record->append( MARC::Moose::Field::Std->new(
896             tag => '500',
897             subf => [ [ a => 'Type of computer file: ' . $field->subfield('a') ] ] ) );
898             }
899              
900             # 345 => 037
901             for my $field ( $unimarc->field('345') ) {
902             my @sf;
903             for ( @{$field->subf} ) {
904             my ($letter, $value) = @$_;
905             $letter = $letter eq 'a' ? 'b' :
906             $letter eq 'b' ? 'a' :
907             $letter eq 'c' ? 'f' :
908             $letter eq 'd' ? 'c' : $letter;
909             push @sf, [ $letter => $value ];
910             }
911             $record->append( MARC::Moose::Field::Std->new(
912             tag => '037', subf => \@sf ) );
913             }
914              
915             # TODO 410 411 421 422 423 430 431 432 433 434 435 436 437 440 441 442 443
916             # 444 445 446 447 448 451 452 453
917              
918             # 454 => 765
919             for my $ft ( (
920             [410, 760],
921             [411, 762],
922             [421, 770],
923             [422, 772],
924             [423, 777],
925             [430, 780, 0],
926             [431, 780, 1],
927             [432, 780, 2],
928             [433, 780, 3],
929             [434, 780, 5],
930             [435, 780, 6],
931             [436, 780, 4],
932             [437, 780, 7],
933             [440, 785, 0],
934             [441, 785, 1],
935             [442, 785, 2],
936             [443, 785, 3],
937             [444, 785, 4],
938             [445, 785, 5],
939             [446, 785, 6],
940             [447, 785, 7],
941             [448, 785, 8],
942             [451, 775],
943             [452, 776],
944             [453, 767],
945             [454, 765],
946             [455, 787, 8, 'Reproduction of:'],
947             [456, 787, 8, 'Reproduced as:'],
948             [461, 773],
949             [462, 774],
950             [463, 773],
951             [464, 774],
952             [470, 787, 8, 'Item reviewed:'],
953             [488, 787, 8, 'Reproduced as:'],
954             [491, 774],
955             [492, 774],
956             [493, 773],
957             [494, 773],
958             ) ) {
959             my ($from, $to, $ind2, $text) = @$ft;
960             $ind2 = ' ' unless $ind2;
961             for my $field ( $unimarc->field($from) ) {
962             my @sf;
963             push @sf, [ i => $text ] if $text;
964             for ( @{$field->subf} ) {
965             my ($letter, $value) = @$_;
966             if ( $letter eq 't') {
967             $value =~ s/\x{0088}//g;
968             $value =~ s/\x{0089}//g;
969             }
970             $letter = $letter eq '1' ? 'a' :
971             $letter eq '3' ? 'w' :
972             $letter eq 'v' ? 'g' :
973             $letter eq 'y' ? 'z' : $letter;
974             push @sf, [ $letter => $value ];
975             }
976             my $ind1 = $field->ind2 =~ /0/ ? 1 : 0;
977             $record->append( MARC::Moose::Field::Std->new(
978             tag => $to, ind1 => $ind1, ind2 =>$ind2, subf => \@sf ) );
979             }
980             }
981              
982             # 500 => 240 or 130
983             for my $field ( $unimarc->field('500|503|517|540|541') ) {
984             my ($ind1, $ind2) = ($field->ind1, $field->ind2);
985             my $tag = '240';
986             if ( $ind2 eq '0' ) {
987             $ind2 = 0;
988             }
989             elsif ( $ind2 eq '1' ) {
990             $tag = '130';
991             ($ind1, $ind2) = (0, ' ');
992             }
993             else {
994             ($ind1, $ind2) = (1, 0);
995             }
996             $record->append( MARC::Moose::Field::Std->new(
997             tag => $tag, ind1 => $ind1, ind2 => $ind2,
998             subf => $self->procedure_title($field->subf) ) );
999             }
1000              
1001             # 545 => 773, on passe t en a
1002             for my $field ( $unimarc->field('545') ) {
1003             $field->tag('773');
1004             $field->subf( [ grep { $_->[0] = 't' if $_->[0] eq 'a'; $_ } @{$field->subf} ] );
1005             $record->append( $field );
1006             }
1007              
1008             # 600 => 600
1009             # Suppr 6 et 7. f => d
1010             for my $field ( $unimarc->field('600') ) {
1011             my @names;
1012             my $date;
1013             # Skip $6 and $7
1014             my @sf;
1015             my $date_available = 0;
1016             SUBFIELD600:
1017             for ( @{$field->subf} ) {
1018             my ($letter, $value) = @$_;
1019             $value =~ s/^ *//; $value =~ s/ *$//;
1020             next unless $value;
1021             for ($letter) {
1022             if ( /6|7/ ) { next SUBFIELD600; }
1023             elsif ( /a|b/ ) { push @names, $value; next; }
1024             elsif ( /f/ ) { $date_available = 1; $letter = 'd'; }
1025             elsif ( /y/ ) { $letter = 'z'; }
1026             elsif ( /z/ ) { $letter = 'y'; }
1027             push @sf, [ $letter => $value ];
1028             }
1029             }
1030             my @sf_complete;
1031             my $notpushed = 1;
1032             for (@sf) {
1033             my ($letter, $value) = @$_;
1034             if ($letter gt 'a' && $notpushed) {
1035             push @sf_complete, [ a => join(', ', @names) . ($date_available ? ',' : '') ];
1036             $notpushed = 0;
1037             }
1038             push @sf_complete, $_;
1039             }
1040             $record->append( MARC::Moose::Field::Std->new(
1041             tag => '600', subf => \@sf_complete ) );
1042             }
1043              
1044             # 605 => 630 - 606 => 650 - 607 => 651 - 608 => 650
1045             # On conserve à leur place les lettres a x j (subdivision de forme)
1046             # On inverse y et z. et déplacée en v.
1047             # On suppr les $3
1048             for my $fromto ( ( [601, 650], [604, 600], [605, 630], [606, 650], [607, 651], [608, 650] ) ) {
1049             my ($from, $to) = @$fromto;
1050             for my $field ( $unimarc->field($from) ) {
1051             my @sf;
1052             for ( @{$field->subf} ) {
1053             my ($letter, $value) = @$_;
1054             $value =~ s/^ *//, $value =~ s/ *$//;
1055             next if $letter =~ /3/;
1056             if ( $letter eq 'j' ) {
1057             $letter = 'v';
1058             }
1059             elsif ( $letter eq 'y' ) {
1060             $letter = 'z';
1061             }
1062             elsif ( $letter eq 'z' ) {
1063             $letter = 'y';
1064             }
1065             push @sf, [ $letter => $value ];
1066             }
1067             next unless @sf;
1068             $sf[-1][1] = $sf[-1][1] . '.' if $sf[-1][1] !~ /\.$/;
1069             $record->append( MARC::Moose::Field::Std->new(
1070             tag => $to, subf => \@sf ) );
1071             }
1072             }
1073              
1074             # 675 => 080, $v and $z aren't converted
1075             for my $field ( $unimarc->field('675') ) {
1076             my @sf = grep { $_->[0] !~ /v|z/; } @{$field->subf};
1077             $record->append( MARC::Moose::Field::Std->new(
1078             tag => '080', subf => \@sf ) );
1079             }
1080              
1081             # 676 => 082, $v => $2
1082             for my $field ( $unimarc->field('676') ) {
1083             my @sf = map { $_->[0] = '2' if $_->[0] eq 'v'; $_; } @{$field->subf};
1084             $record->append( MARC::Moose::Field::Std->new(
1085             tag => '082', subf => \@sf ) );
1086             }
1087              
1088             # Les auteurs 700 => 100,
1089             # Suppr sous $3, $6 et $7 $9
1090             for my $fromto ( ( [700, 100], [701, 700], [702, 700] ) ) {
1091             my ($from, $to) = @$fromto;
1092             for my $field ( $unimarc->field($from) ) {
1093             my $ind1 = $field->ind2;
1094             my @sf;
1095             my @codes;
1096             for ( @{$field->subf} ) {
1097             my ($letter, $value) = @$_;
1098             for ($letter) {
1099             if ( /a/ ) {
1100             push @sf, [ a => $value ];
1101             }
1102             elsif ( /b/ ) {
1103             if ( @sf ) {
1104             $sf[-1]->[1] .= ", $value";
1105             }
1106             else {
1107             push @sf, [ a => $value ];
1108             }
1109             }
1110             elsif ( /c/ ) {
1111             $sf[-1]->[1] .= ',';
1112             push @sf, [ c => $value ];
1113             }
1114             elsif ( /d/ ) {
1115             push @sf, [ b => $value ];
1116             }
1117             elsif ( /f/ ) {
1118             $sf[-1]->[1] .= ',' if @sf;
1119             push @sf, [ d => $value ];
1120             }
1121             elsif ( /g/ ) {
1122             $sf[-1]->[1] .= '(';
1123             push @sf, [ q => "$value)" ];
1124             }
1125             elsif ( /4/ ) {
1126             next if $from eq '700' && $value eq '070';
1127             my $code = $authcode{$value};
1128             next unless $code;
1129             push @codes, $code->[0];
1130             }
1131             }
1132             }
1133             next unless @sf;
1134             my $value = $sf[-1]->[1];
1135             $value =~ s/ *$//;
1136             $value =~ s/\.*$//;
1137             $value .= '.' if $value !~ /[-\?]$/;
1138             $sf[-1]->[1] = $value;
1139             push @sf, [ 4 => $_ ] for @codes;
1140             $record->append( MARC::Moose::Field::Std->new(
1141             tag => $to, ind1 => $field->ind2, subf => \@sf ) );
1142             }
1143             }
1144              
1145             # Les collectivités
1146             # Suppr sous $3, $6 et $7 $9
1147             SUBFIELD_CORPORATE:
1148             for my $fromto ( ( [710, 110, 111], [711, 710, 711], [712, 710, 711] ) ) {
1149             my ($from, $to_corporate, $to_meeting) = @$fromto;
1150             for my $field ( $unimarc->field($from) ) {
1151             my @sf;
1152             my @codes;
1153             for ( @{$field->subf} ) {
1154             my ($letter, $value) = @$_;
1155             for ($letter) {
1156             if ( /a/ ) {
1157             push @sf, [ a => $value ];
1158             }
1159             elsif ( /g/ ) {
1160             $value = "($value)" unless $value =~ /^\(/;
1161             $sf[-1]->[1] .= " $value" if @sf;
1162             }
1163             elsif ( /h/ ) {
1164             $sf[-1]->[1] .= " $value";
1165             }
1166             elsif ( /g/ ) {
1167             $sf[-1]->[1] .= " ($value)";
1168             }
1169             elsif ( /b/ ) {
1170             if ( @sf ) {
1171             $sf[-1]->[1] .= '.' unless $sf[-1]->[1] =~ /\.$/;
1172             }
1173             push @sf, [ b => $value ];
1174             }
1175             elsif ( /d/ ) {
1176             $value = "($value" unless $value =~ /^\(/;
1177             push @sf, [ n => $value ];
1178             }
1179             elsif ( /e/ ) {
1180             $value = " :$value)";
1181             push @sf, [ c => $value ];
1182             }
1183             elsif ( /f/ ) {
1184             $value = $sf[-1]->[0] eq 'n'
1185             ? " :$value"
1186             : "($value" if @sf;
1187             push @sf, [ d => $value ];
1188             }
1189             elsif ( /4/ ) {
1190             next SUBFIELD_CORPORATE if $from eq '700' && $value eq '070';
1191             my $code = $authcode{$value};
1192             next SUBFIELD_CORPORATE unless $code;
1193             push @codes, $code->[0];
1194             }
1195             }
1196             }
1197             next unless @sf;
1198             my $value = $sf[-1]->[1];
1199             $value =~ s/ *$//;
1200             $value =~ s/\.*$//;
1201             $value .= '.';
1202             $sf[-1]->[1] = $value;
1203             push @sf, [ 4 => $_ ] for @codes;
1204             my $to = $field->ind1 eq '1' ? $to_meeting : $to_corporate;
1205             $record->append( MARC::Moose::Field::Std->new(
1206             tag => $to, ind1 => $field->ind2, subf => \@sf ) );
1207             }
1208             }
1209              
1210             # Populate non-filing indicator based on UNIMARC NSB/NSE
1211             {
1212             my $first = 1;
1213             for my $tags (@$nonfiling_tags) {
1214             for my $tag (@$tags) {
1215             for my $field ($record->field($tag)) {
1216             for (@{$field->subf}) {
1217             next if $_->[0] ne 'a';
1218             # Found Main title
1219             my $title = $_->[1];
1220             next unless $title;
1221             for my $ns (@$ns_characters) {
1222             my ($nsb, $nse) = @$ns;
1223             next if $title !~ /^$nsb(.*)$nse(.)/;
1224             my $len = length($1);
1225             $len++ if $2 eq ' ';
1226             $len = 0 if $len >= 10;
1227             $title =~ s/$nsb//g;
1228             $title =~ s/$nse//g;
1229             $_->[1] = $title;
1230             if ($first) { $field->ind1($len); }
1231             else { $field->ind2($len); }
1232             last;
1233             }
1234             last;
1235             }
1236             }
1237             }
1238             $first = 0;
1239             }
1240             }
1241              
1242             # Some fields are kept, as they are: 856, 801, 9xx
1243             if ( my @fields = $unimarc->field('801|856|9..') ) {
1244             $record->append(@fields)
1245             }
1246              
1247             # Clean non-filing characters in all fields
1248             for my $field (@{$record->fields}) {
1249             next if ref $field eq 'MARC::Moose::Field::Control';
1250             for (@{$field->subf} ) {
1251             next if $_->[0] !~ /[a-z0-9]/;
1252             $_->[1] =~ s/\x08|\x09//g;
1253             }
1254             }
1255              
1256             return $record;
1257             };
1258              
1259             __PACKAGE__->meta->make_immutable;
1260              
1261             1;
1262              
1263             __END__
1264              
1265             =pod
1266              
1267             =encoding UTF-8
1268              
1269             =head1 NAME
1270              
1271             MARC::Moose::Formater::UnimarcToMarc21 - Convert biblio record from UNIMARC to MARC21
1272              
1273             =head1 VERSION
1274              
1275             version 1.0.45
1276              
1277             =head1 SYNOPSYS
1278              
1279             Read a UNIMARC ISO2709 file and dump it to STDOUT in text transformed into
1280             MARC21:
1281              
1282             my $reader = MARC::Moose::Reader::File::Iso2709->new(
1283             file => 'biblio-unimarc.iso' );
1284             my $formater = MARC::Moose::Formater::UnimarcToMarc21->new();
1285             while ( my $unimarc = $reader->read() ) {
1286             my $marc21 = $formater->format($unimarc);
1287             print $marc21->as('Text');
1288             }
1289              
1290             Same with shortcut:
1291              
1292             my $reader = MARC::Moose::Reader::File::Iso2709->new(
1293             file => 'biblio-unimarc.iso' );
1294             while ( my $unimarc = $reader->read() ) {
1295             print $unimarc->as('UnimarcToMarc21')->as('Text');
1296             }
1297              
1298             Read a UNIMARC ISO2709 file and dump it to another ISO2709 file transformed
1299             into MARC21:
1300              
1301             my $reader = MARC::Moose::Reader::File::Iso2709->new(
1302             file => 'biblio-unimarc.iso' );
1303             my $writer = MARC::Moose::Writer->new(
1304             fh => IO::File->new('koha.mrc', '>:encoding(utf8)'),
1305             formater => MARC::Moose::Formater::Iso2709->new() )
1306             );
1307             my $tomarc21 = MARC::Moose::Formater::UnimarcToMarc21->new();
1308             while ( my $unimarc = $reader->read() ) {
1309             $writer->write( $tomarc21->format($unimarc) );
1310             }
1311              
1312             =head1 COMMAND LINE
1313              
1314             If you don't want to write a Perl script, you can use the L<marcmoose> command.
1315             This way, you can for example convert a ISO 2709 UNIMARC file named
1316             C<unimarc.iso> into a ISO 2709 MARC21 file named C<marc.iso>:
1317              
1318             marcmoose --parser iso2709 --formater iso2709 --converter unimarctomarc21
1319             --output marc.iso unimarc.iso
1320              
1321             =head1 AUTHOR
1322              
1323             Frédéric Demians <f.demians@tamil.fr>
1324              
1325             =head1 COPYRIGHT AND LICENSE
1326              
1327             This software is copyright (c) 2022 by Frédéric Demians.
1328              
1329             This is free software; you can redistribute it and/or modify it under
1330             the same terms as the Perl 5 programming language system itself.
1331              
1332             =cut