package MARC::Moose::Formater::UnimarcToMarc21; $MARC::Moose::Formater::UnimarcToMarc21::VERSION = '1.0.46'; # ABSTRACT: Convert biblio record from UNIMARC to MARC21 use Moose; use 5.010; use utf8; extends 'MARC::Moose::Formater'; use List::Util qw/ first /; use MARC::Moose::Field::Control; use MARC::Moose::Field::Std; # Equivalence UNIMARC author type code > MARC21 # Each UNIMARC code points to a array ref which first entry contains MARC21 # code and second MARC21 author type description. The second entry isn't used # yet. my %authcode = map { /^(\d*) (\w*) (.*)$/; $1 => [$2, $3] } split /\n/, < $2; } split /\n/, < $2; } split /\n/, <[0] eq $letter } @equivals ) { my ($from, $to, $sep) = @$equival; if ( $sep && @sf ) { my $match = $sep; $match = '\.' if $match eq '.'; if ( $sf[-1]->[0] !~ /$match$/ ) { $sf[-1]->[1] .= $sep; } } push @sf, [ $to => $value ]; } else { for ($letter) { if ( /e/ ) { next unless @sf; #FIXME warning required if ( $sf[-1][0] =~ /a|n|p/ ) { $sf[-1]->[1] .= ' :'; push @sf, [ b => $value ]; } else { $sf[-1]->[1] .= " : $value"; } } elsif ( /i/ ) { if ( @sf ) { if ( $sf[-1]->[0] eq 'h' ) { $sf[-1]->[1] .= ',' if $sf[-1]->[1] !~ /,$/; } else { $sf[-1]->[1] .= '.'; } } push @sf, [ p => $value ]; } } } } return \@sf; } override 'format' => sub { my ($self, $unimarc) = @_; my $record = MARC::Moose::Record->new(); $record->_leader(" nam a22 7a 4500"); my $code008 = '120130t xxu||||| |||| 00| 0 ||| d'; my @sf040; # 001 => 001 for my $field ( $unimarc->field('001' ) ) { $record->append($field->clone()); } # ISBN 010 => 020 for my $field ( $unimarc->field('010') ) { my @sf; for ( @{$field->subf} ) { my ($letter, $value) = @$_; for ($letter) { if ( /a|z/ ) { $value =~ s/-//g; push @sf, [ $letter => $value ]; } elsif ( /b/ ) { $value = "($value)" unless $value =~ /^\(/; if (@sf) { $sf[-1]->[1] .= " $value"; } else { push @sf, [ c => $value ]; } } elsif ( /d/ ) { if (@sf) { $sf[-1]->[1] .= " :"; } push @sf, [ c => $value ]; } } } $record->append( MARC::Moose::Field::Std->new( tag => '020', subf => \@sf ) ); } # ISSN 011 => 022 # Except 011$b$d => 365 for my $field ( $unimarc->field('011') ) { my (@sf, @price); for ( @{$field->subf} ) { my ($letter, $value) = @$_; for ($letter) { if ( /a/ ) { $value =~ s/-//g; push @sf, [ a => $value ]; } elsif ( /z/ ) { $value =~ s/-//g; push @sf, [ y => $value ]; } elsif ( /b|d/ ) { $value = "($value)" unless $value =~ /^\(/; my $newlet = $letter eq 'b' ? 'b' : 'd'; push @price, [ $newlet => $value ]; } } } $record->append( MARC::Moose::Field::Std->new( tag => '022', subf => \@sf ) ) if @sf; $record->append(MARC::Moose::Field::Std->new( tag => '365', subf => \@price ) ) if @price; } # EAN 076 => 024. Get only $a subfield for my $field ( $unimarc->field('073') ) { my $value = $field->subfield('a'); next unless $value; $record->append( MARC::Moose::Field::Std->new( tag => '024', subf => [ [ a => $value ] ] ) ); } # 100 => 008 if ( my $field = $unimarc->field('100') ) { my $code100 = $field->subfield('a'); if ( $code100 && length($code100) > 20 ) { # Date entered on file substr $code008, 0, 6, substr($code100, 2, 6); # Type of publication date my $value = substr($code100, 8, 1); $value = $typeofpub{$value} || ' '; substr $code008, 6, 1, $value; # Date 1 $value = substr($code100, 9, 4); if ( 1 ) { #FIXME Determine if it's a serials # Not serials my $count = 0; for ( split //, $value ) { $count++ if / /; } $value =~ s/ /0/g if $count <= 3; } else { # A serials $value =~ s/ /u/g; } substr $code008, 7, 4, $value; # Date 2 $value = substr($code100, 13, 4); if ( 1 ) { #FIXME Determine if it's a serials # Not serials my $count = 0; for ( split //, $value ) { $count++ if / /; } $value =~ s/ /0/g if $count <= 3; } else { # A serials $value =~ s/ /u/g; } substr $code008, 11, 4, $value; # 3 positions for target audience $value = substr($code100, 17, 3); for (my $i=0; $i < 3; $i++) { $value = substr($code100, 17+$i, 1); $value = $target_audience{$value} || ' '; substr $code008, 17+$i, 1, $value; } # Language of cataloging push @sf040, [ b => substr($code100, 22, 3) ]; # Alphabet of title, converted if serials # FIXME if ( 0 ) { substrr $code008, 33, 1, substr($code100,34,1); } } } # Language 101 => 041 and 008 if ( my $field = $unimarc->field('101') ) { # FIXME: à virer if ( ref($field) eq 'MARC::Moose::Field::Control' ) { say $unimarc->as('Text'); exit; } my @all = @{$field->subf}; my $count_a = 0; my (@sf, @sf_b); for (@all) { my ($letter, $value) = @$_; for ($letter) { if ( /a/ ) { next if $count_a >= 6; $count_a++; if ( $count_a == 1 ) { $value .= ' '; $value = substr($value, 0, 3); substr $code008, 35, 3, $value; } push @sf, [ a => $value]; } elsif ( /c/ ) { push @sf, [ h => $value ]; } elsif ( /b/ ) { push @sf_b, $value; } elsif ( /d/ ) { push @sf, [ b => $value ]; } elsif ( /e/ ) { push @sf, [ f => $value ]; } elsif ( /f|g/ ) { } elsif ( /j/ ) { push @sf, [ b => $value ]; } elsif ( /h/ ) { push @sf, [ e => $value ]; } elsif ( /i/ ) { push @sf, [ g => $value ]; } } } if ( @sf_b ) { for ( @sf ) { if ($_->[0] eq 'h') { $_->[1] .= ' ' . join(' ', @sf_b); last; } } } my $ind1 = $field->ind1; $ind1 = '0' if $ind1 eq ' '; $ind1 = '1' if $ind1 eq '2'; $record->append( MARC::Moose::Field::Std->new( tag => '041', ind1 => $ind1, subf => \@sf ) ); } else { substr($code008, 35, 3) = '|||'; } # 125 => 008 # FIXME: 125$b isn't handled at all if ( my $field = $unimarc->field('125') ) { my $value = $field->subfield('a'); my ($pos0, $pos1); $pos0 = substr($value, 0, 1) if $value && length($value) >= 1; $pos1 = substr($value, 1, 1) if $value && length($value) >= 2; $pos0 ||= '|'; $pos0 = 'n' if $pos0 eq 'x'; $pos1 ||= '|'; $pos1 = 'n' if $pos1 eq 'x'; $pos1 = ' ' if $pos1 eq 'y'; substr($code008, 20, 2) = $pos0 . $pos1; } $record->append( MARC::Moose::Field::Control->new( tag => '008', value => $code008 ) ); # Title for my $field ( $unimarc->field('200') ) { my @sf; my ($a_index, $h_index) = (-1, -1); SUBFIELD200: for ( @{$field->subf} ) { my ($letter, $value) = @$_; for ($letter) { if ( /a/ ) { if ( $a_index == -1 ) { push @sf, [ a => $value ]; $a_index = $#sf; } else { $sf[$a_index]->[1] .= " ; $value"; } } elsif ( /b/) { if ( $h_index == -1 ) { push @sf, [ h => $value ]; $h_index = $#sf; } else { if ( $#sf == $h_index ) { $sf[$h_index]->[1] .= " + $value"; } else { $sf[-1]->[1] .= " ($value)"; } } } elsif ( /c/ ) { next SUBFIELD200 unless @sf; #FIXME warning required $sf[-1]->[1] .= ". $value"; } elsif ( /d/ ) { next SUBFIELD200 unless @sf; #FIXME warning required if ( $sf[-1]->[0] =~ /a|n|p/ ) { $sf[-1]->[1] .= ' ='; $value =~ s/^= //; push @sf, [ b => $value ]; } else { $sf[-1]->[1] .= " = $value"; } } elsif ( /e/ ) { next SUBFIELD200 unless @sf; #FIXME warning required if ( $sf[-1]->[0] =~ /a|n|p/ ) { $sf[-1]->[1] .= ' :'; push @sf, [ b => $value ]; } else { $sf[-1]->[1] .= " : $value"; } } elsif ( /f/) { next SUBFIELD200 unless @sf; #FIXME warning required if ( $sf[-1]->[0] =~ /a|b|n|p/ ) { $sf[-1]->[1] .= ' /'; push @sf, [ c => $value ]; } else { $sf[-1]->[1] .= " / $value"; } } elsif ( /g/) { next SUBFIELD200 unless @sf; #FIXME warning required $sf[-1]->[1] .= " ; $value"; } elsif ( /h/ ) { next SUBFIELD200 unless @sf; #FIXME warning required if ( $sf[-1]->[0] =~ /a|n|p/ ) { $sf[-1]->[1] .= '.'; push @sf, [ n => $value ]; } else { #$sf[-1]->[1] .= ". $value"; push @sf, [ n => $value ]; } } elsif ( /i/ ) { next SUBFIELD200 unless @sf; #FIXME warning required if ( @sf && $sf[-1]->[0] =~ /a|n|p/ ) { $sf[-1]->[1] .= ','; push @sf, [ p => $value ]; } else { $sf[-1]->[1] .= ". $value"; } } elsif ( /v|z|5|6|7/ ) { next SUBFIELD200 } } } next unless @sf; $sf[$h_index]->[1] = '[' . $sf[$h_index]->[1] . ']' unless $h_index == -1; # Point final if (@sf) { my $last_value = $sf[-1][1]; my $last_char = substr($last_value, length($last_value)-1); $sf[-1][1] = "$last_value." if $last_char !~ /[.?,;:]/; } # Indicators my ($ind1, $ind2) = ($field->ind1, 0); for ($ind1) { if ( /0/ ) { } elsif ( /1/ ) { #FIXME Test marc21 100/110/111/130 presence $ind1 = $unimarc->field('700|710' ) ? 1 : 0; } else { $ind1 = 1; } } $record->append( MARC::Moose::Field::Std->new( tag => '245', ind1 => $ind1, ind2 => $ind2, subf => \@sf ) ); } # TODO 204 # 205 => 250 for my $field ($unimarc->field('205') ) { my @sf; my ($a_index, $b_index) = (-1, -1); for ( @{$field->subf} ) { my ($letter, $value) = @$_; for ($letter) { if ( /a/ ) { if ( $a_index == -1 ) { push @sf, [ a => $value ]; $a_index = $#sf; } else { $sf[$a_index]->[1] .= ", $value"; } } elsif ( /b/ ) { if ( @sf ) { $sf[-1]->[1] .= ", $value"; } else { push @sf, [ a => $value ]; $a_index = $#sf; } } elsif ( /d/ ) { if ( $b_index == -1 ) { push @sf, [ b => $value]; $b_index = $#sf; } else { $sf[-1]->[1] .= " $value"; } } elsif ( /f/ ) { if ( $b_index == -1 ) { $sf[-1]->[1] .= " / " if @sf; push @sf, [ b => $value]; $b_index = $#sf; } else { $sf[-1]->[1] .= " / $value"; } } elsif ( /g/ ) { if ( @sf ) { $sf[-1]->[1] .= " / $value"; } else { push @sf, [ a => $value ] } } } } next unless @sf; if ( $b_index >= 1 ) { my $value = $sf[$b_index]->[1]; if ( $value =~ /= $/ ) { $value =~ s/= $//; $sf[$b_index]->[1] = $value; $sf[$b_index-1]->[1] .= '= '; } } # Point final $sf[-1][1] = $sf[-1][1] . '.' if @sf && $sf[-1][1] !~ /\.$/; $record->append( MARC::Moose::Field::Std->new( tag => '250', ind1 => $field->ind1, ind2 => $field->ind2, subf => \@sf ) ); } # TODO 206 # 207 => 362 for my $field ($unimarc->field('207') ) { my @sf; my $a_index = -1; for ( @{$field->subf} ) { my ($letter, $value) = @$_; for ($letter) { if ( /a/ ) { if ( $a_index == -1 ) { push @sf, [ a => $value ]; $a_index = $#sf; } else { my $prev = $sf[$a_index]->[1]; $prev =~ s/ *$//; $prev =~ s/;$//; $prev =~ s/ *$//; $sf[$a_index]->[1] = "$prev ; $value"; } } elsif ( /v/ ) { push @sf, [ z => $value ]; } } } next unless @sf; # Point at the end $sf[-1][1] = $sf[-1][1] . '.' if @sf && $sf[-1][1] !~ /\.$/; $record->append( MARC::Moose::Field::Std->new( tag => '362', ind2 => $field->ind1, subf => \@sf ) ); } #TODO 208 # 210/214 => 260 for my $field ( $unimarc->field('210|214') ) { my @sf; for ( @{$field->subf} ) { my ($letter, $value) = @$_; $value =~ s/^ *//, $value =~ s/ *$//; my %found; for ($letter) { if ( /a/ ) { push @sf, [ a => $value ]; } elsif ( /b/ ) { $value = "($value)" if $value !~ /^\(/; if ( @sf ) { $sf[-1]->[1] .= " $value"; } else { push @sf, [ a => $value ]; } } elsif ( /c/ ) { push @sf, [ b => $value ]; } elsif ( /d/ ) { push @sf, [ c => $value ]; } elsif ( /e/ ) { push @sf, [ e => $value ]; } elsif ( /f/ ) { unless ( $found{$letter} ) { $found{$letter} = 1; $sf[-1]->[1] .= ", $value" if @sf; } } elsif ( /g/ ) { unless ( $found{$letter} ) { $found{$letter} = 1; push @sf, [ f => $value ]; } } elsif ( /h/ ) { unless ( $found{$letter} ) { $found{$letter} = 1; push @sf, [ g => $value ]; } } elsif ( /j/ ) { $record->append( MARC::Moose::Field::Std->new( tag => '265', subf => [ a => $value ] ) ); } elsif ( /k/ ) { $record->append( MARC::Moose::Field::Std->new( tag => '265', ind1 => '0', ind2 => '0', subf => [ a => $value ] ) ); } elsif ( /l/ ) { $record->append( MARC::Moose::Field::Std->new( tag => '265', ind1 => '1', ind2 => '0', subf => [ [ a => $value ] ] ) ); } elsif ( /m/ ) { $record->append( MARC::Moose::Field::Std->new( tag => '265', ind1 => '2', ind2 => '0', subf => [ a => $value ] ) ); } } } next unless @sf; # Ponctuation for (my $i=0; $i < @sf; $i++) { my ($letter, $value) = @{$sf[$i]}; for ($letter) { if ( /a/ ) { $sf[$i-1]->[1] .= ' ;' if $i; } elsif ( /b|f/ ) { $sf[$i-1]->[1] .= ' :' if $i; } elsif ( /c|g/ ) { $sf[$i-1]->[1] .= ',' if $i; } } $value = "($value)" if $letter =~ /e|f|g/; if ( $value =~ /^= / ) { $value =~ s/^= //; $sf[$i-1]->[1] .= ' =' if $i; } $sf[$i]->[1] = $value; } $sf[-1][1] = $sf[-1][1] . '.' if @sf && $sf[-1][1] !~ /\.$/; $record->append( MARC::Moose::Field::Std->new( tag => '260', subf => \@sf ) ); } # TODO 211 => 263 # 215 => 300 for my $field ( $unimarc->field('215') ) { my @sf; SUBFIELD215: for ( @{$field->subf} ) { my ($letter, $value) = @$_; $value =~ s/^ *//, $value =~ s/ *$//; for ($letter) { if ( /c/ ) { $letter = 'b'; } elsif ( /d/ ) { $letter = 'c'; } elsif ( /6|7/ ) { next SUBFIELD215; } } push @sf, [ $letter => $value ]; } next unless @sf; # Ponctuation for (my $i=1; $i < @sf; $i++) { my ($letter, $value) = @{$sf[$i]}; for ($letter) { if ( /b/ ) { $sf[$i-1]->[1] .= ' :'; } elsif ( /c/ ) { $sf[$i-1]->[1] .= ' ;'; } elsif ( /e/ ) { $sf[$i-1]->[1] .= ' + '; } } } $sf[-1][1] = $sf[-1][1] . '.' if $sf[-1][1] !~ /\.$/; $record->append( MARC::Moose::Field::Std->new( tag => '300', subf => \@sf ) ); } # 225 => 490 for my $field ( $unimarc->field('225') ) { my (@sf, @a, @vx); my $prev_letter = ''; for ( @{$field->subf} ) { my ($letter, $value) = @$_; $value =~ s/^ *//, $value =~ s/ *$//; $value =~ s/\x88//g, $value =~ s/\x89//; for ($letter) { if ( /a/ ) { push @a, $value; } elsif ( /d/ ) { push @a, " = $value" } elsif ( /e/ ) { push @a, " : $value" } elsif ( /f/ ) { push @a, " / $value" } elsif ( /h/ ) { push @a, ". $value" } elsif ( /i/ ) { push @a, $prev_letter eq 'h' ? ", $value " : ". $value"; } elsif ( /v|x/ ) { push @vx, [ $letter => $value ] } } $prev_letter = $letter; } next unless @a; push @sf, [ a => join('', @a) ]; push @sf, @vx; $record->append( MARC::Moose::Field::Std->new( tag => '490', ind1 => $field->ind1 =~ /0|2/ ? 1 : 0, subf => \@sf ) ); } # 230 => 256 for my $field ( $unimarc->field('230') ) { $record->append($field->clone('256')); } # Unchanged fields for my $fromto ( @unchanged ) { my ($from, $to) = @$fromto; for my $field ( $unimarc->field($from) ) { $record->append($field->clone($to)); } } # 325 => 533 for my $field ( $unimarc->field('325') ) { $record->append( MARC::Moose::Field::Std->new( tag => '533', subf => [ [ n => $field->subfield('a') ] ] ) ); } # 326 => 533 for my $field ( $unimarc->field('326') ) { # FIXME Should be done depending on biblio record type: # MAP, SERIALS my $type = 'SERIALS'; my $new_field; if ( $type =~ /SERIALS/ ) { $new_field = $field->clone('310'); } $record->append($new_field); } # 327 => 505 for my $field ( $unimarc->field('327') ) { my $ind1 = $field->ind1; $ind1 = 0 if $ind1 =~ /1/; $ind1 = 1 if $ind1 =~ /0/; my @a = map { $_->[1] } @{$field->subf}; $record->append( MARC::Moose::Field::Std->new( tag => '505', ind1 => $ind1, subf => [ [ a => join(' ', @a) ] ] ) ); } # 329 => 505 # This is French (CCfr) specific field without equivalent in MARC21 # Concatained into 505 field for my $field ( $unimarc->field('359') ) { my @a = map { $_->[1] } @{$field->subf}; $record->append( MARC::Moose::Field::Std->new( tag => '505', ind1 => '0', subf => [ [ a => join(' -- ', @a) ] ] ) ); } # 336 => 500 for my $field ( $unimarc->field('336') ) { $record->append( MARC::Moose::Field::Std->new( tag => '500', subf => [ [ a => 'Type of computer file: ' . $field->subfield('a') ] ] ) ); } # 345 => 037 for my $field ( $unimarc->field('345') ) { my @sf; for ( @{$field->subf} ) { my ($letter, $value) = @$_; $letter = $letter eq 'a' ? 'b' : $letter eq 'b' ? 'a' : $letter eq 'c' ? 'f' : $letter eq 'd' ? 'c' : $letter; push @sf, [ $letter => $value ]; } $record->append( MARC::Moose::Field::Std->new( tag => '037', subf => \@sf ) ); } # TODO 410 411 421 422 423 430 431 432 433 434 435 436 437 440 441 442 443 # 444 445 446 447 448 451 452 453 # 454 => 765 for my $ft ( ( [410, 760], [411, 762], [421, 770], [422, 772], [423, 777], [430, 780, 0], [431, 780, 1], [432, 780, 2], [433, 780, 3], [434, 780, 5], [435, 780, 6], [436, 780, 4], [437, 780, 7], [440, 785, 0], [441, 785, 1], [442, 785, 2], [443, 785, 3], [444, 785, 4], [445, 785, 5], [446, 785, 6], [447, 785, 7], [448, 785, 8], [451, 775], [452, 776], [453, 767], [454, 765], [455, 787, 8, 'Reproduction of:'], [456, 787, 8, 'Reproduced as:'], [461, 773], [462, 774], [463, 773], [464, 774], [470, 787, 8, 'Item reviewed:'], [488, 787, 8, 'Reproduced as:'], [491, 774], [492, 774], [493, 773], [494, 773], ) ) { my ($from, $to, $ind2, $text) = @$ft; $ind2 = ' ' unless $ind2; for my $field ( $unimarc->field($from) ) { my @sf; push @sf, [ i => $text ] if $text; for ( @{$field->subf} ) { my ($letter, $value) = @$_; if ( $letter eq 't') { $value =~ s/\x{0088}//g; $value =~ s/\x{0089}//g; } $letter = $letter eq '1' ? 'a' : $letter eq '3' ? 'w' : $letter eq 'v' ? 'g' : $letter eq 'y' ? 'z' : $letter; push @sf, [ $letter => $value ]; } my $ind1 = $field->ind2 =~ /0/ ? 1 : 0; $record->append( MARC::Moose::Field::Std->new( tag => $to, ind1 => $ind1, ind2 =>$ind2, subf => \@sf ) ); } } # 500 => 240 or 130 for my $field ( $unimarc->field('500|503|517|540|541') ) { my ($ind1, $ind2) = ($field->ind1, $field->ind2); my $tag = '240'; if ( $ind2 eq '0' ) { $ind2 = 0; } elsif ( $ind2 eq '1' ) { $tag = '130'; ($ind1, $ind2) = (0, ' '); } else { ($ind1, $ind2) = (1, 0); } $record->append( MARC::Moose::Field::Std->new( tag => $tag, ind1 => $ind1, ind2 => $ind2, subf => $self->procedure_title($field->subf) ) ); } # 545 => 773, on passe t en a for my $field ( $unimarc->field('545') ) { $field->tag('773'); $field->subf( [ grep { $_->[0] = 't' if $_->[0] eq 'a'; $_ } @{$field->subf} ] ); $record->append( $field ); } # 600 => 600 # Suppr 6 et 7. f => d for my $field ( $unimarc->field('600') ) { my @names; my $date; # Skip $6 and $7 my @sf; my $date_available = 0; SUBFIELD600: for ( @{$field->subf} ) { my ($letter, $value) = @$_; $value =~ s/^ *//; $value =~ s/ *$//; next unless $value; for ($letter) { if ( /6|7/ ) { next SUBFIELD600; } elsif ( /a|b/ ) { push @names, $value; next; } elsif ( /f/ ) { $date_available = 1; $letter = 'd'; } elsif ( /y/ ) { $letter = 'z'; } elsif ( /z/ ) { $letter = 'y'; } push @sf, [ $letter => $value ]; } } my @sf_complete; my $notpushed = 1; for (@sf) { my ($letter, $value) = @$_; if ($letter gt 'a' && $notpushed) { push @sf_complete, [ a => join(', ', @names) . ($date_available ? ',' : '') ]; $notpushed = 0; } push @sf_complete, $_; } $record->append( MARC::Moose::Field::Std->new( tag => '600', subf => \@sf_complete ) ); } # 605 => 630 - 606 => 650 - 607 => 651 - 608 => 650 # On conserve à leur place les lettres a x j (subdivision de forme) # On inverse y et z. et déplacée en v. # On suppr les $3 for my $fromto ( ( [601, 650], [604, 600], [605, 630], [606, 650], [607, 651], [608, 650] ) ) { my ($from, $to) = @$fromto; for my $field ( $unimarc->field($from) ) { my @sf; for ( @{$field->subf} ) { my ($letter, $value) = @$_; $value =~ s/^ *//, $value =~ s/ *$//; next if $letter =~ /3/; if ( $letter eq 'j' ) { $letter = 'v'; } elsif ( $letter eq 'y' ) { $letter = 'z'; } elsif ( $letter eq 'z' ) { $letter = 'y'; } push @sf, [ $letter => $value ]; } next unless @sf; $sf[-1][1] = $sf[-1][1] . '.' if $sf[-1][1] !~ /\.$/; $record->append( MARC::Moose::Field::Std->new( tag => $to, subf => \@sf ) ); } } # 675 => 080, $v and $z aren't converted for my $field ( $unimarc->field('675') ) { my @sf = grep { $_->[0] !~ /v|z/; } @{$field->subf}; $record->append( MARC::Moose::Field::Std->new( tag => '080', subf => \@sf ) ); } # 676 => 082, $v => $2 for my $field ( $unimarc->field('676') ) { my @sf = map { $_->[0] = '2' if $_->[0] eq 'v'; $_; } @{$field->subf}; $record->append( MARC::Moose::Field::Std->new( tag => '082', subf => \@sf ) ); } # Les auteurs 700 => 100, # Suppr sous $3, $6 et $7 $9 for my $fromto ( ( [700, 100], [701, 700], [702, 700] ) ) { my ($from, $to) = @$fromto; for my $field ( $unimarc->field($from) ) { my $ind1 = $field->ind2; my @sf; my @codes; for ( @{$field->subf} ) { my ($letter, $value) = @$_; for ($letter) { if ( /a/ ) { push @sf, [ a => $value ]; } elsif ( /b/ ) { if ( @sf ) { $sf[-1]->[1] .= ", $value"; } else { push @sf, [ a => $value ]; } } elsif ( /c/ ) { $sf[-1]->[1] .= ','; push @sf, [ c => $value ]; } elsif ( /d/ ) { push @sf, [ b => $value ]; } elsif ( /f/ ) { $sf[-1]->[1] .= ',' if @sf; push @sf, [ d => $value ]; } elsif ( /g/ ) { $sf[-1]->[1] .= '('; push @sf, [ q => "$value)" ]; } elsif ( /4/ ) { next if $from eq '700' && $value eq '070'; my $code = $authcode{$value}; next unless $code; push @codes, $code->[0]; } } } next unless @sf; my $value = $sf[-1]->[1]; $value =~ s/ *$//; $value =~ s/\.*$//; $value .= '.' if $value !~ /[-\?]$/; $sf[-1]->[1] = $value; push @sf, [ 4 => $_ ] for @codes; $record->append( MARC::Moose::Field::Std->new( tag => $to, ind1 => $field->ind2, subf => \@sf ) ); } } # Les collectivités # Suppr sous $3, $6 et $7 $9 SUBFIELD_CORPORATE: for my $fromto ( ( [710, 110, 111], [711, 710, 711], [712, 710, 711] ) ) { my ($from, $to_corporate, $to_meeting) = @$fromto; for my $field ( $unimarc->field($from) ) { my @sf; my @codes; for ( @{$field->subf} ) { my ($letter, $value) = @$_; for ($letter) { if ( /a/ ) { push @sf, [ a => $value ]; } elsif ( /g/ ) { $value = "($value)" unless $value =~ /^\(/; $sf[-1]->[1] .= " $value" if @sf; } elsif ( /h/ ) { $sf[-1]->[1] .= " $value"; } elsif ( /g/ ) { $sf[-1]->[1] .= " ($value)"; } elsif ( /b/ ) { if ( @sf ) { $sf[-1]->[1] .= '.' unless $sf[-1]->[1] =~ /\.$/; } push @sf, [ b => $value ]; } elsif ( /d/ ) { $value = "($value" unless $value =~ /^\(/; push @sf, [ n => $value ]; } elsif ( /e/ ) { $value = " :$value)"; push @sf, [ c => $value ]; } elsif ( /f/ ) { $value = $sf[-1]->[0] eq 'n' ? " :$value" : "($value" if @sf; push @sf, [ d => $value ]; } elsif ( /4/ ) { next SUBFIELD_CORPORATE if $from eq '700' && $value eq '070'; my $code = $authcode{$value}; next SUBFIELD_CORPORATE unless $code; push @codes, $code->[0]; } } } next unless @sf; my $value = $sf[-1]->[1]; $value =~ s/ *$//; $value =~ s/\.*$//; $value .= '.'; $sf[-1]->[1] = $value; push @sf, [ 4 => $_ ] for @codes; my $to = $field->ind1 eq '1' ? $to_meeting : $to_corporate; $record->append( MARC::Moose::Field::Std->new( tag => $to, ind1 => $field->ind2, subf => \@sf ) ); } } # Populate non-filing indicator based on UNIMARC NSB/NSE { my $first = 1; for my $tags (@$nonfiling_tags) { for my $tag (@$tags) { for my $field ($record->field($tag)) { for (@{$field->subf}) { next if $_->[0] ne 'a'; # Found Main title my $title = $_->[1]; next unless $title; for my $ns (@$ns_characters) { my ($nsb, $nse) = @$ns; next if $title !~ /^$nsb(.*)$nse(.)/; my $len = length($1); $len++ if $2 eq ' '; $len = 0 if $len >= 10; $title =~ s/$nsb//g; $title =~ s/$nse//g; $_->[1] = $title; if ($first) { $field->ind1($len); } else { $field->ind2($len); } last; } last; } } } $first = 0; } } # Some fields are kept, as they are: 856, 801, 9xx if ( my @fields = $unimarc->field('801|856|9..') ) { $record->append(@fields) } # Clean non-filing characters in all fields for my $field (@{$record->fields}) { next if ref $field eq 'MARC::Moose::Field::Control'; for (@{$field->subf} ) { next if $_->[0] !~ /[a-z0-9]/; $_->[1] =~ s/\x08|\x09//g; } } return $record; }; __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME MARC::Moose::Formater::UnimarcToMarc21 - Convert biblio record from UNIMARC to MARC21 =head1 VERSION version 1.0.46 =head1 SYNOPSYS Read a UNIMARC ISO2709 file and dump it to STDOUT in text transformed into MARC21: my $reader = MARC::Moose::Reader::File::Iso2709->new( file => 'biblio-unimarc.iso' ); my $formater = MARC::Moose::Formater::UnimarcToMarc21->new(); while ( my $unimarc = $reader->read() ) { my $marc21 = $formater->format($unimarc); print $marc21->as('Text'); } Same with shortcut: my $reader = MARC::Moose::Reader::File::Iso2709->new( file => 'biblio-unimarc.iso' ); while ( my $unimarc = $reader->read() ) { print $unimarc->as('UnimarcToMarc21')->as('Text'); } Read a UNIMARC ISO2709 file and dump it to another ISO2709 file transformed into MARC21: my $reader = MARC::Moose::Reader::File::Iso2709->new( file => 'biblio-unimarc.iso' ); my $writer = MARC::Moose::Writer->new( fh => IO::File->new('koha.mrc', '>:encoding(utf8)'), formater => MARC::Moose::Formater::Iso2709->new() ) ); my $tomarc21 = MARC::Moose::Formater::UnimarcToMarc21->new(); while ( my $unimarc = $reader->read() ) { $writer->write( $tomarc21->format($unimarc) ); } =head1 COMMAND LINE If you don't want to write a Perl script, you can use the L command. This way, you can for example convert a ISO 2709 UNIMARC file named C into a ISO 2709 MARC21 file named C: marcmoose --parser iso2709 --formater iso2709 --converter unimarctomarc21 --output marc.iso unimarc.iso =head1 AUTHOR Frédéric Demians =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2022 by Frédéric Demians. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut