File Coverage

blib/lib/Catmandu/AlephX/Metadata/MARC/Aleph.pm
Criterion Covered Total %
statement 9 52 17.3
branch 0 4 0.0
condition 0 3 0.0
subroutine 3 6 50.0
pod 0 3 0.0
total 12 68 17.6


line stmt bran cond sub pod time code
1             package Catmandu::AlephX::Metadata::MARC::Aleph;
2 3     3   110217 use Catmandu::Sane;
  3         222233  
  3         35  
3 3     3   858 use Catmandu::Util qw(:array);
  3         8  
  3         475  
4 3     3   20 use Moo;
  3         8  
  3         20  
5              
6             our $VERSION = "1.073";
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/</&lt;/sg;
51 0           $data =~ s/>/&gt;/sg;
52 0           $data =~ s/"/&quot;/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;