Rebase tree.

1 files changed, 417 insertions, 0 deletions

diff --git a/lib/LXRng/Index/Pg.pm b/lib/LXRng/Index/Pg.pm
new file mode 100644
index 0000000..05fe3a0
--- /dev/null
+++ b/lib/LXRng/Index/Pg.pm
@@ -0,0 +1,417 @@
+package LXRng::Index::Pg;
+
+use strict;
+use DBI;
+
+use base qw(LXRng::Index::DBI);
+
+sub dbh {
+    my ($self) = @_;
+
+    $$self{'dbh'} ||= DBI->connect('dbi:Pg:'.$$self{'db_spec'},
+				   $$self{'db_user'}, $$self{'db_pass'},
+				   {AutoCommit => 1,
+				    RaiseError => 1})
+	or die($DBI::errstr);
+    
+    return $$self{'dbh'};
+}
+
+sub init_db {
+    my ($self) = @_;
+
+    my $dbh = $self->dbh;
+    my $pre = $self->prefix;
+    $dbh->{AutoCommit} = 0;
+
+    $dbh->do(qq{create sequence ${pre}treenum}) or die($dbh->errstr);
+    $dbh->do(qq{create sequence ${pre}relnum}) or die($dbh->errstr);
+    $dbh->do(qq{create sequence ${pre}filenum cache 50}) or die($dbh->errstr);
+    $dbh->do(qq{create sequence ${pre}revnum cache 50}) or die($dbh->errstr);
+    $dbh->do(qq{create sequence ${pre}symnum cache 50}) or die($dbh->errstr);
+    $dbh->do(qq{create sequence ${pre}identnum cache 50}) or die($dbh->errstr);
+
+    $dbh->do(qq{
+	create table ${pre}charsets
+	    (
+	     id			serial,
+	     name		varchar,
+	     primary key	(id)
+	     )
+	}) or die($dbh->errstr);
+
+    $dbh->do(qq{insert into ${pre}charsets(name) values ('ascii')})
+	or die($dbh->errstr);
+    $dbh->do(qq{insert into ${pre}charsets(name) values ('utf-8')})
+	or die($dbh->errstr);
+    $dbh->do(qq{insert into ${pre}charsets(name) values ('iso8859-1')})
+	or die($dbh->errstr);
+
+    $dbh->do(qq{
+	create table ${pre}trees
+	    (
+	     id			int default nextval('${pre}treenum'),
+	     name		varchar,
+	     primary key	(id)
+	     )
+	}) or die($dbh->errstr);
+
+    $dbh->do(qq{
+	create table ${pre}releases
+	    (
+	     id			int default nextval('${pre}relnum'),
+	     id_tree		int references ${pre}trees(id),
+	     release_tag	varchar,
+	     is_indexed		bool default 'f',
+	     primary key	(id)
+	     )
+	}) or die($dbh->errstr);
+
+    $dbh->do(qq{
+	create table ${pre}files
+	    (
+	     id			int default nextval('${pre}filenum'),
+	     path		varchar,
+	     primary key	(id),
+	     unique		(path)
+	     )
+	}) or die($dbh->errstr);
+
+    $dbh->do(qq{
+	create table ${pre}revisions
+	    (
+	     id			int default nextval('${pre}revnum'),
+	     id_file		int references ${pre}files(id),
+	     revision		varchar,
+	     last_modified_gmt	timestamp without time zone, -- GMT
+	     last_modified_tz	varchar(5), -- Optional TZ
+	     body_charset	int references ${pre}charsets(id),
+	     primary key	(id),
+	     unique		(id_file, revision)
+	     )
+	}) or die($dbh->errstr);
+
+    $dbh->do(qq{
+	create table ${pre}filestatus
+	    (
+	     id_rfile		int references ${pre}revisions(id),
+	     indexed		bool default 'f',
+	     referenced		bool default 'f',
+	     hashed		bool default 'f',
+	     primary key	(id_rfile)
+	     )
+	}) or die($dbh->errstr);
+
+    $dbh->do(qq{
+	create table ${pre}hashed_documents
+	    (
+	     id_rfile		int references ${pre}revisions(id),
+	     doc_id		int not null,
+	     primary key	(id_rfile)
+	     )
+	}) or die($dbh->errstr);
+
+    $dbh->do(qq{
+	create table ${pre}filereleases
+	    (
+	     id_rfile		int references ${pre}revisions(id),
+	     id_release		int references ${pre}releases(id),
+	     primary key	(id_rfile, id_release)
+	     )
+	}) or die($dbh->errstr);
+
+    $dbh->do(qq{
+	create table ${pre}includes
+	    (
+	     id_rfile		int references ${pre}revisions(id),
+	     id_include_path	int references ${pre}files(id)
+	     )
+	}) or die($dbh->errstr);
+
+    $dbh->do(qq{
+	create table ${pre}symbols
+	    (
+	     id			int default nextval('${pre}symnum'),
+	     name		varchar,
+	     primary key	(id),
+	     unique		(name)
+	     )
+	}) or die($dbh->errstr);
+
+    $dbh->do(qq{
+	create table ${pre}identifiers
+	    (
+	     id 		int default nextval('${pre}identnum'),
+	     id_symbol		int references ${pre}symbols(id) deferrable,
+	     id_rfile		int references ${pre}revisions(id) deferrable,
+	     line		int,
+	     type		char(1),
+	     context		int references ${pre}identifiers(id) deferrable,
+	     primary key	(id)
+	     )
+	}) or die($dbh->errstr);
+
+    $dbh->do(qq{
+	create table ${pre}usage
+	    (
+	     id_rfile		int references ${pre}revisions(id) deferrable,
+	     id_symbol		int references ${pre}symbols(id) deferrable,
+	     line		int
+	     )
+	}) or die($dbh->errstr);
+
+    $dbh->do(qq{alter table ${pre}usage alter column id_symbol set statistics 250});
+    $dbh->do(qq{alter table ${pre}identifiers alter column id_symbol set statistics 250});
+
+    $dbh->do(qq{create index ${pre}symbol_idx1 on ${pre}symbols using btree (name)})
+	or die($dbh->errstr);
+    $dbh->do(qq{create index ${pre}ident_idx1 on ${pre}identifiers using btree (id_symbol)})
+	or die($dbh->errstr);
+    $dbh->do(qq{create index ${pre}ident_idx2 on ${pre}identifiers using btree (id_rfile)})
+	or die($dbh->errstr);
+    $dbh->do(qq{create index ${pre}ident_idx3 on ${pre}identifiers using btree (id_symbol, id_rfile)})
+	or die($dbh->errstr);
+    $dbh->do(qq{create index ${pre}usage_idx1 on ${pre}usage using btree (id_symbol)})
+	or die($dbh->errstr);
+    $dbh->do(qq{create index ${pre}usage_idx2 on ${pre}usage using btree (id_rfile)})
+	or die($dbh->errstr);
+    $dbh->do(qq{create index ${pre}include_idx1 on ${pre}includes using btree (id_rfile)})
+	or die($dbh->errstr);
+    $dbh->do(qq{create index ${pre}file_idx1 on ${pre}files using btree (path)})
+	or die($dbh->errstr);
+
+    $dbh->do(qq{grant select on ${pre}charsets to public}) or die($dbh->errstr);
+    $dbh->do(qq{grant select on ${pre}trees to public}) or die($dbh->errstr);
+    $dbh->do(qq{grant select on ${pre}releases to public}) or die($dbh->errstr);
+    $dbh->do(qq{grant select on ${pre}files to public}) or die($dbh->errstr);
+    $dbh->do(qq{grant select on ${pre}releases to public}) or die($dbh->errstr);
+    $dbh->do(qq{grant select on ${pre}filereleases to public}) or die($dbh->errstr);
+    $dbh->do(qq{grant select on ${pre}filestatus to public}) or die($dbh->errstr);
+    $dbh->do(qq{grant select on ${pre}hashed_documents to public}) or die($dbh->errstr);
+    $dbh->do(qq{grant select on ${pre}includes to public}) or die($dbh->errstr);
+    $dbh->do(qq{grant select on ${pre}symbols to public}) or die($dbh->errstr);
+    $dbh->do(qq{grant select on ${pre}identifiers to public}) or die($dbh->errstr);
+    $dbh->do(qq{grant select on ${pre}usage to public}) or die($dbh->errstr);
+    $dbh->do(qq{grant select on ${pre}revisions to public}) or die($dbh->errstr);
+
+    $dbh->commit();
+    $dbh->{AutoCommit} = 0;
+}
+
+sub drop_db {
+    my ($self) = @_;
+
+    my $dbh = $self->dbh;
+    my $pre = $self->prefix;
+    local($dbh->{RaiseError}) = 0;
+
+    $dbh->do(qq{drop index ${pre}symbol_idx1});
+    $dbh->do(qq{drop index ${pre}ident_idx1});
+    $dbh->do(qq{drop index ${pre}ident_idx2});
+    $dbh->do(qq{drop index ${pre}usage_idx1});
+    $dbh->do(qq{drop index ${pre}usage_idx2});
+    $dbh->do(qq{drop index ${pre}include_idx1});
+    $dbh->do(qq{drop index ${pre}file_idx1});
+
+    $dbh->do(qq{drop table ${pre}usage});
+    $dbh->do(qq{drop table ${pre}identifiers});
+    $dbh->do(qq{drop table ${pre}symbols});
+    $dbh->do(qq{drop table ${pre}includes});
+    $dbh->do(qq{drop table ${pre}filereleases});
+    $dbh->do(qq{drop table ${pre}hashed_documents});
+    $dbh->do(qq{drop table ${pre}filestatus});
+    $dbh->do(qq{drop table ${pre}revisions});
+    $dbh->do(qq{drop table ${pre}files});
+    $dbh->do(qq{drop table ${pre}releases});
+    $dbh->do(qq{drop table ${pre}trees});
+    $dbh->do(qq{drop table ${pre}charsets});
+
+    $dbh->do(qq{drop sequence ${pre}treenum});
+    $dbh->do(qq{drop sequence ${pre}relnum});
+    $dbh->do(qq{drop sequence ${pre}filenum});
+    $dbh->do(qq{drop sequence ${pre}revnum});
+    $dbh->do(qq{drop sequence ${pre}symnum});
+    $dbh->do(qq{drop sequence ${pre}identnum});
+}
+
+sub _add_tree {
+    my ($self, $tree) = @_;
+
+    my $dbh = $self->dbh;
+    my $pre = $self->prefix;
+    my $sth = $$self{'sth'}{'_add_tree_ins'} ||=
+	$dbh->prepare(qq{insert into ${pre}trees(name) values (?)});
+    $sth->execute($tree);
+    
+    $sth = $$self{'sth'}{'_add_tree_insid'} ||=
+	$dbh->prepare(qq{select currval('${pre}treenum')});
+    $sth->execute();
+    my ($id) = $sth->fetchrow_array();
+    $sth->finish();
+
+    return $id;
+}
+
+sub _add_release {
+    my ($self, $tree_id, $release) = @_;
+
+    my $dbh = $self->dbh;
+    my $pre = $self->prefix;
+    my $sth = $$self{'sth'}{'_add_relase_ins'} ||=
+	$dbh->prepare(qq{insert into ${pre}releases(id_tree, release_tag) 
+			     values (?, ?)});
+    $sth->execute($tree_id, $release);
+    
+    $sth = $$self{'sth'}{'_add_release_insid'} ||=
+	$dbh->prepare(qq{select currval('${pre}relnum')});
+    $sth->execute();
+    my ($id) = $sth->fetchrow_array();
+    $sth->finish();
+
+    return $id;
+}
+
+sub _add_file {
+    my ($self, $path) = @_;
+
+    my $dbh = $self->dbh;
+    my $pre = $self->prefix;
+    my $sth = $$self{'sth'}{'_add_file_ins'} ||=
+	$dbh->prepare(qq{insert into ${pre}files(path) values (?)});
+    $sth->execute($path);
+    
+    $sth = $$self{'sth'}{'_add_file_insid'} ||=
+	$dbh->prepare(qq{select currval('${pre}filenum')});
+    $sth->execute();
+    my ($id) = $sth->fetchrow_array();
+    $sth->finish();
+
+    return $id;
+}
+
+sub _get_rfile {
+    my ($self, $file_id, $revision) = @_;
+
+    my $dbh = $self->dbh;
+    my $pre = $self->prefix;
+    my $sth = $$self{'sth'}{'_get_rfile'} ||=
+	$dbh->prepare(qq{select id, extract('epoch' from last_modified_gmt
+					    at time zone 'UTC')
+			     from ${pre}revisions
+			     where id_file = ? and revision = ?});
+    my ($id, $gmt);
+    if ($sth->execute($file_id, $revision) > 0) {
+	($id, $gmt) = $sth->fetchrow_array();
+    }
+    $sth->finish();
+
+    return ($id, $gmt);
+}
+
+sub _add_rfile {
+    my ($self, $file_id, $revision, $time) = @_;
+
+    my ($epoch, $zone) = $time =~ /^(\d+)(?: ([-+]\d\d\d\d)|)$/;
+
+    my $dbh = $self->dbh;
+    my $pre = $self->prefix;
+    my $sth = $$self{'sth'}{'_add_rfile_ins'} ||=
+	$dbh->prepare(qq{
+	    insert into ${pre}revisions(id_file, revision,
+					last_modified_gmt,
+					last_modified_tz)
+		values (?, ?, 
+			timestamp 'epoch' + ? * interval '1 second', ?)});
+    $sth->execute($file_id, $revision, $epoch, $zone)
+	or die($dbh->errstr);
+    
+    $sth = $$self{'sth'}{'_add_rfile_insid'} ||=
+	$dbh->prepare(qq{select currval('${pre}revnum')});
+    $sth->execute();
+    my ($id) = $sth->fetchrow_array();
+    $sth->finish();
+
+    return $id;
+}
+
+sub _update_rfile_timestamp {
+    my ($self, $rfile_id, $time) = @_;
+
+    my ($epoch, $zone) = $time =~ /^(\d+)(?: ([-+]\d\d\d\d)|)$/;
+
+    my $dbh = $self->dbh;
+    my $pre = $self->prefix;
+    my $sth = $$self{'sth'}{'_update_rfile_timestamp'} ||=
+	$dbh->prepare(qq{
+	    update ${pre}revisions set
+		last_modified_gmt = timestamp 'epoch' + ? * interval '1 second',
+		last_modified_tz = ?
+		where id = ?});
+
+    $sth->execute($epoch, $zone, $rfile_id)
+	or die($dbh->errstr);
+    $sth->finish();
+}
+
+sub _add_filerelease {
+    my ($self, $rfile_id, $rel_id) = @_;
+
+    my $dbh = $self->dbh;
+    my $pre = $self->prefix;
+    my $sth = $$self{'sth'}{'_add_filerelease'} ||=
+	$dbh->prepare(qq{insert into ${pre}filereleases(id_rfile, id_release)
+			     select ?, ? where not exists
+			     (select 1 from ${pre}filereleases
+			      where id_rfile = ? and id_release = ?)});
+    $sth->execute($rfile_id, $rel_id, $rfile_id, $rel_id);
+}
+
+sub _add_symbol {
+    my ($self, $symbol) = @_;
+
+    my $dbh = $self->dbh;
+    my $pre = $self->prefix;
+    my $sth = $$self{'sth'}{'_add_symbol_ins'} ||=
+	$dbh->prepare(qq{insert into ${pre}symbols(name) values (?)});
+    $sth->execute($symbol);
+    
+    $sth = $$self{'sth'}{'_add_symbol_insid'} ||=
+	$dbh->prepare(qq{select currval('${pre}symnum')});
+    $sth->execute();
+    my ($id) = $sth->fetchrow_array();
+    $sth->finish();
+
+    return $id;
+}
+
+sub _add_ident {
+    my ($self, $rfile_id, $line, $sym_id, $type, $ctx_id) = @_;
+
+    my $dbh = $self->dbh;
+    my $pre = $self->prefix;
+    my $sth = $$self{'sth'}{'_add_ident_ins'} ||=
+	$dbh->prepare(qq{insert into ${pre}identifiers
+			     (id_rfile, line, id_symbol, type, context)
+			     values (?, ?, ?, ?, ?)});
+    $sth->execute($rfile_id, $line, $sym_id, $type, $ctx_id);
+    
+    $sth = $$self{'sth'}{'_add_ident_insid'} ||=
+	$dbh->prepare(qq{select currval('${pre}identnum')});
+    $sth->execute();
+    my ($id) = $sth->fetchrow_array();
+    $sth->finish();
+
+    return $id;
+}
+
+sub DESTROY {
+    my ($self) = @_;
+
+    if ($$self{'dbh'}) {
+	$$self{'dbh'}->rollback();
+	$$self{'dbh'}->disconnect();
+	delete($$self{'dbh'});
+    }
+}
+
+1;