line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Catmandu::AlephX::Metadata::MARC::Aleph; |
2
|
3
|
|
|
3
|
|
105071
|
use Catmandu::Sane; |
|
3
|
|
|
|
|
195428
|
|
|
3
|
|
|
|
|
21
|
|
3
|
3
|
|
|
3
|
|
692
|
use Catmandu::Util qw(:array); |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
457
|
|
4
|
3
|
|
|
3
|
|
21
|
use Moo; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
17
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = "1.072"; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
extends qw(Catmandu::AlephX::Metadata); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
#parse aleph oai marc into catmandu marc array |
11
|
|
|
|
|
|
|
sub parse { |
12
|
0
|
|
|
0
|
0
|
|
my($class,$xpath)=@_; |
13
|
|
|
|
|
|
|
|
14
|
0
|
|
|
|
|
|
my @marc = (); |
15
|
0
|
|
|
|
|
|
my $_id; |
16
|
|
|
|
|
|
|
|
17
|
0
|
|
|
|
|
|
for my $fix_field($xpath->find('./fixfield')->get_nodelist()){ |
18
|
0
|
|
|
|
|
|
my $tag = $fix_field->findvalue('@id'); |
19
|
0
|
|
|
|
|
|
my $value = $fix_field->findvalue('.'); |
20
|
0
|
|
|
|
|
|
push @marc,[$tag,'','','_',$value]; |
21
|
|
|
|
|
|
|
|
22
|
0
|
0
|
|
|
|
|
if($tag eq "001"){ |
23
|
0
|
|
|
|
|
|
$_id = $value; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
0
|
|
|
|
|
|
for my $var_field($xpath->find('./varfield')->get_nodelist()){ |
28
|
|
|
|
|
|
|
|
29
|
0
|
|
|
|
|
|
my $tag = $var_field->findvalue('@id'); |
30
|
0
|
|
|
|
|
|
my $ind1 = $var_field->findvalue('@i1'); |
31
|
0
|
|
|
|
|
|
my $ind2 = $var_field->findvalue('@i2'); |
32
|
|
|
|
|
|
|
|
33
|
0
|
|
|
|
|
|
my @subf = (); |
34
|
|
|
|
|
|
|
|
35
|
0
|
|
|
|
|
|
foreach my $sub_field($var_field->find('.//subfield')->get_nodelist()) { |
36
|
0
|
|
|
|
|
|
my $code = $sub_field->findvalue('@label'); |
37
|
0
|
|
|
|
|
|
my $value = $sub_field->findvalue('.'); |
38
|
0
|
|
|
|
|
|
push @subf,$code,$value; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
0
|
|
|
|
|
|
push @marc,[$tag,$ind1,$ind2,@subf]; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
0
|
|
|
|
|
|
__PACKAGE__->new(type => 'oai_marc',data => { record => \@marc, _id => $_id }); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
sub escape_value { |
48
|
0
|
|
|
0
|
0
|
|
my $data = $_[0]; |
49
|
0
|
|
|
|
|
|
$data =~ s/&/&/sg; |
50
|
0
|
|
|
|
|
|
$data =~ s/</</sg; |
51
|
0
|
|
|
|
|
|
$data =~ s/>/>/sg; |
52
|
0
|
|
|
|
|
|
$data =~ s/"/"/sg; |
53
|
0
|
|
|
|
|
|
$data; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
sub to_xml { |
56
|
0
|
|
|
0
|
0
|
|
my($class,$record)=@_; |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
my @xml = "<oai_marc>"; |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
|
for my $field(@{ $record->{record} }){ |
|
0
|
|
|
|
|
|
|
61
|
0
|
|
|
|
|
|
my($tag,$ind1,$ind2,@subfields)= @$field; |
62
|
|
|
|
|
|
|
|
63
|
0
|
0
|
0
|
|
|
|
if(array_includes([qw(FMT LDR)],$tag) || $tag =~ /^00/o){ |
64
|
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
|
push @xml,"<fixfield id=\"$tag\">"; |
66
|
0
|
|
|
|
|
|
push @xml,escape_value($subfields[1]); |
67
|
0
|
|
|
|
|
|
push @xml,"</fixfield>"; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
}else{ |
70
|
|
|
|
|
|
|
|
71
|
0
|
|
|
|
|
|
push @xml,"<varfield id=\"$tag\" i1=\"$ind1\" i2=\"$ind2\">"; |
72
|
0
|
|
|
|
|
|
for(my $i = 0;$i < scalar(@subfields);$i+=2){ |
73
|
0
|
|
|
|
|
|
my $label = $subfields[$i]; |
74
|
0
|
|
|
|
|
|
my $value = $subfields[$i+1]; |
75
|
0
|
|
|
|
|
|
push @xml,"<subfield label=\"$label\">".escape_value($value)."</subfield>"; |
76
|
|
|
|
|
|
|
} |
77
|
0
|
|
|
|
|
|
push @xml,"</varfield>"; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
0
|
|
|
|
|
|
push @xml,"</oai_marc>"; |
84
|
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
|
join('',@xml); |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
1; |