diff --git a/bin/app.pl b/bin/app.pl
new file mode 100755
index 0000000..72025df
--- /dev/null
+++ b/bin/app.pl
@@ -0,0 +1,4 @@
+#!/usr/bin/env perl
+use Dancer;
+use PrimoServices;
+dance;
diff --git a/environments/development.yml.dist b/environments/development.yml.dist
new file mode 100644
index 0000000..1107437
--- /dev/null
+++ b/environments/development.yml.dist
@@ -0,0 +1,27 @@
+# configuration file for development environment
+
+# the logger engine to use
+# console: log messages to STDOUT (your console where you started the
+# application server)
+# file: log message to a file in log/
+logger: "console"
+
+# the log level for this environment
+# core is the lowest, it shows Dancer's core log messages as well as yours
+# (debug, info, warning and error)
+log: "core"
+
+# should Dancer consider warnings as critical errors?
+warnings: 1
+
+# should Dancer show a stacktrace when an error is caught?
+show_errors: 1
+
+# auto_reload is a development and experimental feature
+# you should enable it by yourself if you want it
+# Module::Refresh is needed
+#
+# Be aware it's unstable and may cause a memory leak.
+# DO NOT EVER USE THIS FEATURE IN PRODUCTION
+# OR TINY KITTENS SHALL DIE WITH LOTS OF SUFFERING
+auto_reload: 0
diff --git a/environments/production.yml.dist b/environments/production.yml.dist
new file mode 100644
index 0000000..f16492b
--- /dev/null
+++ b/environments/production.yml.dist
@@ -0,0 +1,17 @@
+# configuration file for production environment
+
+# only log warning and error messages
+log: "warning"
+
+# log message to a file in logs/
+logger: "file"
+
+# don't consider warnings critical
+warnings: 0
+
+# hide errors
+show_errors: 0
+
+# cache route resolution for maximum performance
+route_cache: 1
+
diff --git a/lib/PrimoServices.pm b/lib/PrimoServices.pm
new file mode 100644
index 0000000..672880e
--- /dev/null
+++ b/lib/PrimoServices.pm
@@ -0,0 +1,64 @@
+package PrimoServices;
+use Dancer 1.3132 ':syntax';
+use Dancer::Exception ':all';
+
+use PrimoServices::Dispatcher;
+
+use Time::HiRes();
+use Benchmark(':hireswallclock');
+
+# http://semver.org/
+# X.Y.Z (Major.Minor.Patch)
+use version; our $VERSION = version->declare("v2.2.0");
+
+#
+# Route handlers
+#
+
+get qr{.*} => sub {
+
+ my $data;
+
+ # Parse and reply to the request
+ #$data = PrimoServices::Dispatcher::handle_request();
+
+ try {
+ my $execution_time = timeit( 1, sub{
+ $data = PrimoServices::Dispatcher::handle_request();
+ });
+
+ # Calculate the total execution time of the call
+ $data->{appExecutionTime} = sprintf "%.3fs", $execution_time->real;
+ }
+ catch {
+ status 500;
+ $data->{error} = 'PrimoServices';
+ $data->{exception} = $_;
+ };
+
+ # Insert the request into the response (in development)
+ $data->{request} = params if config->{environment} eq 'development';
+
+ # Delete request_lookup_table (outside development)
+ delete $data->{request_lookup_table} if config->{environment} ne 'development';
+
+ # Count requested and returned number of IDs
+ $data->{totalItems} = param_array 'id';
+ $data->{totalItemsReturned} = @{$data->{items}};
+
+ # Name and version
+ $data->{appName} = config->{appname} . ' ' . $VERSION->normal();
+
+ # Set the serializer to either JSONP or JSON
+ if ( params->{callback} ) {
+ set serializer => 'JSONP';
+ }
+ else {
+ set serializer => 'JSON';
+ }
+
+ # Serialize...
+ return $data;
+};
+
+true;
diff --git a/lib/PrimoServices/Dispatcher.pm b/lib/PrimoServices/Dispatcher.pm
new file mode 100644
index 0000000..ce0d29f
--- /dev/null
+++ b/lib/PrimoServices/Dispatcher.pm
@@ -0,0 +1,533 @@
+package PrimoServices::Dispatcher;
+use 5.10.0;
+use Dancer ':syntax';
+use Dancer::Exception ':all';
+
+use PrimoServices::Parsers ':all';
+
+use HTTP::Async();
+use HTTP::Request();
+use HTTP::Headers();
+use URI();
+use CHI();
+use locale;
+use Digest::SHA();
+use List::MoreUtils();
+use Data::Dumper();
+
+# Setup $cache CHI object
+my $uid = $ENV{LOGNAME} || $ENV{USER} || getpwuid($<);
+my $cache = CHI->new(
+ namespace => __PACKAGE__,
+ driver => config->{caching}{chi_driver},
+ root_dir => config->{caching}{chi_root_dir} . '_' . $uid,
+ depth => config->{caching}{chi_depth},
+ expires_in => config->{caching}{default_expires_in},
+ );
+
+# Setup $async HTTP::Async object
+my $async = HTTP::Async->new(
+ slots => config->{http_async}{slots},
+ timeout => config->{http_async}{max_request_time}
+ );
+my $headers = HTTP::Headers->new(
+ Accept_Encoding => 'gzip',
+ Accept_Charset => 'utf-8',
+ User_Agent => config->{http_async}{user_agent}
+ );
+
+
+# We will use the given/when 'switch' feature of perl 5.10.0
+no if $] >= 5.018, warnings => "experimental";
+use feature 'switch';
+
+
+sub handle_request {
+ # Get URL parameters
+ my %params = request->params;
+
+ # The response that we are building
+ my %data;
+
+ # Dispatch initial web service requests
+ request_webservices(\%params,\%data);
+
+ # Retrieve responses (and dispatch further web service requests)
+ retrieve_webservices(\%data);
+
+
+ return \%data;
+}
+
+sub request_webservices {
+ my $params_ref = shift;
+ my $data_ref = shift;
+
+ # Our helper lookup-table which will link request id numbers to the request type and key
+ my %request_lookup_table;
+
+ #
+ # Primo Central
+ #
+
+ # Query Primo Central (not in case of blended search or call from a Primo Central tab)
+ if ( $params_ref->{scope} && $params_ref->{scope} !~ m{primo_central_multiple_fe} ) {
+
+ # Turn the query string into an unique id
+ my $key;
+ {
+ # Avoid problems with UTF-8 strings
+ use bytes;
+ $key = 'primocentral' . Digest::SHA::sha1_hex( $params_ref->{query} . $params_ref->{scope} );
+ }
+
+ unless ( $cache->is_valid($key) && ! defined params->{nocaching} ) {
+ # Not in cache
+ my $uri = URI->new( config->{primo}{'api'} . config->{primo}{x_search_brief} );
+
+ $uri->query_form(
+ institution => config->{primo}{institution},
+ pcAvailability => 1,
+ indx => 1,
+ bulkSize => 1,
+ json => 'true',
+ loc => 'adaptor,primo_central_multiple_fe',
+ query => 'any,contains,' . param 'query' );
+
+ my $req_id = $async->add(HTTP::Request->new( GET => $uri, $headers ));
+
+ $request_lookup_table{$req_id} = { type => 'primocentral', uri => $uri->as_string, key => $key };
+ }
+ else {
+ # Get from cache
+ $data_ref->{primoCentral} = $cache->get($key);
+ }
+ }
+
+ #
+ # Keywords
+ #
+
+ # Query for each individual keyword in the search string
+ if ( $params_ref->{query} ) {
+ my $query = $params_ref->{query};
+
+ # Normalize query string
+ $query =~ s{
+ # Remove 's
+ 's}{}gsxmi;
+
+ $query =~ s{
+ # Concatenate ' parts
+ '}{}gsxm;
+
+ $query =~ s{
+ # Remove non words
+ [\W]}{ }gsxm;
+
+ # Replace any horizontal white space with a single space
+ $query =~ s{\h+}{ }gsxm;
+
+ # Remove heading and / or tailing white space
+ $query =~ s{^\s|\s$}{}gsxm;
+
+ my @keywords;
+
+ foreach my $keyword ( split / /, $query ) {
+ # Skip short keywords
+ if ( length($keyword) < 3 ) {
+ push @{$data_ref->{keywordSearch}}, { $keyword => '...' };
+ next;
+ }
+
+ # Turn the keyword query into an unique id
+ my $key;
+ {
+ # Avoid problems with UTF-8 strings
+ use bytes;
+ $key = 'keyword' . Digest::SHA::sha1_hex( $keyword . $params_ref->{scope} . '' );
+ }
+
+ unless ( $cache->is_valid($key) && ! defined params->{nocaching} ) {
+ # Create a list of individual search scopes
+ my @search_scopes;
+ while ( $params_ref->{scope} =~ m{scope:\((.*?)\)}gsxm ) {
+ push @search_scopes, $1;
+ }
+ my $scope;
+ $scope = 'local,scope:(' . join(',', @search_scopes) . ')' if @search_scopes;
+
+ # Not in cache
+ my $uri = URI->new( config->{primo}{'api'} . config->{primo}{x_search_brief} );
+
+ # Build hash of query parameters
+ my %query_params;
+ $query_params{institution} = config->{primo}{institution};
+ $query_params{indx} = 1;
+ $query_params{bulkSize} = 1;
+ # Is it a blended search scope?
+ if ( $scope && $params_ref->{scope} =~m {primo_central_multiple_fe} ) {
+ $query_params{loc} = [ $scope, 'adaptor,primo_central_multiple_fe' ];
+ }
+ # Is it a local search scope?
+ elsif ( $scope ) {
+ $query_params{loc} = $scope;
+ }
+ # Then it is Primo Central
+ else {
+ $query_params{loc} = 'adaptor,primo_central_multiple_fe';
+ }
+ $query_params{query} = 'any,exact,' . $keyword;
+ $query_params{json} = 'true';
+
+ $uri->query_form(\%query_params);
+
+ my $req_id = $async->add(HTTP::Request->new( GET => $uri, $headers ));
+
+ $request_lookup_table{$req_id} = { type => 'keyword', keyword => $keyword, key => $key, uri => $uri->as_string };
+ }
+ else {
+ # Get from cache
+ push @{$data_ref->{keywordSearch}}, $cache->get($key);
+ }
+ }
+ }
+
+ #
+ # Primo records
+ #
+
+ # Array of the responses for each individual IDs we are gathering information about
+ my @items;
+
+ # Iterate through each ID given
+ foreach my $id ( param_array 'id' ) {
+
+ # Skip further handling of Primo Central records
+ if ( $id =~ m {
+ # Primo Central records are prefixed by 'TN_'
+ ^TN_}sxm ) {
+ push @items, { id => $id, primoStatus => 'Not a local record' };
+ next;
+ }
+
+ # If the local record is a frbr group
+ if ( $id =~ m {
+ # frbr groups are prefixed by 'frbg' followed by the id number
+ ^(?:frbg)(.*)
+ }sxm) {
+ my $frbg = $1;
+
+ unless ( $cache->is_valid($id) && ! defined params->{nocaching} ) {
+ # Not in cache
+ my $uri = URI->new( config->{primo}{'api'} . config->{primo}{x_search_brief} );
+
+ $uri->query_form(
+ institution => config->{primo}{institution},
+ loc => 'local',
+ indx => 1,
+ bulkSize => 1000,
+ query => 'facet_frbrgroupid,exact,' . $frbg,
+ json => 'true' );
+
+ my $req_id = $async->add(HTTP::Request->new( GET => $uri, $headers ));
+
+ $request_lookup_table{$req_id} = { type => 'frbg', key => $id, uri => $uri->as_string };
+ }
+ else {
+ # Get from cache
+ push @items, $cache->get($id);
+ }
+ }
+ # Then this is a single, local record
+ else {
+ unless ( $cache->is_valid($id) && ! defined params->{nocaching} ) {
+ # Not in cache
+ my $uri = URI->new( config->{primo}{'api'} . config->{primo}{x_search_full} );
+
+ $uri->query_form(
+ institution => config->{primo}{institution},
+ indx => 1,
+ bulkSize => 1,
+ getDelivery => 'true',
+ query => 'any,contains,',
+ docId => $id,
+ json => 'true' );
+
+ my $req_id = $async->add(HTTP::Request->new( GET => $uri, $headers ));
+
+ $request_lookup_table{$req_id} = { type => 'record', key => $id, uri => $uri->as_string };
+ }
+ else {
+ # Get from cache
+ my $item = $cache->get($id);
+ push @items, $item;
+ # Get JournalTOCs from cache
+ if ( $item->{metadata}{issn} ) {
+ my $key = 'issn' . lc $item->{metadata}{issn};
+ my $item = $cache->get($key);
+ if ( $item && $item->{id} ) {
+ push @{$data_ref->{journalTOCs}}, $item;
+ }
+ }
+ # Get GoogleBooks from cache
+ if ( $item->{metadata}{isbn} ) {
+ my $key = 'isbn' . lc $item->{metadata}{isbn};
+ my $item = $cache->get($key);
+ if ( $item && $item->{id} ) {
+ push @{$data_ref->{googleBooks}}, $item;
+ }
+ }
+ # Get RSI from cache
+ if ( $item->{id} ) {
+ my $key = 'rsi' . $item->{id};
+ my $item = $cache->get($key);
+ if ( $item && $item->{id} ) {
+ push @{$data_ref->{rsi}}, $item;
+ }
+ }
+ }
+ }
+ }
+
+ $data_ref->{items} = \@items;
+ $data_ref->{request_lookup_table} = \%request_lookup_table;
+}
+
+sub retrieve_webservices {
+ my $data_ref = shift;
+
+ # Wait until a response has arrived
+ while ( my ($response, $req_id) = $async->wait_for_next_response ) {
+
+ # Is it a success?
+ if ( $response->message eq 'OK' ) {
+
+ my $content = $response->decoded_content;
+
+ given ( $data_ref->{request_lookup_table}{$req_id}{type} ) {
+ when ( /record/ ) {
+ my %values = parse_record(
+ $data_ref,
+ \$content,
+ $data_ref->{request_lookup_table}{$req_id}{key},
+ $req_id );
+ push @{$data_ref->{items}}, \%values;
+ $cache->set($data_ref->{request_lookup_table}{$req_id}{key}, \%values);
+
+ #
+ # Google Books
+ #
+
+ # Send to Google Books API if we have an ISBN numer and the item is in print
+ if ( $values{metadata}{isbn} && grep /Physical Item/, @{$values{delcategory}} ) {
+
+ my $key = 'isbn' . lc $values{metadata}{isbn};
+ $key =~ s/-//g;
+
+ unless ( $cache->is_valid($key) && ! defined params->{nocaching} ) {
+ my ($req_id, $uri) = query_googlebooks($values{metadata}{isbn});
+ $data_ref->{request_lookup_table}{$req_id} = {
+ type => 'googlebooks',
+ key => $key,
+ isbn => $values{metadata}{isbn},
+ uri => $uri,
+ linked_item => $values{id}
+ };
+ }
+ else {
+ # Get from cache
+ push @{$data_ref->{googleBooks}}, $cache->get($key);
+ }
+ }
+
+ #
+ # JournalTOCs
+ #
+
+ # Send to JournalTOCs if we have an ISSN number and the record is a journal
+ if ( $values{metadata}{issn} && $values{type} eq 'journal' ) {
+
+ my $key = 'issn' . lc $values{metadata}{issn};
+
+ unless ( $cache->is_valid($key) && ! defined params->{nocaching} ) {
+ my ($req_id, $uri) = query_journaltocs($values{metadata}{issn});
+ $data_ref->{request_lookup_table}{$req_id} = {
+ type => 'journaltocs',
+ key => $key,
+ issn => $values{metadata}{issn},
+ uri => $uri,
+ linked_item => $values{id}
+ };
+ }
+ else {
+ # Get from cache
+ push @{$data_ref->{journalTOCs}}, $cache->get($key);
+ }
+ }
+
+ #
+ # RSI
+ #
+
+ # Send to SFX RSI API to check for online resource
+ if ( defined @{$values{delcategory}}[0]
+ && @{$values{delcategory}} == 1 && @{$values{delcategory}}[0] eq 'Physical Item'
+ && ($values{metadata}{isbn} || $values{metadata}{issn}) ) {
+
+ my $key = 'rsi' . $values{id};
+
+ unless ( $cache->is_valid($key) && ! defined params->{nocaching} ) {
+ my ($req_id, $uri) = query_rsi(\%values);
+ $data_ref->{request_lookup_table}{$req_id} = {
+ type => 'rsi',
+ key => $key,
+ uri => $uri,
+ linked_item => $values{id},
+ atitle => $values{metadata}{atitle},
+ spage => $values{metadata}{spage},
+ date => $values{metadata}{date},
+ volume => $values{metadata}{volume},
+ issue => $values{metadata}{issue},
+ };
+ }
+ else {
+ # Get from cache
+ push @{$data_ref->{rsi}}, $cache->get($key);
+ }
+ }
+ }
+ when ( /frbg/ ) {
+ my %values = parse_frbg(
+ $data_ref,
+ \$content,
+ $data_ref->{request_lookup_table}{$req_id}{key},
+ $req_id );
+ push @{$data_ref->{items}}, \%values;
+ $cache->set($data_ref->{request_lookup_table}{$req_id}{key}, \%values);
+ }
+ when ( /keyword/ ) {
+ my %values = parse_keyword(
+ $data_ref,
+ \$content,
+ $data_ref->{request_lookup_table}{$req_id}{key},
+ $req_id );
+ push @{$data_ref->{keywordSearch}}, \%values;
+ $cache->set($data_ref->{request_lookup_table}{$req_id}{key}, \%values);
+ }
+ when ( /primocentral/ ) {
+ my %values = parse_primocentral(
+ $data_ref,
+ \$content,
+ $data_ref->{request_lookup_table}{$req_id}{key},
+ $req_id );
+ $data_ref->{primoCentral} = \%values;
+ $cache->set($data_ref->{request_lookup_table}{$req_id}{key}, \%values);
+ }
+ when ( /googlebooks/ ) {
+ my %values = parse_googlebooks(
+ $data_ref,
+ \$content,
+ $data_ref->{request_lookup_table}{$req_id}{key},
+ $req_id );
+ push @{$data_ref->{googleBooks}}, \%values if $values{id};
+ $cache->set($data_ref->{request_lookup_table}{$req_id}{key}, \%values);
+ }
+ when ( /journaltocs/ ) {
+ my %values = parse_journaltocs(
+ $data_ref,
+ \$content,
+ $data_ref->{request_lookup_table}{$req_id}{key},
+ $req_id );
+ push @{$data_ref->{journalTOCs}}, \%values if $values{id};
+ $cache->set($data_ref->{request_lookup_table}{$req_id}{key}, \%values);
+ }
+ when ( /rsi/ ) {
+ my %values = parse_rsi(
+ $data_ref,
+ \$content,
+ $data_ref->{request_lookup_table}{$req_id}{key},
+ $req_id );
+ push @{$data_ref->{rsi}}, \%values if $values{id};
+ $cache->set($data_ref->{request_lookup_table}{$req_id}{key}, \%values);
+ }
+ }
+ }
+ # There was an error
+ else {
+ push @{$data_ref->{errors}}, {
+ key => $data_ref->{request_lookup_table}{$req_id}{key},
+ status => $response->status_line
+ };
+ }
+
+ }
+}
+
+#
+# Subs
+#
+
+sub query_googlebooks {
+ my $isbn = shift;
+
+ my $uri = URI->new( config->{google_books}{api} );
+
+ $uri->query_form(
+ key => config->{google_books}{password},
+ filter => 'partial',
+ country => config->{google_books}{country},
+ q => 'isbn:' . $isbn
+ );
+
+ my $req_id = $async->add(HTTP::Request->new( GET => $uri, $headers ));
+
+ return $req_id, $uri->as_string;
+}
+
+sub query_journaltocs {
+ my $issn = shift;
+
+ my $uri = URI->new( config->{journaltocs}{api} . $issn );
+
+ $uri->query_form(
+ user => config->{journaltocs}{password},
+ );
+
+ my $req_id = $async->add(HTTP::Request->new( GET => $uri, $headers ));
+
+ return $req_id, $uri->as_string;
+}
+
+sub query_rsi {
+ my $values_ref = shift;
+
+ my $uri = URI->new ( config->{sfx}{rsi_api} );
+
+ # build the RSI API xml payload
+ my $rsi_request = '';
+ $rsi_request .= '';
+ $rsi_request .= '';
+ # add every single ISBN and ISSN number
+ foreach ( @{$values_ref->{metadata}{'@isbn'}} ) {
+ $rsi_request .= 'isbn:' . $_ . '' if $_;
+ }
+ foreach ( @{$values_ref->{metadata}{'@issn'}} ) {
+ $rsi_request .= 'issn:' . $_ . '' if $_;
+ }
+ $rsi_request .= '' . $values_ref->{metadata}{date} . '' if $values_ref->{metadata}{date};
+ $rsi_request .= '' . $values_ref->{metadata}{volume} . '' if $values_ref->{metadata}{volume};
+ $rsi_request .= '' . $values_ref->{metadata}{issue}. '' if $values_ref->{metadata}{issue};
+ $rsi_request .= '';
+ $rsi_request .= '';
+
+ $uri->query_form(
+ request_xml => $rsi_request
+ );
+
+ my $req_id = $async->add(HTTP::Request->new( GET => $uri, $headers ));
+
+ return $req_id, $uri->as_string;
+}
+
+true;
diff --git a/lib/PrimoServices/Parsers.pm b/lib/PrimoServices/Parsers.pm
new file mode 100644
index 0000000..c75ce32
--- /dev/null
+++ b/lib/PrimoServices/Parsers.pm
@@ -0,0 +1,299 @@
+package PrimoServices::Parsers;
+use strict;
+use warnings;
+use Dancer ':syntax';
+use Dancer::Exception ':all';
+
+use PrimoServices::Utility ':all';
+
+use JSON::XS();
+use List::MoreUtils();
+
+# Export our functions
+use Exporter 'import';
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(
+ parse_record
+ parse_frbg
+ parse_primocentral
+ parse_keyword
+ parse_googlebooks
+ parse_journaltocs
+ parse_rsi );
+our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
+
+#
+# Subs
+#
+
+sub parse_record {
+ my $data_ref = shift;
+ my $content_ref = shift;
+ my $id = shift;
+ my $req_id = shift;
+
+ my $json;
+ my %values;
+
+ # JSON::XS will croak on error
+ try{
+ $json = JSON::XS->new->utf8->decode($$content_ref);
+
+ $values{id} = $id;
+ $values{primoStatus} = 'OK';
+
+ $values{metadata}{isbn} = get_as_scalar($json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{PrimoNMBib}{record}{addata}{isbn});
+ $values{metadata}{'@isbn'} = get_as_array($json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{PrimoNMBib}{record}{addata}{isbn});
+ $values{metadata}{issn} = get_as_scalar($json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{PrimoNMBib}{record}{addata}{issn});
+ $values{metadata}{'@issn'} = get_as_array($json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{PrimoNMBib}{record}{addata}{issn});
+
+ $values{delcategory} = get_as_array($json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{PrimoNMBib}{record}{delivery}{delcategory});
+ @{$values{delcategory}} = List::MoreUtils::apply { s/(^\$\$V|\$\$O.*$)//g } @{$values{delcategory}} if @{$values{delcategory}}[0];
+ @{$values{delcategory}} = List::MoreUtils::uniq @{$values{delcategory}} if @{$values{delcategory}}[1];
+
+ $values{type} = $json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{PrimoNMBib}{record}{display}{type};
+ $values{availability} = $json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{LIBRARIES};
+ $values{metadata}{date} = get_as_scalar($json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{PrimoNMBib}{record}{addata}{date});
+ $values{metadata}{volume} = get_as_scalar($json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{PrimoNMBib}{record}{addata}{volume});
+ $values{metadata}{issue} = get_as_scalar($json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{PrimoNMBib}{record}{addata}{issue});
+ $values{metadata}{issue} = get_as_scalar($json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{PrimoNMBib}{record}{addata}{spage});
+
+ $values{metadata}{atitle} = get_as_scalar($json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{PrimoNMBib}{record}{addata}{atitle});
+
+ my $holdings = get_as_array($json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}{PrimoNMBib}{record}{display}{lds01});
+
+ my ($online, $paper);
+ if ( $holdings->[0] ) {
+ $online = join(', ', sort grep(/^oa:/, @$holdings));
+ $paper = join(', ', sort grep(/^pe:/, @$holdings));
+ }
+ if ( $paper ) {
+ $paper =~ s/pe://g;
+ $values{holdings}{paper} = $paper;
+ }
+ if ( $online ) {
+ $online =~ s/oa://g;
+ $values{holdings}{online} = $online;
+ }
+
+ }
+ catch {
+ # JSON was malformed so we cannot tell the number of hits
+ $values{id} = $id;
+ $values{primoStatus} = 'Record failed in JSON conversion';
+ $values{error} = $_;
+ };
+
+ return %values;
+}
+
+sub parse_frbg {
+ my $data_ref = shift;
+ my $content_ref = shift;
+ my $id = shift;
+ my $req_id = shift;
+
+ my $json;
+ my %values;
+
+ # JSON::XS will croak on error
+ try{
+ $json = JSON::XS->new->utf8->decode($$content_ref);
+
+ $values{id} = $id;
+ $values{primoStatus} = 'OK';
+
+ # Iterate through records in frbr group
+ my @dates;
+ foreach my $doc ( @{$json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{DOC}} ) {
+ push @dates, $doc->{PrimoNMBib}{record}{display}{creationdate};
+ }
+
+ my @uniqDates = List::MoreUtils::uniq(sort @dates);
+ $values{yearsRange} = put_years_in_order(@uniqDates);
+ $values{years} = join(", ", @uniqDates);
+ }
+ catch {
+ # JSON was malformed so we cannot tell the number of hits
+ $values{id} = $id;
+ $values{primoStatus} = 'Record failed in JSON conversion';
+ $values{error} = $_;
+ };
+
+ return %values;
+}
+
+sub parse_keyword {
+ my $data_ref = shift;
+ my $content_ref = shift;
+ my $id = shift;
+ my $req_id = shift;
+
+ my $json;
+ my %values;
+
+ # JSON::XS will croak on error
+ try{
+ $json = JSON::XS->new->utf8->decode($$content_ref);
+ $values{$data_ref->{request_lookup_table}{$req_id}{keyword}} = $json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{'@TOTALHITS'};
+ }
+ catch {
+ # JSON was malformed so we cannot tell the number of hits
+ $values{$data_ref->{request_lookup_table}{$req_id}{keyword}} = '...';
+ };
+
+ return %values;
+}
+
+sub parse_primocentral {
+ my $data_ref = shift;
+ my $content_ref = shift;
+ my $id = shift;
+ my $req_id = shift;
+
+ my $json;
+ my %values;
+
+ # JSON::XS will croak on error
+ try{
+ $json = JSON::XS->new->utf8->decode($$content_ref);
+ $values{totalHits} = $json->{SEGMENTS}{JAGROOT}{RESULT}{DOCSET}{'@TOTALHITS'};
+
+ my @facets = @{$json->{SEGMENTS}{JAGROOT}{RESULT}{FACETLIST}{FACET}};
+
+ # Iterate through facets for the "tlevel"-facet
+ foreach my $facet ( @facets ) {
+ if ( $facet->{'@NAME'} eq "tlevel" ) {
+ # If there is more than one "tlevel"-facet
+ if ( ref $facet->{FACET_VALUES} eq "ARRAY" ) {
+ foreach my $tlevel ( @{$facet->{FACET_VALUES}} ) {
+ if ( $tlevel->{'@KEY'} eq "online_resources" ) {
+ $values{onlineHits} = $tlevel->{'@VALUE'};
+ }
+ if ( $tlevel->{'@KEY'} eq "peer_reviewed" ) {
+ $values{peerReviewedHits} = $tlevel->{'@VALUE'};
+ }
+ }
+ }
+ # If there is only one
+ else {
+ $values{onlineHits} = $facet->{FACET_VALUES}{'@VALUE'} if $facet->{FACET_VALUES}{'@KEY'} eq "online_resources";
+ $values{peerReviewedHits} = $facet->{FACET_VALUES}{'@VALUE'} if $facet->{FACET_VALUES}{'@KEY'} eq "peer_reviewed";
+ }
+ }
+ }
+ };
+
+ return %values;
+}
+
+sub parse_googlebooks {
+ my $data_ref = shift;
+ my $content_ref = shift;
+ my $id = shift;
+ my $req_id = shift;
+
+ my $json;
+ my %values;
+
+ # JSON::XS will croak on error
+ try{
+ $json = JSON::XS->new->utf8->decode($$content_ref);
+
+ # Only process if there is a 1:1 match
+ if ( $json->{totalItems} eq '1' ) {
+ $values{id} = $data_ref->{request_lookup_table}{$req_id}{linked_item};
+ $values{gbsid} = $json->{items}[0]{id};
+ $values{previewLink} = $json->{items}[0]{volumeInfo}{previewLink};
+ $values{webReaderLink} = $json->{items}[0]{accessInfo}{webReaderLink};
+ $values{viewability} = $json->{items}[0]{accessInfo}{viewability};
+ }
+ }
+ catch {
+ # JSON was malformed so we cannot tell the number of hits
+ };
+
+ return %values;
+}
+
+sub parse_journaltocs {
+ my $data_ref = shift;
+ my $content_ref = shift;
+ my $id = shift;
+ my $req_id = shift;
+
+ my %values;
+
+ if ( $$content_ref =~ m{
+ JournalTOCs[ ]API[ ]-[ ]Found
+ }sxmi ) {
+ $values{id} = $data_ref->{request_lookup_table}{$req_id}{linked_item};
+ $values{link} = config->{journaltocs}{deeplink} . $data_ref->{request_lookup_table}{$req_id}{issn} . '?embed';
+ $values{rssFeed} = config->{journaltocs}{deeplink} . 'rss/' . $data_ref->{request_lookup_table}{$req_id}{issn};
+ }
+
+ return %values;
+}
+
+sub parse_rsi {
+ my $data_ref = shift;
+ my $content_ref = shift;
+ my $id = shift;
+ my $req_id = shift;
+
+ my %values;
+
+ if ( $$content_ref !~ m{
+ <RESULT>not[ ]found</RESULT>
+ }sxmi
+ && $$content_ref =~ m{
+ <AVAILABLE_SERVICES>getFullTxt</AVAILABLE_SERVICES>
+ }sxmi ) {
+
+ # Get SFX Object ID
+ my $sfx_object_id = $1 if ( $$content_ref =~ m{
+ <OBJECT_ID>(\d+?)</OBJECT_ID>
+ }sxmi );
+
+ # Define OpenURL metadata format according to the available metadata
+ my $sfx_metadata = 'book';
+ my $sfx_genre = 'book';
+ if ( $$content_ref =~ m{
+ <IDENTIFIER>issn:
+ }sxmi ) {
+ $sfx_genre = 'journal';
+ if ( $data_ref->{request_lookup_table}{$req_id}{volume} || $data_ref->{request_lookup_table}{$req_id}{issue} ) {
+ $sfx_genre = 'article';
+ }
+ $sfx_metadata = 'journal';
+ }
+
+ # Build OpenURL
+ my $uri = URI->new ( config->{sfx}{base_url} );
+
+ my %uri_params;
+ $uri_params{url_ver} = 'Z39.88-2004';
+ $uri_params{url_ctx_fmt} = 'info:ofi/fmt:kev:mtx:ctx';
+ $uri_params{rft_val_fmt} = 'info:ofi/fmt:kev:mtx:' . $sfx_metadata;
+ $uri_params{ctx_ver} = 'Z39.88-2004';
+ $uri_params{ctx_enc} = 'info:ofi/enc:UTF-8';
+ $uri_params{rfr_id} = config->{sfx}{rfr_id};
+ $uri_params{'rft.object_id'} = $sfx_object_id;
+ $uri_params{'rft.genre'} = $sfx_genre;
+ $uri_params{'rft.year'} = $data_ref->{request_lookup_table}{$req_id}{date} if $data_ref->{request_lookup_table}{$req_id}{date};
+ $uri_params{'rft.volume'} = $data_ref->{request_lookup_table}{$req_id}{volume} if $data_ref->{request_lookup_table}{$req_id}{volume};
+ $uri_params{'rft.issue'} = $data_ref->{request_lookup_table}{$req_id}{issue} if $data_ref->{request_lookup_table}{$req_id}{issue};
+ $uri_params{'rft.spage'} = $data_ref->{request_lookup_table}{$req_id}{spage} if $data_ref->{request_lookup_table}{$req_id}{spage};
+ $uri_params{'rft.atitle'} = $data_ref->{request_lookup_table}{$req_id}{atitle} if $data_ref->{request_lookup_table}{$req_id}{atitle};
+ $uri_params{vid} = 'primo';
+
+ $uri->query_form(\%uri_params);
+
+ $values{id} = $data_ref->{request_lookup_table}{$req_id}{linked_item};
+ $values{openURL} = $uri->as_string;
+
+ }
+ return %values;
+}
+
+true;
diff --git a/lib/PrimoServices/Utility.pm b/lib/PrimoServices/Utility.pm
new file mode 100644
index 0000000..e55b595
--- /dev/null
+++ b/lib/PrimoServices/Utility.pm
@@ -0,0 +1,79 @@
+package PrimoServices::Utility;
+use strict;
+use warnings;
+use Dancer ':syntax';
+
+# Export our functions
+use Exporter 'import';
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw( get_as_scalar get_as_array put_years_in_order );
+our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
+
+#
+# Subs
+#
+
+sub get_as_scalar {
+ my $key = shift;
+
+ if ( ref $key eq 'ARRAY' ) {
+ return $key->[0];
+ }
+ else {
+ return $key;
+ }
+}
+
+sub get_as_array {
+ my $key = shift;
+
+ if ( ref $key eq 'ARRAY') {
+ return $key;
+ }
+ else {
+ return [ $key ];
+ }
+}
+
+# make a pretty printed year range
+# (dates pased to the sub needs to be sorted and unique)
+sub put_years_in_order {
+ my @range = @_;
+
+ # just return "unknown" no year exist
+ return "????" unless $range[0];
+
+ # is this a current year only?
+ return $range[0] if ( ! defined $range[1] );
+
+ my $in_order = '';
+
+ # loop through each year in the array
+ for ( my $index=0 ; $index<@range ; $index++ ) {
+ # this is the last year in the range
+ if ( ! defined $range[$index+1] ) {
+ # is this then the end of a range
+ $in_order .= $range[$index];
+ last;
+ }
+ # this is a single year (current year +1 not equal to next year AND current year -1 not equal to previous year)
+ if ( ($range[$index]+1 != $range[$index+1]) && ($range[$index]-1 != $range[$index-1]) ) {
+ $in_order .= $range[$index] . ", ";
+ next;
+ }
+ # this is the beginning of a year range (current year not equal to previous year +1)
+ if ( $range[$index] ne $range[$index-1]+1 ) {
+ $in_order .= $range[$index] . '-';
+ next;
+ }
+ # this is the ending of a year range (current year +1 not equal next year)
+ if ( $range[$index]+1 != $range[$index+1] ) {
+ $in_order .= $range[$index] . ", ";
+ next;
+ }
+ }
+
+ return $in_order;
+}
+
+true;
\ No newline at end of file
diff --git a/logs/README b/logs/README
new file mode 100644
index 0000000..e69de29
diff --git a/public/README b/public/README
new file mode 100644
index 0000000..e69de29
diff --git a/t/001_base.t b/t/001_base.t
new file mode 100644
index 0000000..bac629d
--- /dev/null
+++ b/t/001_base.t
@@ -0,0 +1,5 @@
+use Test::More tests => 1;
+use strict;
+use warnings;
+
+use_ok 'PrimoServices';
diff --git a/t/002_index_route.t b/t/002_index_route.t
new file mode 100644
index 0000000..f5403b5
--- /dev/null
+++ b/t/002_index_route.t
@@ -0,0 +1,10 @@
+use Test::More tests => 2;
+use strict;
+use warnings;
+
+# the order is important
+use PrimoServices;
+use Dancer::Test;
+
+route_exists [GET => '/'], 'a route handler is defined for /';
+response_status_is ['GET' => '/'], 200, 'response status is 200 for /';
diff --git a/views/README b/views/README
new file mode 100644
index 0000000..e69de29