[Debian-l10n-commits] [SCM] DDTP - Debian Descriptions Translation Project branch, master, updated. 20080812.0-116-g9d06ac3
Martijn van Oosterhout
kleptog at dukas.debian.org
Sat Jun 16 16:48:23 UTC 2012
The following commit has been merged in the master branch:
commit 19d9456f567b1775dd2ef24367da865f1dfb4c4a
Author: Martijn van Oosterhout <kleptog at svana.org>
Date: Fri Jun 15 18:04:52 2012 +0200
Replace the DDTSS library using BDB with a wrapper which refers to a table in the PostgreSQL database.
diff --git a/ddtss/DDTSS.pm b/ddtss/DDTSS.pm
index 8c3b442..76f7e8e 100644
--- a/ddtss/DDTSS.pm
+++ b/ddtss/DDTSS.pm
@@ -1,4 +1,7 @@
#use strict;
+
+die "DDTSS.pm is deprecated, use the DDTSS_Pg.pm module which provides the same interface but transparently uses the PostgreSQL database";
+
use POSIX qw(strftime);
use DB_File::Lock;
use Text::Iconv;
diff --git a/ddtss/DDTSS.pm b/ddtss/DDTSS_Pg.pm
similarity index 93%
copy from ddtss/DDTSS.pm
copy to ddtss/DDTSS_Pg.pm
index 8c3b442..bbfd8b5 100644
--- a/ddtss/DDTSS.pm
+++ b/ddtss/DDTSS_Pg.pm
@@ -1,62 +1,44 @@
#use strict;
use POSIX qw(strftime);
-use DB_File::Lock;
+#use DB_File::Lock;
+use Pg_BDB;
+use Data::Dumper;
use Text::Iconv;
use Mail::Sender;
-use Algorithm::Diff qw(compact_diff);
+use Algorithm::Diff::XS qw(compact_diff);
use ddts_lib;
my $COUNT = 0;
-chdir '/org/ddtp.debian.net/ddtss' or die;
-my $db_hash = "ddtss2.db";
-
-my %hash;
-
# Open DB for write mode
sub DDTSS_Open_Write
{
- my $db = tie %hash, 'DB_File::Lock', $db_hash, O_RDWR, 0666, $DB_BTREE, "write";
- if( not defined $db )
- { die "Unable to open DB file for writing ($!)\n" }
+ my $db = Pg_BDB->open_write();
return $db;
}
# Open DB for read mode
sub DDTSS_Open_Read
{
- my $db = tie %hash, 'DB_File::Lock', $db_hash, O_RDONLY, 0666, $DB_BTREE, "read";
- if( not defined $db )
- { die "Unable to open DB file for reading ($!)\n" }
+ my $db = Pg_BDB->open_read();
return $db;
}
# close DB, undef caller reference
sub DDTSS_Close
{
+ $_[0]->close();
undef $_[0];
- untie %hash;
}
sub ddtss_match
{
- my($db, $prefix, $sub ) = @_;
+ my($db, $prefix, $sub, $regex) = @_;
# print "ddtss_match: $prefix\n";
- my ($key,$value);
-
- $key = $prefix;
- $prefix = qr/^$prefix/;
-
- for (my $status = $db->seq($key, $value, R_CURSOR) ;
- $status == 0 and $key =~ /$prefix/;
- $status = $db->seq($key, $value, R_NEXT) )
- {
-# print "Key: $key, Data: $value\n";
- $sub->($key,$value)
- }
+ $db->search($prefix, $sub, $regex);
}
# Get list of suggestions packages
@@ -111,10 +93,36 @@ sub DDTSS_Get_Untranslated
my $lock = DDTSS_IsLocked( $db, "$lang/packages/$package", $user );
push @todo, [$prio, $package, $lock];
- } );
+ }, "^$lang/packages/([\\w.+-]+)\$" );
return [ map { [ $_->[1], $_->[0], $_->[2] ] } sort { $b->[0] <=> $a->[0] } @todo ];
}
+# Get list of untranslated packages
+sub DDTSS_Get_Users
+{
+ my $db = shift;
+
+ my ($key,$value);
+ my @todo;
+
+ ddtss_match( $db, "aliases/", sub {
+ my ($key,$value) = @_;
+ push @todo, [$key, $value];
+ }, "^aliases/" );
+ return [ map { [ $_->[0], $_->[1] ] } sort { $b->[0] <=> $a->[0] } @todo ];
+}
+
+# Get list of untranslated packages
+sub DDTSS_Get_PartTrans
+{
+ my $db = shift;
+ my $milestone = shift;
+
+ my @packages=get_parttrans($milestone);
+
+ return (@packages);
+}
+
# Get list of packages for review
sub DDTSS_Get_ForReview
{
@@ -167,7 +175,7 @@ sub DDTSS_Get_ForReview
}
push @todo, [$package,$str,$reviewable,$timestamp];
- } );
+ }, "^$lang/packages/([\\w.+-]+)\$" );
return [ sort { $a->[3] cmp $b->[3] } @todo ];
}
@@ -209,6 +217,7 @@ sub DDTSS_IsLocked
{ $db->del( "lock/$key" ); $lockuser = ""; $locktime = 0 }
else
{
+# print STDERR "field=$field\n";
($lockuser,$locktime) = split /,/, $field;
# Hack to fix breakage by reparenting, but good check anyway
if( $locktime !~ /^\d+$/ )
@@ -249,9 +258,7 @@ sub DDTSS_Kill_Oldest_Request
my($key,$value);
- for (my $status = $db->seq($key, $value, R_FIRST) ;
- $status == 0 ;
- $status = $db->seq($key, $value, R_NEXT) )
+ ddtss_match($db, "$lang/requests/", sub
{
# Found a sent request
if( $key =~ m,^$lang/requests/, )
@@ -259,7 +266,7 @@ sub DDTSS_Kill_Oldest_Request
if( $value < $oldest )
{ $oldest = $value }
}
- }
+ });
$db->del( "$lang/requests/$oldest" );
return;
@@ -269,7 +276,7 @@ sub DDTSS_Load_Wordlist
{
my $lang = shift;
my $fh;
- open $fh, "words-$lang.txt" or return undef;
+ open $fh, "/org/ddtp.debian.net/ddtss/words-$lang.txt" or return undef;
my $wordlist = {};
@@ -345,7 +352,7 @@ sub DDTSS_Get_Translated
my $state = ($value =~ /add the translation in the db/) ? "ok" : "check";
return unless $key =~ m,$lang/logs/(\d+)/([\w.+-]+)$,;
push @trans, [ $2, $state, strftime( "%a %b %e %H:%M:%S %Y", localtime $1), $key ];
- } );
+ }, "^$lang/logs/(\\d+)/([\\w.+-]+)\$" );
# Should be ordered by time ascending
@trans = reverse @trans; # Now descending
@@ -418,15 +425,17 @@ sub DDTSS_CreateDiff
if( $words )
{
- @str1 = grep { defined } split /\b|(\s)/, $str1;
- @str2 = grep { defined } split /\b|(\s)/, $str2;
+ @str1 = grep { defined and length } split /\b|(\s)/, $str1;
+ @str2 = grep { defined and length } split /\b|(\s)/, $str2;
}
else
{
- @str1 = grep { defined } split /\b|(\s)|(?=[\xC0-\xF7])/, $str1;
- @str2 = grep { defined } split /\b|(\s)|(?=[\xC0-\xF7])/, $str2;
+ @str1 = grep { defined and length } split /\b|(\s)|(?=[\xC0-\xF7])/, $str1;
+ @str2 = grep { defined and length } split /\b|(\s)|(?=[\xC0-\xF7])/, $str2;
}
+# if (-t) { print Dumper([\@str1, \@str2, scalar(@str1), scalar(@str2)]) }
my $diff = compact_diff( \@str1, \@str2 );
+# if (-t) { print Dumper([$diff]) }
my $changed = 0;
my $count = scalar(@$diff)/2 - 2;
@@ -487,7 +496,7 @@ sub DDTSS_GetStats
}
}
# print "Key: $key: $hash{$key}\n";
- } );
+ }, "^(\\w+)/(done|packages)/([\\w+.-]+)\$" );
for my $lang (keys %score)
{
@@ -526,7 +535,7 @@ sub DDTSS_Reparent_Owners
-t STDERR and print STDERR "Reparent[$key]: $value => $newvalue\n";
push @todo, [$key, $newvalue];
- } );
+ }, "^\\w+/packages/[\\w.+-]+/(owner|reviewers)\$" );
for my $task (@todo)
{
@@ -756,7 +765,7 @@ sub process_reviewed
ddtss_match( $db, "$lang/packages/", sub {
my ($key, $value) = @_;
- return unless $key =~ m,$lang/packages/([\w.+-]+)$,;
+ return unless $key =~ m,^$lang/packages/([\w.+-]+)$,;
my $package = $1;
return unless $value =~ /^forreview/;
@@ -784,7 +793,7 @@ sub process_reviewed
{
push @todo, [ $lang, $package ];
}
- } );
+ }, "^$lang/packages/([\\w.+-]+)\$" );
}
DDTSS_Close($db);
diff --git a/ddtss/Pg_BDB.pm b/ddtss/Pg_BDB.pm
new file mode 100644
index 0000000..7aad35e
--- /dev/null
+++ b/ddtss/Pg_BDB.pm
@@ -0,0 +1,170 @@
+use strict;
+
+package Pg_BDB;
+
+use DBI;
+use DBD::Pg qw(:pg_types);
+#DBI->trace(1);
+my @DSN = ("DBI:Pg:dbname=ddtp", "", "");
+
+my ($_dbh, $_inuse);
+sub _get_handle()
+{
+ # Only open connection once
+ if (not defined $_dbh)
+ {
+ $_dbh = DBI->connect(@DSN,
+ { PrintError => 0,
+ RaiseError => 1,
+ AutoCommit => 1,
+ });
+
+ die $DBI::errstr unless $_dbh;
+ }
+
+ die "Reuse of DB" if $_inuse;
+
+ $_inuse = 1;
+ return $_dbh;
+}
+
+sub _release_handle()
+{
+ die "Release of DB without use" unless $_inuse;
+ $_inuse = 0;
+}
+
+sub open_read()
+{
+ my $self = bless { mode => "r", dbh => _get_handle() }, 'Pg_BDB';
+
+ my $dbh = $self->{dbh};
+ $dbh->begin_work or die $dbh->errstr;
+ $dbh->do("LOCK TABLE ddtss IN ACCESS SHARE MODE") or die $dbh->errstr;
+
+ return $self;
+}
+
+sub open_write()
+{
+ my $self = bless { mode => "w", dbh => _get_handle() }, 'Pg_BDB';
+
+ my $dbh = $self->{dbh};
+ $dbh->begin_work or die $dbh->errstr;
+ $dbh->do("LOCK TABLE ddtss IN ACCESS EXCLUSIVE MODE") or die $dbh->errstr;
+
+ return $self;
+}
+
+sub close()
+{
+ my $self = shift;
+ _release_handle();
+ my $dbh = $self->{dbh};
+ $self->{dbh} = undef;
+ $dbh->commit;
+}
+
+# These methods emulate the berkeley DB interface
+sub get($$)
+{
+ my $self = shift;
+ my $key = shift;
+ my $value = undef;
+ my $res;
+
+ my $dbh = $self->{dbh};
+
+ my $sth = $dbh->prepare("SELECT value FROM ddtss WHERE key = ?", {});
+ $sth->execute($key) or die $dbh->errstr;
+ if ($sth->rows)
+ {
+ ($value) = $sth->fetchrow_array;
+ $res = 0;
+ }
+ else
+ {
+ $res = 1;
+ }
+ $_[0] = $value;
+# print STDERR "get($key) => [".(defined($value)?$value:'(undef)')."]\n";
+
+ return $res;
+}
+
+sub put($$)
+{
+ my $self = shift;
+ my $key = shift;
+ my $value = shift;
+
+ my $dbh = $self->{dbh};
+
+ if( $self->{mode} eq "r" )
+ {
+ warn "put($key) in readonly transaction";
+ return 1;
+ }
+
+ my $sth = $dbh->prepare("UPDATE ddtss SET value = ? WHERE key = ?", {});
+ $sth->bind_param(1, undef, { pg_type => DBD::Pg::PG_BYTEA });
+ $sth->execute($value, $key) or die $dbh->errstr;
+
+ if ($sth->rows == 0 ) # No rows updated, needs insert
+ {
+ $sth = $dbh->prepare("INSERT INTO ddtss (key, value) VALUES (?,?)", {});
+ $sth->bind_param(2, undef, { pg_type => DBD::Pg::PG_BYTEA });
+ $sth->execute($key, $value) or die $dbh->errstr;
+ }
+ return undef;
+}
+
+sub del($)
+{
+ my $self = shift;
+ my $key = shift;
+
+ my $dbh = $self->{dbh};
+
+ if( $self->{mode} eq "r" )
+ {
+ warn "del($key) in readonly transaction";
+ return 1;
+ }
+
+ my $sth = $dbh->prepare("DELETE FROM ddtss WHERE key = ?", {});
+ $sth->execute($key) or die $dbh->errstr;
+
+ return undef;
+}
+
+# And this is the search interface, to be used by the ddtss_match method
+sub search($&;$)
+{
+ my $self = shift;
+ my $prefix = shift;
+ my $callback = shift;
+ my $regex = shift; # Regex is optional, for performence on the db side really
+
+ my $sth;
+ my $dbh = $self->{dbh};
+
+ warn "prefix: $prefix\n";
+ warn "regex: $regex\n";
+ if( defined $regex )
+ {
+ $sth = $dbh->prepare("SELECT key, value FROM ddtss WHERE key LIKE ? AND key ~ ? ORDER BY key", {});
+ $sth->execute($prefix."%", $regex);
+ }
+ else
+ {
+ $sth = $dbh->prepare("SELECT key, value FROM ddtss WHERE key LIKE ? ORDER BY key", {});
+ $sth->execute($prefix."%");
+ }
+ while ( my $row = $sth->fetchrow_arrayref )
+ {
+ $callback->( $row->[0], $row->[1] );
+ }
+ return;
+}
+1;
diff --git a/ddtss/ddtss-process b/ddtss/ddtss-process
index 6118d54..545e053 100755
--- a/ddtss/ddtss-process
+++ b/ddtss/ddtss-process
@@ -15,7 +15,7 @@ BEGIN {
}
# This is the installation directory
use lib '/home/kleptog/perl/ddtss2';
-use DDTSS;
+use DDTSS_Pg;
process_todo();
process_reviewed();
diff --git a/ddtss/ddtss-setup b/ddtss/ddtss-setup
index 010ba83..7ce131c 100755
--- a/ddtss/ddtss-setup
+++ b/ddtss/ddtss-setup
@@ -4,75 +4,69 @@
# create the initial database, or to update the parameters later on.
use strict;
+use Pg_BDB;
-my @langs = qw(da de es fi fr hu id it ja km_KH ko nb nl pl sv zh_CN pt pt_BR eo zh_TW ca cs uk vi ml ru sk);
+my @langs = qw(da de es fi fr gl hu id it ja km_KH kn ko nb nl pl sv zh_CN pt pt_BR eo zh_TW ca cs uk vi ml ru sk sr bg);
my @disabled_langs = qw(go);
-use DB_File::Lock;
-my %hash;
-my $db_hash = "ddtss2.db";
-umask 0111;
-
-tie %hash, 'DB_File::Lock', $db_hash, O_RDWR | O_CREAT, 0666, $DB_BTREE, "write"
- or die "Cannot tie $db_hash ($!)\n";
-
+my $db = Pg_BDB->open_write();
# Language codes available for translations
-$hash{'langs'} = join(",", @langs);
-$hash{"langs/disabled"} = join(",", at disabled_langs);
+$db->put('langs', join(",", @langs));
+$db->put("langs/disabled", join(",", at disabled_langs));
# Set default values for all languages
for my $lang (@langs)
{
# Minimum number of untranslated descriptions to have at any time
- $hash{"$lang/config/minuntranslated"} = '1';
+ $db->put("$lang/config/minuntranslated", '1');
# Number of reviewers before sending, can be zero
- $hash{"$lang/config/numreviewers"} = '3';
+ $db->put("$lang/config/numreviewers", '3');
# Do we require translators to be registered?
- $hash{"$lang/config/requirelogin"} = '0';
+ $db->put("$lang/config/requirelogin", '1');
}
# Special value for nl
-$hash{'nl/config/minuntranslated'} = '3';
-$hash{'nl/config/numreviewers'} = '2';
-
-$hash{'de/config/minuntranslated'} = '4';
-$hash{'da/config/minuntranslated'} = '3';
-$hash{'da/config/numreviewers'} = '2';
-$hash{'ja/config/minuntranslated'} = '1';
-$hash{'km_KH/config/minuntranslated'} = '1';
-$hash{'fr/config/minuntranslated'} = '4';
-$hash{'fr/config/numreviewers'} = '2';
-$hash{'es/config/minuntranslated'} = '50';
-$hash{'es/config/numreviewers'} = '2';
-$hash{'pl/config/minuntranslated'} = '2';
-$hash{'it/config/minuntranslated'} = '3';
-$hash{'fi/config/minuntranslated'} = '2';
-$hash{'pt_PT/config/minuntranslated'} = '3';
-$hash{'pt_PT/config/numreviewers'} = '2';
-$hash{'eo/config/numreviewers'} = '1';
-$hash{'pt_BR/config/minuntranslated'} = '3';
-$hash{'zh_TW/config/numreviewers'} = 2;
-$hash{'zh_TW/config/minuntranslated'} = 2;
-$hash{'ca/config/minuntranslated'} = 2;
-$hash{'cs/config/minuntranslated'} = 2;
-$hash{'cs/config/numreviewers'} = '2';
-$hash{'zh_CN/config/minuntranslated'} = 2;
-$hash{'vi/config/requirelogin'} = '1';
-$hash{'vi/config/numreviewers'} = '1';
-$hash{'ru/config/numreviewers'} = '2';
-$hash{'sk/config/numreviewers'} = '1';
+$db->put('ca/config/minuntranslated', 2);
+$db->put('cs/config/minuntranslated', 2);
+$db->put('cs/config/numreviewers', '2');
+$db->put('da/config/minuntranslated', '3');
+$db->put('da/config/numreviewers', '2');
+$db->put('da/config/requirelogin', '0');
+$db->put('de/config/minuntranslated', '4');
+$db->put('de/config/requirelogin', '0');
+$db->put('eo/config/numreviewers', '1');
+$db->put('es/config/minuntranslated', '50');
+$db->put('es/config/numreviewers', '2');
+$db->put('fi/config/minuntranslated', '2');
+$db->put('fr/config/minuntranslated', '4');
+$db->put('fr/config/numreviewers', '2');
+$db->put('it/config/minuntranslated', '3');
+$db->put('ja/config/minuntranslated', '1');
+$db->put('km_KH/config/minuntranslated', '1');
+$db->put('kn/config/minuntranslated', '1');
+$db->put('nl/config/minuntranslated', '3');
+$db->put('nl/config/numreviewers', '2');
+$db->put('pl/config/minuntranslated', '2');
+$db->put('pl/config/requirelogin', '0');
+$db->put('pt_BR/config/minuntranslated', '3');
+$db->put('pt_PT/config/minuntranslated', '3');
+$db->put('pt_PT/config/numreviewers', '2');
+$db->put('ru/config/numreviewers', '2');
+$db->put('sk/config/numreviewers', '1');
+$db->put('uk/config/requirelogin', '0');
+$db->put('vi/config/numreviewers', '1');
+$db->put('vi/config/requirelogin', '1');
+$db->put('zh_CN/config/minuntranslated', 2);
+$db->put('zh_TW/config/minuntranslated', 2);
+$db->put('zh_TW/config/numreviewers', 2);
# Email address of DDTS
-$hash{'config/serveremail'} = '<pdesc at ddtp.debian.net>';
+$db->put('config/serveremail', '<pdesc at ddtp.debian.net>');
# This email (if present) will be BCC'd for any outgoing email
-$hash{'config/debugemail'} = '<test at kleptog.org>';
+$db->put('config/debugemail', '<test at kleptog.org>');
# Your email address. The DDTS will send its replies to this address so
# you have to be able to feed those emails to ddtss-process
-$hash{'config/clientemail'} = 'Martijns DDTSS <ddtss at kleptog.org>';
-
-#delete $hash{'todo/in-data/13843.1155550817'};
-
-#delete $hash{'aliases/felipewiel'};
+$db->put('config/clientemail', 'Martijns DDTSS <ddtss at kleptog.org>');
-untie %hash;
+$db->close();
--
DDTP - Debian Descriptions Translation Project
More information about the Debian-l10n-commits
mailing list