1 |
dpavlin |
17 |
#!/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; |