[Debtags-commits] [svn] r1439 - central-database/branches/alioth/webfrontend

[Enrico Zini]

Author: enrico
Date: Sun Oct 30 12:54:14 2005
New Revision: 1439

Modified:
   central-database/branches/alioth/webfrontend/Engine.pm
Log:
Fixed bugs in importing data
 Data is correct
 Much faster
 gdbm file size is much smaller


Modified: central-database/branches/alioth/webfrontend/Engine.pm
==============================================================================
--- central-database/branches/alioth/webfrontend/Engine.pm	(original)
+++ central-database/branches/alioth/webfrontend/Engine.pm	Sun Oct 30 12:54:14 2005
@@ -1,6 +1,7 @@
 package Engine;
 
 use GDBM_File;
+use Carp;
 
 ##
 ## Configuration
@@ -80,6 +81,32 @@
 	openDB();
 }
 
+# Read all the database contents to RAM
+sub readToRam ()
+{
+	# Read everything in RAM
+	my (%p, %f, %t);
+	tie %p, 'GDBM_File', $BASEDIR.'/packages.gdbm', &GDBM_READER, 0640;
+	tie %f, 'GDBM_File', $BASEDIR.'/facets.gdbm', &GDBM_READER, 0640;
+	tie %t, 'GDBM_File', $BASEDIR.'/tags.gdbm', &GDBM_READER, 0640;
+
+	%packages = %p;
+	%facets = %f;
+	%tags = %t;
+}
+
+sub writeFromRam ()
+{
+	# Write everything back
+	tie %p, 'GDBM_File', $BASEDIR.'/packages.gdbm', &GDBM_NEWDB, 0660;
+	tie %f, 'GDBM_File', $BASEDIR.'/facets.gdbm', &GDBM_NEWDB, 0660;
+	tie %t, 'GDBM_File', $BASEDIR.'/tags.gdbm', &GDBM_NEWDB, 0660;
+
+	%p = %packages;
+	%f = %facets;
+	%t = %tags;
+}
+
 # Get the list of package names
 sub packages () { return keys %packages; }
 
@@ -90,6 +117,7 @@
 sub getPackage ($)
 {
 	my ($name) = @_;
+	confess "Name is not defined" if not defined $name;
 	my $data = $packages{$name};
 	return { name => $name, tags => [] } if not defined $data;
 	my ($sdesc, $ldesc, $tags) = split("\0", $data);
@@ -105,6 +133,8 @@
 sub setPackage ($)
 {
 	my ($pkg) = @_;
+	confess "pkg not a hash" if ref($pkg) ne 'HASH';
+	confess "sdesc is a ".ref($pkg->{sdesc})." instead of a scalar" if ref($pkg->{sdesc}) ne '';
 	$packages{$pkg->{name}} = join("\0", ($pkg->{sdesc} or ''), ($pkg->{ldesc} or ''), join(', ', @{$pkg->{tags}}));
 }
 
@@ -118,6 +148,7 @@
 sub getFacet ($)
 {
 	my ($name) = @_;
+	confess "Name is not defined" if not defined $name;
 	my $data = $facets{$name};
 	return { name => $name, tags => [] } if not defined $data;
 	my ($sdesc, $ldesc, $tags) = split("\0", $data);
@@ -146,6 +177,7 @@
 sub getTag ($)
 {
 	my ($name) = @_;
+	confess "Name is not defined" if not defined $name;
 	my $data = $tags{$name};
 	return { name => $name, packages => [] } if not defined $data;
 	my ($sdesc, $ldesc, $pkgs) = split("\0", $data);
@@ -173,7 +205,7 @@
 {
 	my ($parms, $p) = @_;
 
-#	&main::msg("Match t:%s w:%s\n", join(', ', @{$parms->{tags}}), join(', ', @{$parms->{words}}));
+	&main::msg("Match %s with t:%s w:%s\n", $p->{name}, join(', ', @{$parms->{tags}}), join(', ', @{$parms->{words}}));
 
 	if (@{$parms->{tags}})
 	{
@@ -191,7 +223,7 @@
 			index($p->{ldesc}, $w) == -1;
 	}
 
-#	&main::msg("OK %s\n", $p->{name});
+	&main::msg("OK %s\n", $p->{name});
 	return 1;
 }
 
@@ -337,14 +369,14 @@
 	# Delete the packages that are not in the package database anymore
 	for my $tag (keys %deleted)
 	{
-		my $t = getTag($pkg);
-		for my $pkg ($t->{packages})
+		my $t = getTag($tag);
+		for my $pkg (@{$t->{packages}})
 		{
 			my $p = getPackage($pkg);
 			$p->{tags} = [ grep { $_ != $tag } @{$p->{tags}} ];
 			setPackage($pkg);
 		}
-		delete $packages{$pkg};
+		delete $tags{$tag};
 	}
 }
 
@@ -360,13 +392,14 @@
 		chop;
 		die "Cannot parse line \"$_\"" if (/[^:,] /);
 		my ($pkg, $tags) = split(': ', $_);
+		my $p = getPackage($pkg);
 
 		#printf STDERR "Pkg: %s, tags: %s\n", $pkg, $tags;
 
 		# Compute the difference between the previous tagset and the
 		# one we just read
 
-		my %first = map { $_ => 1 } @{$packages{$pkg}{tags}};
+		my %first = map { $_ => 1 } @{$p->{tags}};
 		my %second = map { $_ => 1 } split(', ', ($tags or ''));
 		my %union = map { $_ => 1 } ( keys %first, keys %second );
 		my (@added, @deleted);
@@ -383,7 +416,6 @@
 		if (@added or @deleted)
 		{
 			# Update the tags in %packages
-			my $p = getPackage($pkg);
 			$p->{tags} = [ keys %second ];
 			setPackage($p);
 
@@ -414,18 +446,23 @@
 	my $reopen = 1 if $tied == 1;
 	closeDB() if $tied == 1;
 
-	tie %packages, 'GDBM_File', $BASEDIR.'/packages.gdbm', &GDBM_NEWDB, 0660;
-	tie %facets, 'GDBM_File', $BASEDIR.'/facets.gdbm', &GDBM_NEWDB, 0660;
-	tie %tags, 'GDBM_File', $BASEDIR.'/tags.gdbm', &GDBM_NEWDB, 0660;
+	print STDERR "Reading into RAM\n";
+	readToRam();
 
+	print STDERR "Initializing package data\n";
 	resyncPackages($pkgs);
+	print STDERR "Initializing vocabulary data\n";
 	resyncVocabulary($vocab);
+	print STDERR "Initializing tag data\n";
 	resyncTags($tags);
-	
-	untie %packages ;
-	untie %facets ;
-	untie %tags ;
 
+	print STDERR "Writing\n";
+	writeFromRam();
+
+	%packages = ();
+	%facets = ();
+	%tags = ();
+	
 	openDB() if $reopen;
 }