File Coverage

blib/lib/WWW/Scraper/ISBN/LOC_Driver.pm

Criterion	Covered	Total	%
statement	73	84	86.9
branch	8	18	44.4
condition	4	9	44.4
subroutine	6	6	100.0
pod	1	1	100.0
total	92	118	77.9

package WWW::Scraper::ISBN::LOC_Driver;

use strict;
use warnings;

our $VERSION = '0.26';

#--------------------------------------------------------------------------

###########################################################################
# Inheritence

our @ISA = qw(WWW::Scraper::ISBN::Driver);

###########################################################################
# Modules

use HTTP::Request::Common;
use LWP::UserAgent;
use WWW::Scraper::ISBN::Driver;

###########################################################################
# Public Interface

sub search {
    my $self = shift;
    my $isbn = shift;
    my %data;

    $self->found(0);
    $self->book(undef);

    # first, initialize the session:
    my $post_url = "http://www.loc.gov/cgi-bin/zgate?ACTION=INIT&FORM_HOST_PORT=/prod/www/data/z3950/locils.html,z3950.loc.gov,7090";
    my $ua = new LWP::UserAgent;
    my $res = $ua->request(GET $post_url);
    my $doc = '';

    # get page
    # removes blank lines, DOS line feeds, and leading spaces.
    $doc = join "\n", grep { /\S/ } split /\n/, $res->as_string();
    $doc =~ s/\r//g;
    $doc =~ s/^\s+//g;

    my $sessionID = '';

    unless ( ($sessionID) = ($doc =~ //i) ) {
        print "Error starting LOC Query session.\n" if $self->verbosity;
        $self->error("Cannot start LOC query session.\n");
        $self->found(0);
        return 0;
    }

    $post_url = "http://www.loc.gov/cgi-bin/zgate";
    $res = $ua->request(
        POST $post_url,
        Referer => $post_url,
        Content => [
            TERM_1      => $isbn,
            USE_1       => '7',
            ESNAME      => 'F',
            ACTION      => 'SEARCH',
            DBNAME      => 'VOYAGER',
            MAXRECORDS  => '20',
            RECSYNTAX   => '1.2.840.10003.5.10',
            STRUCT_1    => '1',
            STRUCT_2    => '1',
            STRUCT_3    => '1',
            SESSION_ID  => $sessionID
        ]
    );

    $doc = '';

    # get page
    # removes blank lines, DOS line feeds, and leading spaces.
    $doc = join "\n", grep { /\S/ } split /\n/, $res->as_string();
    $doc =~ s/\r//g;
    $doc =~ s/^\s+//g;

    if ( (my $book_data) = ($doc =~ /.*(.*)<\/PRE>.*/is) ) {
        print $book_data if ($self->verbosity > 1);

        my @author_lines;
        my $other_authors;

        # get author field
        while ($book_data =~ s/uthor(s)?:\s+(\D+?)(?:, [0-9-.]*|\.)$/if (($1) && ($1 eq "s")) { "uthors:"; } else { "" }/me) {
            my $temp = $2;
            $temp =~ s/ ([A-Z])$/ $1./; # trailing middle initial
            push @author_lines, $temp;
        }

        @author_lines = sort @author_lines;
        foreach my $line(@author_lines) {
            $line =~ s/(\w+), (.*)/$2 $1/;
        }
        $data{author} = join ", ", @author_lines;

        # get other fields
        ($data{title})                      = $book_data =~ /Title:\s+((.*)\n(\s+(.*)\n)*)/;
        ($data{edition})                    = $book_data =~ /Edition:\s+(.*)\n/;
        ($data{volume})                     = $book_data =~ /Volume:\s+(.*)\n/;
        ($data{dewey})                      = $book_data =~ /Dewey No.:\s+(.*)\n/;
        ($data{publisher},$data{pubdate})   = $book_data =~ /Published:\s+[^:]+:\s+(.*), c(\d+)\.\n/;
        ($data{pages},$data{height})        = $book_data =~ /Description:\s+\w+,\s+(\d+)\s+:[^;]+;\s+(\d+)\s*cm.\n/;
        ($data{isbn10},$data{binding})      = $book_data =~ /ISBN:\s+(\d+)\s+\(([^\)]+)\)\n/;

        # trim and clean data
        for my $key (keys %data) {
            next    unless($data{$key});
            $data{$key} =~ s/\n//g;
            $data{$key} =~ s/ +/ /g;
        }

        # reformat and default fields
        $data{title} =~ s/(.*) \/(.*)/$1/;
        $data{height} *= 10;    # cm => mm
        $data{author}  ||= '';
        $data{edition} ||= 'n/a';
        $data{volume}  ||= 'n/a';

        # print data if in verbose mode
        if($self->verbosity > 1) {
            for my $key (keys %data) {
                printf "%-8s %s\n", "$key:", $data{$key};
            }
        }

        # store book data
        my $bk = {
            'isbn'      => $isbn,
            'isbn13'    => $isbn,
            'ean13'     => $isbn
        };

        $bk->{isbn10} = $data{isbn10} if(length($data{isbn10}) == 10);
        $bk->{$_} = $data{$_} for(qw(author title edition volume dewey publisher pubdate pages height binding));

        $self->book($bk);
        $self->found(1);
        return $self->book;

    } else {
        print "Error extracting data from LOC result page.\n" if $self->verbosity;
        $self->error("Could not extract data from LOC result page.\n");
        $self->found(0);
        return 0;
    }
}

1;

__END__