r1880@llin: dpavlin | 2009-05-27 23:45:18 +0200

 added output to CouchDB

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@1196 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/Makefile.PL b/Makefile.PL
index 2b26e85..e6acfa2 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -78,6 +78,10 @@ features(
                -default => 1,
                'SWISH::API',
        ],
+       'WebPAC::Output::CouchDB' => [
+               -default => 0,
+               'Net::CouchDb',
+       ],
        'Parallel execution (probably broken)' => [
                -default => 0,
                'Proc::Queue',

diff --git a/lib/WebPAC/Output/CouchDB.pm b/lib/WebPAC/Output/CouchDB.pm
new file mode 100644 (file)
index 0000000..ee10d0b
--- /dev/null
+++ b/lib/WebPAC/Output/CouchDB.pm
@@ -0,0 +1,103 @@
+package WebPAC::Output::CouchDB;
+
+use warnings;
+use strict;
+
+use base qw/WebPAC::Common WebPAC::Output Class::Accessor/;
+__PACKAGE__->mk_accessors(qw(
+       database
+
+       host
+       port
+));
+
+use Data::Dump qw/dump/;
+use Net::CouchDb;
+
+=head1 NAME
+
+WebPAC::Output::CouchDB - feed data into CouchDB
+
+=head1 FUNCTIONS
+
+=head2 init
+
+  $out->init;
+
+=cut
+
+sub init {
+       my $self = shift;
+       my $log = $self->_get_logger;
+
+       $log->debug('init');
+
+       my $cdb = Net::CouchDb->new(
+               host => $self->host || "localhost",
+               port => $self->port || 5984,
+       );
+
+       $log->info("CouchDB server info ", dump( $cdb->server_info ) );
+
+       my $database = $self->database || 'webpac2';
+
+       $cdb->debug( $self->debug );
+       eval { $cdb->delete_db( $self->database ) };
+       $cdb->create_db( $self->database );
+       $self->{_cdb} = $cdb->db( $self->database );
+
+       return 1;
+}
+
+
+=head2 add
+
+Adds one entry to database.
+
+  $out->add( 42, $ds );
+
+=cut
+
+sub add {
+       my $self = shift;
+
+       my ( $id, $ds ) = @_;
+
+       my $log = $self->_get_logger;
+
+       my $doc = Net::CouchDb::Document->new( $id, $ds );
+       $self->{_cdb}->put( $doc );
+
+       return 1;
+}
+
+=head2 finish
+
+ $out->finish;
+
+=cut
+
+sub finish {
+       my $self = shift;
+
+       my $log = $self->_get_logger();
+
+       $log->info('finish');
+       1;
+
+}
+
+=head1 AUTHOR
+
+Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2009 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::CouchDB

diff --git a/t/5-output-couchdb.t b/t/5-output-couchdb.t
new file mode 100755 (executable)
index 0000000..1f1a59d
--- /dev/null
+++ b/t/5-output-couchdb.t
@@ -0,0 +1,49 @@
+#!/usr/bin/perl -w
+
+use strict;
+use blib;
+
+use Test::More tests => 9;
+
+BEGIN {
+       use lib 'lib';
+       use_ok( 'WebPAC::Test' );
+       use_ok( 'WebPAC::Output::CouchDB' );
+       use_ok( 'SWISH::API' );
+}
+
+my $path = "$abs_path/kino/";
+
+ok(my $out = new WebPAC::Output::CouchDB({
+       database => 'webpac2',
+       %LOG
+}), "new");
+
+ok( $out->init, 'init' );
+
+my $ds = {
+       'Source' => {
+               'name' => 'Izvor: ',
+               'search' => [ 'tko zna' ]
+       },
+       'ID' => {
+               'search' => [ 'id' ],
+       },
+       'Array' => {
+               'search' => [ qw/a1 a2 s3 a4 a5/ ],
+       },
+       'foo' => {
+               'search' => [ 'foo' ],
+       },
+};
+
+ok( $out->add( 42, $ds ), 'add 42' );
+
+my @strange = ( qw/èajðinica odma¹æivanje ¾abokreèina ¹uma/ );
+
+ok( $out->add( 99, { foo => { search => [ @strange ] } } ), 'add 99' );
+
+ok( $out->add( 100, { foo => { search => [ qw/foo bar baz/ ] } } ), 'add 100' );
+
+ok( $out->finish, 'finish' );
+