File Coverage

blib/lib/App/MARC/Filter.pm
Criterion Covered Total %
statement 93 95 97.8
branch 22 32 68.7
condition 4 6 66.6
subroutine 13 13 100.0
pod 2 2 100.0
total 134 148 90.5


line stmt bran cond sub pod time code
1             package App::MARC::Filter;
2              
3 4     4   96404 use strict;
  4         25  
  4         94  
4 4     4   17 use warnings;
  4         6  
  4         101  
5              
6 4     4   1686 use Class::Utils qw(set_params);
  4         107819  
  4         65  
7 4     4   245 use English;
  4         6  
  4         26  
8 4     4   1460 use Error::Pure qw(err);
  4         7  
  4         130  
9 4     4   6951 use Getopt::Std;
  4         223  
  4         233  
10 4     4   23 use List::MoreUtils qw(none);
  4         9  
  4         27  
11 4     4   4005 use MARC::File::XML (BinaryEncoding => 'utf8', RecordFormat => 'MARC21');
  4         446990  
  4         40  
12 4     4   185 use Readonly;
  4         9  
  4         274  
13 4     4   1926 use Unicode::UTF8 qw(encode_utf8 decode_utf8);
  4         1909  
  4         2856  
14              
15             Readonly::Array our @OUTPUT_FORMATS => qw(ascii xml);
16              
17             our $VERSION = 0.02;
18              
19             # Constructor.
20             sub new {
21 7     7 1 8641 my ($class, @params) = @_;
22              
23             # Create object.
24 7         18 my $self = bless {}, $class;
25              
26             # Process parameters.
27 7         36 set_params($self, @params);
28              
29             # Object.
30 6         60 return $self;
31             }
32              
33             # Run.
34             sub run {
35 5     5 1 10 my $self = shift;
36              
37             # Process arguments.
38 5         24 $self->{'_opts'} = {
39             'h' => 0,
40             'o' => 'xml',
41             'r' => 0,
42             };
43 5 100 66     17 if (! getopts('ho:r', $self->{'_opts'}) || @ARGV < 4
      66        
44             || $self->{'_opts'}->{'h'}) {
45              
46 1         119 print STDERR "Usage: $0 [-h] [-o format] [-r] [--version] marc_xml_file field subfield value\n";
47 1         13 print STDERR "\t-h\t\tPrint help.\n";
48 1         9 print STDERR "\t-o format\tOutput MARC format. Possible formats are ascii, xml.\n";
49 1         9 print STDERR "\t-r\t\tUse value as Perl regexp.\n";
50 1         10 print STDERR "\t--version\tPrint version.\n";
51 1         9 print STDERR "\tmarc_xml_file\tMARC XML file.\n";
52 1         9 print STDERR "\tfield\t\tMARC field.\n";
53 1         10 print STDERR "\tsubfield\tMARC subfield.\n";
54 1         15 print STDERR "\tvalue\t\tMARC field/subfield value to filter.\n";
55 1         5 return 1;
56             }
57 4         109 $self->{'_marc_xml_file'} = shift @ARGV;
58 4         6 $self->{'_marc_field'} = shift @ARGV;
59 4         6 $self->{'_marc_subfield'} = shift @ARGV;
60 4         16 $self->{'_marc_value'} = decode_utf8(shift @ARGV);
61              
62             # Check output format.
63 4 50   8   28 if (none { $self->{'_opts'}->{'o'} eq $_ } @OUTPUT_FORMATS) {
  8         74  
64 0         0 err "Output format '$self->{'_opts'}->{'o'}' doesn't supported.";
65             }
66              
67 4         33 my $marc_file = MARC::File::XML->in($self->{'_marc_xml_file'});
68 4         272 my @ret;
69 4         6 my $num = 1;
70 4         4 my $previous_record;
71 4         6 while (1) {
72 8         11 my $record = eval {
73 8         24 $marc_file->next;
74             };
75 8 100       10882 if ($EVAL_ERROR) {
76 1 50       132 print STDERR "Cannot process '$num' record. ".
77             (
78             defined $previous_record
79             ? "Previous record is ".encode_utf8($previous_record->title)."\n"
80             : ''
81             );
82 1         18 print STDERR "Error: $EVAL_ERROR\n";
83 1         4 next;
84             }
85 7 100       15 if (! defined $record) {
86 4         7 last;
87             }
88 3         5 $previous_record = $record;
89              
90 3         9 my @fields = $record->field($self->{'_marc_field'});
91 3         443 foreach my $field (@fields) {
92 3         12 my @subfield_values = $field->subfield($self->{'_marc_subfield'});
93 3         64 foreach my $subfield_value (@subfield_values) {
94 3 50       9 if (defined $subfield_value) {
95 3         4 my $match = 0;
96 3 100       7 if ($self->{'_opts'}->{'r'}) {
97 1 50       13 if ($subfield_value =~ m/$self->{'_marc_value'}/ms) {
98 1         2 $match = 1;
99             }
100             } else {
101 2 100       7 if ($subfield_value eq $self->{'_marc_value'}) {
102 1         1 $match = 1;
103             }
104             }
105 3 100       5 if ($match) {
106 2         5 push @ret, $record;
107             }
108             }
109             }
110             }
111              
112 3         6 $num++;
113             }
114              
115             # Print out.
116 4         7 $num = 0;
117 4         7 foreach my $ret (@ret) {
118 2 50       4 if (! $num) {
119 2 50       7 if ($self->{'_opts'}->{'o'} eq 'xml') {
120 2         6 print MARC::File::XML::header()."\n";
121             }
122             }
123              
124 2 50       112 if ($self->{'_opts'}->{'o'} eq 'xml') {
    0          
125 2         10 print encode_utf8(MARC::File::XML::record($ret))."\n";
126             } elsif ($self->{'_opts'}->{'o'} eq 'ascii') {
127 0         0 print encode_utf8($ret->as_formatted)."\n";
128             }
129              
130 2         3557 $num++;
131             }
132 4 100       11 if ($num) {
133 2 50       7 if ($self->{'_opts'}->{'o'} eq 'xml') {
134 2         6 print MARC::File::XML::footer()."\n";
135             }
136             }
137            
138 4         110 return 0;
139             }
140              
141             1;
142              
143              
144             __END__