File Coverage

blib/lib/App/MARC/List.pm

Criterion	Covered	Total	%
statement	113	123	91.8
branch	26	34	76.4
condition	15	15	100.0
subroutine	15	15	100.0
pod	2	2	100.0
total	171	189	90.4

package App::MARC::List;

use strict;
use warnings;

use Class::Utils qw(set_params);
use English;
use Error::Pure qw(err);
use Getopt::Std;
use IO::Uncompress::AnyUncompress qw($AnyUncompressError);
use List::MoreUtils qw(uniq);
use List::Util qw(max);
use MARC::Batch;
use MARC::File::XML (BinaryEncoding => 'utf8', RecordFormat => 'MARC21');
use Unicode::UTF8 qw(decode_utf8 encode_utf8);

our $VERSION = 0.09;

# Constructor.
sub new {
	my ($class, @params) = @_;

	# Create object.
	my $self = bless {}, $class;

	# Process parameters.
	set_params($self, @params);

	# Object.
	return $self;
}

# Run.
sub run {
	my $self = shift;

	# Process arguments.
	$self->{'_opts'} = {
		'f' => 0,
		'h' => 0,
		's' => 0,
	};
	if (! getopts('fhs', $self->{'_opts'})
		|| $self->{'_opts'}->{'h'}
		|| @ARGV < 2) {

		print STDERR "Usage: $0 [-f] [-h] [-s] [--version] marc_xml_file field [subfield]\n";
		print STDERR "\t-f\t\tPrint frequency.\n";
		print STDERR "\t-h\t\tPrint help.\n";
		print STDERR "\t-s\t\tSkip controls of field/subfield.\n";
		print STDERR "\t--version\tPrint version.\n";
		print STDERR "\tmarc_xml_file\tMARC XML file, could be compressed.\n";
		print STDERR "\tfield\t\tMARC field (field number or 'leader' string).\n";
		print STDERR "\tsubfield\tMARC subfield (for datafields).\n";
		return 1;
	}
	my $marc_xml_file = shift @ARGV;
	my $marc_field = shift @ARGV;
	my $marc_subfield = shift @ARGV;

	if (! $self->{'_opts'}->{'s'}) {
		if ($marc_field ne 'leader'
			&& $marc_field !~ m/^\d+$/ms) {

			err "Bad field definition. Must be a 'leader' or numeric value of the field.";
		}

		if ($marc_field ne 'leader'
			&& int($marc_field) > 9
			&& ! defined $marc_subfield) {

			err 'Subfield is required.';
		}
	}

	if (! -r $marc_xml_file) {
		err "File '$marc_xml_file' doesn't exist.";
	}
	my ($fh, $errno);
	if ($self->_open_marc_input($marc_xml_file, \$fh, \$errno)) {
		print STDERR "Cannot open file '$marc_xml_file'.";
		if (defined $errno) {
			print STDERR "\tErrno: $errno\n";
		}
		return 1;
	}
	my $marc_batch = eval {
		MARC::Batch->new('XML', $fh);
	};
	if ($EVAL_ERROR) {
		print STDERR "Cannot open MARC XML stream.\n";
		print STDERR "\tError: $EVAL_ERROR\n";
		return 1;
	}
	my $ret_hr = {};
	my $num = 1;
	my $previous_record;
	while (1) {
		my $record = eval {
			$marc_batch->next;
		};
		if ($EVAL_ERROR) {
			print STDERR "Cannot process '$num' record. ".
				(
					defined $previous_record
					? "Previous record is ".encode_utf8($previous_record->title)."\n"
					: ''
				);
			print STDERR "Error: $EVAL_ERROR\n";
			next;
		}
		if (! defined $record) {
			last;
		}
		$previous_record = $record;

		if ($marc_field eq 'leader') {
			my $leader = $record->leader;
			$ret_hr->{"'".$leader."'"}++;
		} else {
			my @fields = $record->field($marc_field);
			foreach my $field (@fields) {
				if (defined $marc_subfield) {
					my @subfield_values = $field->subfield($marc_subfield);
					foreach my $subfield_value (@subfield_values) {
						$ret_hr->{$subfield_value}++;
					}
				} else {
					my $data = $field->data;
					$ret_hr->{$data}++;
				}
			}
		}
		$num++;
	}

	# Print out.
	if (%{$ret_hr}) {
		if ($self->{'_opts'}->{'f'}) {
			my $max = max(values %{$ret_hr});
			my $num = length($max);
			print join "\n",
				map { sprintf("%${num}s", $ret_hr->{$_}).' '.encode_utf8($_) }
				reverse sort {
					$ret_hr->{$a} <=> $ret_hr->{$b}
					||
					$b cmp $a
				}
				keys %{$ret_hr};
		} else {
			print join "\n", map { encode_utf8($_) } sort keys %{$ret_hr};
		}
		print "\n";
	}

	return 0;
}

sub _open_marc_input {
	my ($self, $path, $fh_sr, $errno_sr) = @_;

	# Compression autodetection.
	${$fh_sr} = IO::Uncompress::AnyUncompress->new($path);
	if (defined ${$fh_sr}) {
		return 0;
	}
	${$errno_sr} = $AnyUncompressError;

	return 1;
}

1;


__END__