1 |
#!/usr/bin/perl |
2 |
|
3 |
use warnings; |
4 |
use strict; |
5 |
|
6 |
use CouchDB::Client; |
7 |
use Getopt::Long; |
8 |
use Data::Dump qw/dump/; |
9 |
|
10 |
my $uri = 'http://localhost:5984/'; |
11 |
|
12 |
my ( $list, @delete, @dump ) = ( 1 ); |
13 |
|
14 |
GetOptions( |
15 |
'uri=s' => \$uri, |
16 |
'list!' => \$list, |
17 |
'delete|drop=s@' => \@delete, |
18 |
'dump=s@' => \@dump, |
19 |
) or die "$0: $!"; |
20 |
|
21 |
my $c = CouchDB::Client->new( uri => $uri ); |
22 |
$c->testConnection or die "The server cannot be reached"; |
23 |
warn "# $uri ",dump( $c->serverInfo ),"\n"; |
24 |
|
25 |
$c->req( 'DELETE', "/$_" ) foreach @delete; |
26 |
|
27 |
foreach my $dump ( @dump ) { |
28 |
warn "## dump $dump\n"; |
29 |
die "$dump doesn't exist\n" unless $c->dbExists( $dump ); |
30 |
my $db = $c->newDB( $dump ); |
31 |
foreach ( @{ $db->listDocIdRevs } ) { |
32 |
warn "DOC = ",dump( $_ ); |
33 |
my $doc = $db->newDoc( $_->{id}, $_->{rev} ); |
34 |
$doc->retrieve; |
35 |
warn dump( $doc ); |
36 |
} |
37 |
} |
38 |
|
39 |
print join("\n", @{ $c->listDBNames } ) if $list; |