From 7b04aa31a642ea233b9dcf1104e9557edf615c2c Mon Sep 17 00:00:00 2001
From: Dobrica Pavlinusic <dpavlin@rot13.org>
Date: Sat, 13 Nov 2010 21:04:10 +0100
Subject: [PATCH] extract Riak communication to separate module

---
 koha/RiakSearch.pm       | 57 ++++++++++++++++++++++++++++++++++++++++
 koha/koha2riak-search.pl | 44 ++++++++++++++-----------------
 2 files changed, 76 insertions(+), 25 deletions(-)
 create mode 100644 koha/RiakSearch.pm

diff --git a/koha/RiakSearch.pm b/koha/RiakSearch.pm
new file mode 100644
index 0000000..ceebb9c
--- /dev/null
+++ b/koha/RiakSearch.pm
@@ -0,0 +1,57 @@
+package RiakSearch;
+
+# https://wiki.basho.com/display/RIAK/Riak+Search
+
+use strict;
+use warnings;
+
+use LWP::UserAgent;
+use JSON::XS;
+use Data::Dump qw/dump/;
+
+sub new {
+	my ($class, $url) = @_;
+
+	my $ua = LWP::UserAgent->new;
+	$ua->timeout(10);
+	$ua->env_proxy;
+
+	return bless {
+		ua  => $ua,
+		url => $url,
+	}, $class;
+}
+
+sub request {
+	my ($self, $method, $uri, $content, $headers) = @_;
+
+	my $full_url = $self->{url} . "/riak/$uri";
+	$full_url =~ s{//+}{/}g;
+	$full_url =~ s{http:/}{http://};
+
+	$headers->{'Content-Type'} = 'application/json' unless exists $headers->{'Content-Type'};
+
+	my $req;
+
+	if (defined $content) {
+		$content = encode_json $content if ref $content;
+		$req = HTTP::Request->new( $method, $full_url, undef, $content );
+	} else {
+		$req = HTTP::Request->new( $method, $full_url );
+	}
+
+	$req->header( $_ => $headers->{$_} ) foreach keys %$headers;
+	$req->header( 'Host' => $1 ) if $self->{url} =~ m{http://([^/]+)};
+
+	warn "# $method $full_url ", dump($req, $content);
+	my $response = $self->{ua}->request($req);
+
+	if ($response->is_success) {
+		warn "$full_url ", $response->status_line,$/;
+		return $response->content;
+	} else {
+		die($response->status_line . ":" . $response->content);
+	}
+}
+
+1;
diff --git a/koha/koha2riak-search.pl b/koha/koha2riak-search.pl
index c5ea668..ace3441 100755
--- a/koha/koha2riak-search.pl
+++ b/koha/koha2riak-search.pl
@@ -2,10 +2,10 @@
 
 use strict;
 use DBI;
-use Net::Riak;
+use RiakSearch;
 use Data::Dump qw/dump/;
 
-my $limit = "limit 3";
+my $limit = "limit 5";
 my $riak_url = 'http://10.60.0.92:8098';
 my $dbi = 'DBI:mysql:dbname=koha;host=10.60.0.10;port=3306';
 my @tables = qw(
@@ -14,13 +14,15 @@ biblio
 );
 
 my $dbh = DBI->connect($dbi,"","") || die $DBI::errstr;
-my $riak = Net::Riak->new(host => $riak_url );
+my $riak = RiakSearch->new( $riak_url );
 
-my $xml_bucket = $riak->bucket( 'koha.marcxml' );
-$xml_bucket->set_properties({
-	precommit => [ { mod => 'riak_search_kv_hook', fun => 'precommit' } ],
-});
+warn $riak->request( 'GET' => '/koha.marcxml' );
 
+sub riak_search_kv_hook {
+	$riak->request( 'PUT' => shift, { props => { precommit => [ { mod => 'riak_search_kv_hook', fun => 'precommit' } ] } });
+}
+
+riak_search_kv_hook '/koha.marcxml';
 
 foreach my $table ( @tables ) {
 
@@ -30,33 +32,25 @@ foreach my $table ( @tables ) {
 
     print "import ", $sth->rows, " rows from $table pk:",dump( @pk ),"...\n";
 
-    my $bucket = $riak->bucket( 'koha.' . $table );
-	$bucket->set_properties({
-		precommit => [ { mod => 'riak_search_kv_hook', fun => 'precommit' } ],
-	});
+	riak_search_kv_hook "koha.$table";
 
     while (my $row = $sth->fetchrow_hashref() ) {
 
         my $key = join('_', map { $row->{$_} } @pk);
 
         if ( my $marcxml = delete $row->{marcxml} ) {
-            my $request = $riak->client->new_request(
-                'PUT', [ 'riak', "koha.marcxml/$key" ]
-            );
-            $request->header('Content-Type' => 'text/xml');
-            $request->content($marcxml);
-            my $response = $riak->client->send_request($request);
-
-            warn "$riak_url/riak/koha.marcxml/$key ", length($marcxml), " bytes\n";
-
-            unless ($response->is_success) {
-                die "Error put marcxml:", dump( $response );
-            }
+			$riak->request( 'PUT' => "/koha.marcxml/$key", $marcxml, {
+				'Content-Type' => 'text/xml',
+			} );
         }
 
         warn "# $key ",dump($row);
-		$bucket->new_object( $key => $row )->store;
-		warn "$riak_url/riak/koha.$table/$key\n";
+
+		my $headers;
+		if ( exists $row->{biblionumber} && $key !~ m/biblionumber/ ) {
+			$headers->{Links} = '/koha.biblio/' . $row->{biblionumber};
+		}
+		$riak->request( 'PUT' => "/koha.$table/$key", $row, $headers );
     }
 
 }
-- 
2.20.1