WebPAC/Output/Riak.pm

package WebPAC::Output::Riak;

use warnings;
use strict;

use base qw/WebPAC::Common WebPAC::Output Class::Accessor/;
__PACKAGE__->mk_accessors(qw(
        input
        url
        database
        bucket
));

use Data::Dump qw/dump/;
use URI;
use Net::Riak;

=head1 NAME

WebPAC::Output::Riak - feed data into Riak Search

=head1 FUNCTIONS

=head2 init

  $out->init;

=cut

sub init {
        my $self = shift;
        my $log = $self->_get_logger;

        $log->debug('init');

        my $bucket = $self->bucket || join('.', $self->database, $self->input || 'webpac2' );

        $self->{_riak} = Net::Riak->new( host => $self->url );
        $self->{_bucket} = $self->{_riak}->bucket( $bucket );
        $self->{_bucket}->set_properties({
                precommit => [ { mod => 'riak_search_kv_hook', fun => 'precommit' } ],
        });

        $log->info( $self->url,"/riak/$bucket" );
#       warn dump($self->{_bucket}->get_properties);

        $self->{_count} = 0;

        return 1;
}


=head2 add

Adds one entry to database.

  $out->add( 42, $ds );

=cut

sub add {
        my ($self,$id,$ds) = @_;
        my $log = $self->_get_logger;

#       $log->debug( 'ds = ', $id, sub { dump($ds) } );

        my $data;
        $data->{$_->[0]} = $_->[1] foreach
                map {
                        my $v = join(' ', @{ $ds->{$_}->{search} });
                        my $k = $_;
                        if ( $v =~ m/^\d+([-\d+]*\d)?$/ ) {
                                $v =~ s/-//g;
                                $v *= 1;
                                # _num suffix for riak search https://wiki.basho.com/display/RIAK/Riak+Search+-+Schema
                                $k .= '_num';
                        }
                        [ $k, $v ]
                }
                grep { exists $ds->{$_}->{search} }
                keys %$ds;

        my $obj = $self->{_bucket}->new_object( $id, $data );
        $obj->store;

        $log->debug( 'json = ', $id, sub { dump($data) } );

        $self->{_count}++;

        return 1;
}

=head2 finish

 $out->finish;

=cut

sub finish {
        my $self = shift;

        my $log = $self->_get_logger();

        $log->info('finish ', $self->{_count}, ' documents');

        1;
}

=head1 SEE ALSO

L<https://wiki.basho.com/display/RIAK/Riak+Search>

=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2010 Dobrica Pavlinusic, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of WebPAC::Output::Riak
1	dpavlin	1354	package WebPAC::Output::Riak;
2
3			use warnings;
4			use strict;
5
6			use base qw/WebPAC::Common WebPAC::Output Class::Accessor/;
7			__PACKAGE__->mk_accessors(qw(
8			input
9			url
10			database
11	dpavlin	1357	bucket
12	dpavlin	1354	));
13
14			use Data::Dump qw/dump/;
15			use URI;
16			use Net::Riak;
17
18			=head1 NAME
19
20	dpavlin	1357	WebPAC::Output::Riak - feed data into Riak Search
21	dpavlin	1354
22			=head1 FUNCTIONS
23
24			=head2 init
25
26			$out->init;
27
28			=cut
29
30			sub init {
31			my $self = shift;
32			my $log = $self->_get_logger;
33
34			$log->debug('init');
35
36	dpavlin	1357	my $bucket = $self->bucket \|\| join('.', $self->database, $self->input \|\| 'webpac2' );
37
38	dpavlin	1354	$self->{_riak} = Net::Riak->new( host => $self->url );
39	dpavlin	1357	$self->{_bucket} = $self->{_riak}->bucket( $bucket );
40			$self->{_bucket}->set_properties({
41			precommit => [ { mod => 'riak_search_kv_hook', fun => 'precommit' } ],
42			});
43	dpavlin	1354
44	dpavlin	1357	$log->info( $self->url,"/riak/$bucket" );
45			# warn dump($self->{_bucket}->get_properties);
46	dpavlin	1354
47			$self->{_count} = 0;
48
49			return 1;
50			}
51
52
53			=head2 add
54
55			Adds one entry to database.
56
57			$out->add( 42, $ds );
58
59			=cut
60
61	dpavlin	1357	sub add {
62			my ($self,$id,$ds) = @_;
63			my $log = $self->_get_logger;
64	dpavlin	1354
65	dpavlin	1357	# $log->debug( 'ds = ', $id, sub { dump($ds) } );
66	dpavlin	1354
67	dpavlin	1357	my $data;
68	dpavlin	1363	$data->{$_->[0]} = $_->[1] foreach
69			map {
70			my $v = join(' ', @{ $ds->{$_}->{search} });
71			my $k = $_;
72			if ( $v =~ m/^\d+([-\d+]*\d)?$/ ) {
73			$v =~ s/-//g;
74			$v *= 1;
75			# _num suffix for riak search https://wiki.basho.com/display/RIAK/Riak+Search+-+Schema
76			$k .= '_num';
77			}
78			[ $k, $v ]
79			}
80	dpavlin	1357	grep { exists $ds->{$_}->{search} }
81			keys %$ds;
82	dpavlin	1354
83	dpavlin	1357	my $obj = $self->{_bucket}->new_object( $id, $data );
84	dpavlin	1354	$obj->store;
85
86	dpavlin	1357	$log->debug( 'json = ', $id, sub { dump($data) } );
87	dpavlin	1354
88			$self->{_count}++;
89
90			return 1;
91			}
92
93			=head2 finish
94
95			$out->finish;
96
97			=cut
98
99			sub finish {
100			my $self = shift;
101
102			my $log = $self->_get_logger();
103
104			$log->info('finish ', $self->{_count}, ' documents');
105
106			1;
107			}
108
109	dpavlin	1358	=head1 SEE ALSO
110
111			L<https://wiki.basho.com/display/RIAK/Riak+Search>
112
113	dpavlin	1354	=head1 AUTHOR
114
115			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
116
117			=head1 COPYRIGHT & LICENSE
118
119			Copyright 2010 Dobrica Pavlinusic, All Rights Reserved.
120
121			This program is free software; you can redistribute it and/or modify it
122			under the same terms as Perl itself.
123
124			=cut
125
126			1; # End of WebPAC::Output::Riak