File Coverage

blib/lib/App/MARC/List.pm
Criterion Covered Total %
statement 74 74 100.0
branch 12 14 85.7
condition 7 9 77.7
subroutine 11 11 100.0
pod 2 2 100.0
total 106 110 96.3


line stmt bran cond sub pod time code
1             package App::MARC::List;
2              
3 4     4   90135 use strict;
  4         20  
  4         95  
4 4     4   15 use warnings;
  4         7  
  4         89  
5              
6 4     4   1627 use Class::Utils qw(set_params);
  4         102190  
  4         57  
7 4     4   212 use English;
  4         7  
  4         20  
8 4     4   1388 use Error::Pure qw(err);
  4         7  
  4         124  
9 4     4   6597 use Getopt::Std;
  4         172  
  4         194  
10 4     4   25 use List::MoreUtils qw(uniq);
  4         4  
  4         22  
11 4     4   3879 use MARC::File::XML (BinaryEncoding => 'utf8', RecordFormat => 'MARC21');
  4         421476  
  4         29  
12 4     4   2514 use Unicode::UTF8 qw(decode_utf8 encode_utf8);
  4         1520  
  4         2075  
13              
14             our $VERSION = 0.02;
15              
16             # Constructor.
17             sub new {
18 7     7 1 8728 my ($class, @params) = @_;
19              
20             # Create object.
21 7         18 my $self = bless {}, $class;
22              
23             # Process parameters.
24 7         26 set_params($self, @params);
25              
26             # Object.
27 6         46 return $self;
28             }
29              
30             # Run.
31             sub run {
32 5     5 1 7 my $self = shift;
33              
34             # Process arguments.
35 5         18 $self->{'_opts'} = {
36             'h' => 0,
37             };
38 5 100 66     25 if (! getopts('h', $self->{'_opts'}) || @ARGV < 1
      66        
39             || $self->{'_opts'}->{'h'}) {
40              
41 1         140 print STDERR "Usage: $0 [-h] [--version] marc_xml_file field subfield\n";
42 1         30 print STDERR "\t-h\t\tPrint help.\n";
43 1         13 print STDERR "\t--version\tPrint version.\n";
44 1         10 print STDERR "\tmarc_xml_file\tMARC XML file.\n";
45 1         9 print STDERR "\tfield\t\tMARC field.\n";
46 1         10 print STDERR "\tsubfield\tMARC subfield.\n";
47 1         5 return 1;
48             }
49 4         106 $self->{'_marc_xml_file'} = shift @ARGV;
50 4         8 $self->{'_marc_field'} = shift @ARGV;
51 4         7 $self->{'_marc_subfield'} = shift @ARGV;
52              
53 4 100 100     16 if (! defined $self->{'_marc_field'}
54             || ! defined $self->{'_marc_subfield'}) {
55              
56 2         8 err "Field and subfield is required.";
57             }
58              
59 2         15 my $marc_file = MARC::File::XML->in($self->{'_marc_xml_file'});
60 2         212 my $ret_hr = {};
61 2         4 my $num = 1;
62 2         3 my $previous_record;
63 2         2 while (1) {
64 4         6 my $record = eval {
65 4         16 $marc_file->next;
66             };
67 4 100       6565 if ($EVAL_ERROR) {
68 1 50       134 print STDERR "Cannot process '$num' record. ".
69             (
70             defined $previous_record
71             ? "Previous record is ".encode_utf8($previous_record->title)."\n"
72             : ''
73             );
74 1         17 print STDERR "Error: $EVAL_ERROR\n";
75 1         4 next;
76             }
77 3 100       9 if (! defined $record) {
78 2         4 last;
79             }
80 1         3 $previous_record = $record;
81              
82 1         5 my @fields = $record->field($self->{'_marc_field'});
83 1         202 foreach my $field (@fields) {
84 1         5 my @subfield_values = $field->subfield($self->{'_marc_subfield'});
85 1         25 foreach my $subfield_value (@subfield_values) {
86 1 50       4 if (! exists $ret_hr->{$subfield_value}) {
87 1         4 $ret_hr->{$subfield_value} = $subfield_value;
88             }
89             }
90             }
91 1         3 $num++;
92             }
93              
94             # Print out.
95 2 100       2 if (%{$ret_hr}) {
  2         7  
96 1         2 print join "\n", map { encode_utf8($_) } uniq sort keys %{$ret_hr};
  1         37  
  1         22  
97 1         15 print "\n";
98             }
99            
100 2         32 return 0;
101             }
102              
103             1;
104              
105              
106             __END__