File Coverage

blib/lib/Genealogy/ChroniclingAmerica.pm

Criterion	Covered	Total	%
statement	80	97	82.4
branch	32	48	66.6
condition	5	11	45.4
subroutine	8	8	100.0
pod	2	2	100.0
total	127	166	76.5

package Genealogy::ChroniclingAmerica;

# https://chroniclingamerica.loc.gov/search/pages/results/?state=Indiana&andtext=james=serjeant&date1=1894&date2=1896&format=json
use warnings;
use strict;
use LWP::UserAgent;
use JSON;
use URI;
use Carp;

=head1 NAME

Genealogy::ChroniclingAmerica - Find URLs for a given person on the Library of Congress Newspaper Records

=head1 VERSION

Version 0.03

=cut

our $VERSION = '0.03';

=head1 SYNOPSIS

    use HTTP::Cache::Transparent;  # be nice
    use Genealogy::ChroniclingAmerica;

    HTTP::Cache::Transparent::init({
	BasePath => '/tmp/cache'
    });
    my $loc = Genealogy::ChroniclingAmerica->new({
	firstname => 'John',
	lastname => 'Smith',
	state => 'Indiana',
	date_of_death => 1862
    });

    while(my $url = $loc->get_next_entry()) {
	print "$url\n";
    }

=head1 SUBROUTINES/METHODS

=head2 new

Creates a Genealogy::ChroniclingAmerica object.

It takes three mandatory arguments state, firstname and lastname.
State must be the full name, not an abbreviation.

There are four optional arguments: middlename, date_of_birth, date_of_death, ua and host:
host is the domain of the site to search, the default is chroniclingamerica.loc.gov.
ua is a pointer to an object that understands get and env_proxy messages, such
as L.

=cut

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;

	return unless(defined($class));

	my %args;
	if(ref($_[0]) eq 'HASH') {
		%args = %{$_[0]};
	} elsif(ref($_[0]) || !defined($_[0])) {
		Carp::croak('Usage: ', __PACKAGE__, '->new(%args)');
	} elsif(@_ % 2 == 0) {
		%args = @_;
	}

	unless($args{'firstname'}) {
		Carp::croak('First name is not optional');
		return;	# Don't know why this is needed, but it is
	}
	unless(defined($args{'lastname'})) {
		Carp::croak('Last name is not optional');
		return;
	}
	unless($args{'state'}) {
		Carp::croak('State is not optional');
		return;
	}

	Carp::croak('State needs to be the full name') if(length($args{'state'}) == 2);

	my $ua = $args{'ua'} || LWP::UserAgent->new(agent => __PACKAGE__ . "/$VERSION");
	$ua->env_proxy(1) unless(delete $args{'ua'});

	my $rc = { ua => $ua };
	$rc->{'host'} = $args{'host'} || 'chroniclingamerica.loc.gov';

	my %query_parameters = ( 'format' => 'json', 'state' => ucfirst(lc($args{'state'})) );
	if($query_parameters{'state'} eq 'District of columbia') {
		$query_parameters{'state'} = 'District of Columbia';
	}
	my $name = $args{'firstname'};
	if($args{'middlename'}) {
		$rc->{'name'} = "$name $args{middlename} $args{lastname}";
		$name .= "=$args{middlename}";
	} else {
		$rc->{'name'} = "$name $args{lastname}";
	}
	$name .= "=$args{lastname}";

	$query_parameters{'andtext'} = $name;
	if($args{'date_of_birth'}) {
		$query_parameters{'date1'} = $args{'date_of_birth'};
	}
	if($args{'date_of_death'}) {
		$query_parameters{'date2'} = $args{'date_of_death'};
	}

	my $uri = URI->new("https://$rc->{host}/search/pages/results/");
	$uri->query_form(%query_parameters);
	my $url = $uri->as_string();
	# ::diag(">>>>$url = ", $rc->{'name'});
	# print ">>>>$url = ", $rc->{'name'}, "\n";

	my $resp = $ua->get($url);

	if($resp->is_error()) {
		Carp::carp("API returned error on $url: ", $resp->status_line());
		return;
	}

	unless($resp->is_success()) {
		die $resp->status_line();
	}

	$rc->{'json'} = JSON->new();
	my $data = $rc->{'json'}->decode($resp->content());

	# ::diag(Data::Dumper->new([$data])->Dump());

	my $matches = $data->{'totalItems'};
	if($data->{'itemsPerPage'} < $matches) {
		$matches = $data->{'itemsPerPage'};
	}

	$rc->{'matches'} = $matches;
	if($matches) {
		$rc->{'query_parameters'} = \%query_parameters;
		$rc->{'items'} = $data->{'items'};
		$rc->{'index'} = 0;
	}

	return bless $rc, $class;
}

=head2 get_next_entry

Returns the next match as a URL.

=cut

sub get_next_entry
{
	my $self = shift;

	return if($self->{'matches'} == 0);

	if($self->{'index'} >= $self->{'matches'}) {
		return;
	}

	my $entry = @{$self->{'items'}}[$self->{'index'}];
	$self->{'index'}++;

	if(!defined($entry->{'url'})) {
		return $self->get_next_entry();
	}

	my $text = $entry->{'ocr_eng'};

	if(!defined($text)) {
		return $self->get_next_entry();
	}

	$text =~ s/[\r\n]/ /g;
	if($text !~ /$self->{'name'}/ims) {
		return $self->get_next_entry();
	}

	# ::diag(Data::Dumper->new([$entry])->Dump());

	my $resp = $self->{'ua'}->get($entry->{'url'});

	if($resp->is_error()) {
		# print 'got: ', $resp->content(), "\n";
		Carp::carp("get_next_entry: API returned error on $entry->{url}: ", $resp->status_line());
		return;
	}

	unless($resp->is_success()) {
		die $resp->status_line();
	}

	return $self->{'json'}->decode($resp->content())->{'pdf'};
}

=head1 AUTHOR

Nigel Horne, C<<  >>

=head1 BUGS

If a middle name is given and no match is found,
it should search again without the middle name.

Please report any bugs or feature requests to C,
or through the web interface at
L.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SEE ALSO

L
L

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Genealogy::ChroniclingAmerica

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2018,2019 Nigel Horne.

This program is released under the following licence: GPL2

=cut

1; # End of Genealogy::ChroniclingAmerica