couchdb-changes.pl

   1 #!/usr/bin/perl
   2
   3 # http://wiki.apache.org/couchdb/HTTP_database_API#Changes
   4
   5 use warnings;
   6 use strict;
   7
   8 use lib 'common/mojo/lib';
   9
  10 use Mojo::Client;
  11 use Mojo::JSON;
  12 use Data::Dump qw(dump);
  13 use JSON::XS;
  14
  15 my $url = 'http://localhost:5984/monitor/_changes?feed=continuous;include_docs=true;since=';
  16 my $seq = 0;
  17
  18 my $client = Mojo::Client->new;
  19 my $json   = Mojo::JSON->new;
  20 my $error;
  21
  22 $client->keep_alive_timeout(90); # couchdb timeout is 60s
  23
  24 while( ! $error ) {
  25
  26         warn "GET $url$seq\n";
  27         my $tx = $client->build_tx( GET => $url . $seq );
  28         $tx->res->body(sub{
  29                 my ( $content, $body ) = @_;
  30
  31                 warn "## BODY $body\n";
  32
  33                 if ( length($body) == 0 ) {
  34                         warn "# empty chunk, heartbeat?\n";
  35                         return;
  36                 }
  37
  38                 foreach my $change ( split(/\r?\n/, $body) ) { # we can get multiple documents in one chunk
  39
  40                         my $data = $json->decode($change);
  41
  42                         if ( exists $data->{error} ) {
  43                                 $error = $data;
  44                         } elsif ( exists $data->{last_seq} ) {
  45                                 $seq = $data->{last_seq};
  46                         } elsif ( $data->{seq} <= $seq ) {
  47                                 warn "# stale $body";
  48                         } elsif ( exists $data->{changes} ) {
  49
  50                                 my $id  = $data->{id} || warn "no id?";
  51                                 my $rev = $data->{changes}->[0]->{rev} || warn "no rev?";
  52                                    $seq = $data->{seq} || warn "no seq?";
  53
  54                                 warn "# ",dump( $data ); # FIXME custom code here
  55
  56                         } else {
  57                                 warn "UNKNOWN", dump($data);
  58                         }
  59
  60                 }
  61
  62         });
  63         $client->start($tx);
  64
  65 }
  66
  67 die dump($error) if $error;