DPLA.pm

   1 package DPLA;
   2
   3 use warnings;
   4 use strict;
   5
   6 use MARC::Record;
   7 use Data::Dump qw/dump/;
   8 use JSON::XS;
   9 use Encode;
  10
  11 use base 'Scraper';
  12
  13 my $debug = $ENV{DEBUG} || 0;
  14
  15 sub diag {
  16         warn "# ", @_, $/;
  17 }
  18
  19 # http://dp.la/dev/wiki/Item_API
  20 #
  21 # Base Fields: Mapping to a set of common terms
  22 # Field name    Field description
  23 # dpla.keyword  Almost all of a record's fields get copied to this field
  24 # dpla.title    The title and/or subtitle of the item. Exact matching.
  25 # dpla.title_keyword    The title and/or subtitle of the item. Keyword matching.
  26 # dpla.creator  The creator(s), contributor(s), editor(s), etc. of the item. Exact matching
  27 # dpla.creator_keyword  The creator(s), contributor(s), editor(s), etc. of the item. Keyword matching
  28 # dpla.date     The item's date of publication.
  29 # dpla.description      The item's description. This often includes the item's Table of Contents. Exact matching.
  30 # dpla.description_keyword      The item's description. This often includes the item's Table of Contents. Keyword matching.
  31 # dpla.subject  A catchall for subject information. LCSH, Dewey, and other tag related fields are copied to this field. Exact matching.
  32 # dpla.subject_keyword  A catchall for subject information. LCSH, Dewey, and other tag related fields are copied to this field. Keyword matching.
  33 # dpla.publisher        The name of the publisher. Exact matching.
  34 # dpla.language         The primary language of the item. Exact matching.
  35 # dpla.isbn     The item's ISBN. Exact matching.
  36 # dpla.oclc     The item's OCLC identifier. Exact matching.
  37 # dpla.lccn     The item's LCCN. Exact matching.
  38 # dpla.call_num         The item's call number. Exact matching.
  39 # dpla.content_link     A link to the item's content. Exact matching.
  40 # dpla.contributor      The contributing partner. Exact matching.
  41 # dpla.resource_type    The resource's type. Common values include item and collection. Exact matching.
  42
  43 # Koha Z39.50 query:
  44 #
  45 # Bib-1 @and @and @and @and @and @and @and @or
  46 # @attr 1=4 title
  47 # @attr 1=7 isbn
  48 # @attr 1=8 issn
  49 # @attr 1=1003 author
  50 # @attr 1=16 dewey
  51 # @attr 1=21 subject-holding
  52 # @attr 1=12 control-no
  53 # @attr 1=1007 standard-id
  54 # @attr 1=1016 any
  55
  56 sub usemap {{
  57         4               => 'dpla.title',
  58         7               => 'dpla.isbn',
  59         8               => 'dpla.keyword', # XXX fake
  60         1003    => 'dpla.creator_keyword',
  61 #       16              => '',
  62         21              => 'dpla.subject',
  63 #       12              => '',
  64 #       1007    => '',
  65         1016    => 'dpla.keyword',
  66
  67         RPN => {
  68                 And => '&',
  69                 Or  => '&',     # FIXME sigh, not really supported?
  70         },
  71         prefix_term => sub {
  72                 my ( $prefix, $term ) = @_;
  73                 return 'filter=' . $prefix . ':' . $term;
  74         }
  75 }};
  76
  77 sub search {
  78         my ( $self, $query ) = @_;
  79
  80         die "need query" unless defined $query;
  81
  82         my $url = 'http://api.dp.la/v0.03/item/?' . $query;
  83
  84 diag "get $url";
  85
  86         my $mech = $self->mech;
  87
  88         $mech->get( $url );
  89
  90         my $json = decode_json $mech->content;
  91         diag "# json = ", dump($json) if $debug;
  92
  93         my $hits = 0;
  94
  95         if ( exists $json->{num_found} ) {
  96                 $hits = $json->{num_found};
  97         } else {
  98                 diag "get't find num_found in ", $mech->content;
  99                 return;
 100         }
 101
 102 diag "got $hits results";
 103
 104         $self->{_json} = $json;
 105
 106         return $self->{hits} = $hits;
 107 }
 108
 109 sub next_marc {
 110         my ($self,$format) = @_;
 111
 112         $format ||= 'marc';
 113
 114         my $item = shift @{ $self->{_json}->{docs} };
 115
 116         my $marc = MARC::Record->new;
 117         $marc->encoding('utf-8');
 118
 119         my $fields; # empty marc
 120
 121         foreach my $key ( sort keys %$item ) {
 122                 my $v = $item->{$key};
 123                 warn "# item ",dump( $key, $v ) if $debug;
 124                 if ( $key =~ m/^(\d\d\d)(\w)$/ ) {
 125                         my ($f,$sf) = ($1,$2);
 126
 127                         # XXX do magic and unroll into proper MARC record
 128
 129                         $v = [ $v ] unless ref $v eq 'ARRAY';
 130
 131                         if ( $fields ) {
 132                                 if ( $fields->[0]->[0] ne $f ) {
 133                                         $marc->add_fields( @$fields );
 134                                         warn "# add_fields ",dump($fields) if $debug;
 135                                         $fields = undef;
 136                                 }
 137                         }
 138                         foreach my $i ( 0 .. $#$v ) {
 139                                 $fields->[$i]->[0] = $f;
 140                                 $fields->[$i]->[1] = ' ';
 141                                 $fields->[$i]->[2] = ' ';
 142                                 push @{ $fields->[$i] }, $sf, $v->[$i];
 143                         }
 144
 145                 } else {
 146                         warn "# IGNORED: $key ", dump($item->{$key}), "\n";
 147                 }
 148         }
 149
 150         $marc->add_fields( @$fields );
 151
 152         diag "# marc ", $marc->as_formatted;
 153
 154         warn dump( $marc->as_usmarc );
 155
 156         $self->mech->back; # return to search results for next page
 157
 158         my $id = $item->{'dpla.id'};
 159
 160         if ( ! $id ) {
 161                         warn "no dpla.id in ",dump($item);
 162                         return;
 163         }
 164
 165         $self->save_marc( "$id.marc", $marc->as_usmarc );
 166
 167         return $id;
 168
 169 }
 170
 171 1;