1 |
#!/usr/bin/perl -w |
2 |
|
3 |
use strict; |
4 |
use DBI; |
5 |
use CouchDB::Client; |
6 |
use Data::Dump qw/dump/; |
7 |
|
8 |
$|++; |
9 |
|
10 |
my @tables; |
11 |
|
12 |
my ( $dbi, $database ) = ( 'DBI:Pg:dbname=','carnetweb' ); |
13 |
( $dbi, $database ) = ( 'DBI:mysql:database=','reblog' ); |
14 |
@tables = ( 'items','items_userdata','feeds','feeds_userdata' ); |
15 |
|
16 |
my $dbh = DBI->connect($dbi . $database,"","") || die $DBI::errstr; |
17 |
|
18 |
if ( ! @tables ) { |
19 |
|
20 |
my $sth = $dbh->prepare(qq{ |
21 |
select table_name from information_schema.tables where table_schema = 'public' |
22 |
}) || die $dbh->errstr(); |
23 |
$sth->execute() || die $sth->errstr(); |
24 |
|
25 |
print "found ",$sth->rows," tables to import...\n"; |
26 |
|
27 |
while (my ($table) = $sth->fetchrow_array ) { |
28 |
# anketa|changelog|banners|brand|faq|file|forum|galerija|grupe|kalendar |
29 |
next unless $table =~ m/(banners|brand|faq|file|forum|galerija|kalendar|kategorija|news|picture|rss|users)/; |
30 |
push @tables, $table; |
31 |
} |
32 |
} |
33 |
|
34 |
my $c = CouchDB::Client->new(uri => 'http://localhost:5984/'); |
35 |
$c->testConnection or die "The server cannot be reached"; |
36 |
print "CouchDB version " . $c->serverInfo->{version} . "\n"; |
37 |
my $db = $c->newDB( $database ); |
38 |
$db->delete if $c->dbExists( $database ); |
39 |
$db->create; |
40 |
|
41 |
foreach my $table ( @tables ) { |
42 |
my $sth = $dbh->prepare(qq{ select * from $table }) || die $dbh->errstr(); |
43 |
$sth->execute || die $sth->errstr(); |
44 |
my @pk = $dbh->primary_key( undef, undef, $table ); |
45 |
|
46 |
print "import ", $sth->rows, " rows from $table ",dump( @pk ),"...\n"; |
47 |
|
48 |
while (my $row = $sth->fetchrow_hashref() ) { |
49 |
my $_id = $table . ':' . join(",", map { $row->{$_} } @pk); |
50 |
my $doc = $db->newDoc( $_id ); |
51 |
$row->{table} = $table; |
52 |
$doc->{data} = $row; |
53 |
eval { $doc->create }; |
54 |
print "$_id ", dump( $row ), $@ if $@; |
55 |
} |
56 |
} |
57 |
|