[Debtags-commits] [svn] r1500 -
central-database/branches/alioth/webfrontend
Enrico Zini
enrico at costa.debian.org
Tue Nov 15 15:21:21 UTC 2005
Author: enrico
Date: Tue Nov 15 15:21:20 2005
New Revision: 1500
Modified:
central-database/branches/alioth/webfrontend/Engine.pm
central-database/branches/alioth/webfrontend/Navigation.pm
central-database/branches/alioth/webfrontend/edit.cgi
central-database/branches/alioth/webfrontend/index.cgi
central-database/branches/alioth/webfrontend/maint
central-database/branches/alioth/webfrontend/search.cgi
central-database/branches/alioth/webfrontend/searchtemplate.html
Log:
Refactored Engine to isolate the messy-looking $db
Modified: central-database/branches/alioth/webfrontend/Engine.pm
==============================================================================
--- central-database/branches/alioth/webfrontend/Engine.pm (original)
+++ central-database/branches/alioth/webfrontend/Engine.pm Tue Nov 15 15:21:20 2005
@@ -30,6 +30,294 @@
our $tied = 0;
+##
+## Access the tags <-> packages association
+##
+
+package Engine::PkgTags;
+
+use strict;
+use warnings;
+use Carp;
+use Storable;
+
+
+# Note:
+# This class only works with packages and tag names: it does not know
+# anything about Engine::Package and Engine::Tag.
+
+sub new ($;$)
+{
+ my $class = shift;
+ my $file = (shift or $DEBTAGS);
+ return bless {
+ pkgs => {},
+ tags => {},
+ file => $file,
+ locked => 0,
+ }, $class;
+}
+
+sub clearDB ($)
+{
+ my ($self) = @_;
+ $self->{pkgs} = {};
+ $self->{tags} = {};
+}
+
+sub readDB ($)
+{
+ my ($self) = @_;
+ # Create the file if it doesn't exist yet
+ if (not -r $self->{file})
+ {
+ my $db = { pkgs => {}, tags => {} };
+ store($db, $self->{file});
+ }
+ my $db = retrieve($self->{file});
+ $self->{pkgs} = $db->{pkgs};
+ $self->{tags} = $db->{tags};
+}
+
+sub writeDB ($)
+{
+ my ($self) = @_;
+ my $db = {
+ pkgs => $self->{pkgs},
+ tags => $self->{tags},
+ };
+ store($db, $self->{file});
+}
+
+sub lockDB ($)
+{
+ my ($self) = @_;
+ LockFile::Simple::lock($self->{file}) or die "Can't lock ".$self->{file}.": $!";
+ $self->{locked} = 1;
+ $self->readDB();
+}
+
+sub unlockDB ($)
+{
+ my ($self) = @_;
+ LockFile::Simple::unlock($self->{file});
+ $self->{locked} = 0;
+}
+
+sub DESTROY ($)
+{
+ my ($self) = @_;
+ $self->unlockDB() if $self->{locked};
+}
+
+sub pkgExists ($$)
+{
+ my ($self, $pkg) = @_;
+ return undef if not defined $pkg;
+ return exists $self->{pkgs}{$pkg};
+}
+
+sub tagExists ($$)
+{
+ my ($self, $tag) = @_;
+ return undef if not defined $tag;
+ return exists $self->{tags}{$tag};
+}
+
+sub pkgHasTag ($$$)
+{
+ my ($self, $pkg, $tag) = @_;
+ for my $t (@{$self->{pkgs}{$pkg}{tags}})
+ {
+ return 1 if $t eq $tag;
+ }
+ return undef;
+}
+
+sub tagHasPkg ($$$)
+{
+ my ($self, $tag, $pkg) = @_;
+ for my $p (@{$self->{tags}{$tag}{pkgs}})
+ {
+ return 1 if $p eq $pkg;
+ }
+ return undef;
+}
+
+sub tags ($;@)
+{
+ my $self = shift;
+ if (not @_)
+ {
+ # If nothing was requested, return all the tag names
+ return keys %{$self->{tags}};
+ } elsif (@_ == 1) {
+ # If only one package name is found, return its tags
+ return map { $_->{name} } @{$self->{pkgs}{$_[0]}{tags}};
+ } else {
+ # Else return the union of the tagsets of all the packages given
+ my %res;
+ for my $pkg (@_)
+ {
+ for my $tag (map { $_->{name} } @{$self->{pkgs}{$pkg}{tags}})
+ {
+ $res{$tag} = 1;
+ }
+ }
+ return sort keys %res;
+ }
+}
+sub pkgs ($;@)
+{
+ my $self = shift;
+ if (not @_)
+ {
+ # If nothing was requested, return all the tag names
+ return keys %{$self->{pkgs}};
+ } elsif (@_ == 1) {
+ # If only one tag name is found, return its packages
+ return map { $_->{name} } @{$self->{tags}{$_[0]}{pkgs}};
+ } else {
+ # Else return the union of the package sets of all the tags given
+ my %res;
+ for my $tag (@_)
+ {
+ for my $pkg (map { $_->{name} } @{$self->{tags}{$tag}{pkgs}})
+ {
+ $res{$tag} = 1;
+ }
+ }
+ return sort keys %res;
+ }
+}
+
+sub mkpkg ($$)
+{
+ my ($self, $pkg) = @_;
+ if (not exists $self->{pkgs}{$pkg})
+ {
+ $self->{pkgs}{$pkg} = { name => $pkg, tags => [] };
+ }
+ return $self->{pkgs}{$pkg}
+}
+
+sub mktag ($$)
+{
+ my ($self, $tag) = @_;
+ if (not exists $self->{tags}{$tag})
+ {
+ $self->{tags}{$tag} = { name => $tag, pkgs => [] };
+ }
+# confess "How can $tag not have a name?" if not defined $self->{tags}{$tag}{name};
+ return $self->{tags}{$tag}
+};
+
+sub addTag ($$@)
+{
+ my ($self, $pkg, @tags) = @_;
+
+ # Only add those tags that are missing
+ @tags = grep { ! $self->pkgHasTag($pkg, $_) } @tags;
+ return if not @tags;
+
+ for my $tag (@tags)
+ {
+ $self->{pkgs}{$pkg}{tags} =
+ [ sort { $a->{name} cmp $b->{name} }
+ (@{$self->{pkgs}{$pkg}{tags}}, $self->mktag($tag)) ];
+ $self->{tags}{$tag}{pkgs} =
+ [ sort { $a->{name} cmp $b->{name} }
+ (@{$self->{tags}{$tag}{pkgs}}, $self->mkpkg($pkg)) ];
+ }
+
+ return @tags;
+}
+
+sub removeTag ($$@)
+{
+ my ($self, $pkg, @tags) = @_;
+
+ # Only remove those tags that are there
+ @tags = grep { $self->pkgHasTag($pkg, $_) } @tags;
+ return if not @tags;
+
+ for my $tag (@tags)
+ {
+ $self->{pkgs}{$pkg}{tags} =
+ [ grep { $_->{name} ne $tag } @{$self->{pkgs}{$pkg}{tags}} ];
+ $self->{tags}{$tag}{pkgs} =
+ [ grep { $_->{name} ne $pkg } @{$self->{tags}{$tag}{pkgs}} ];
+ }
+
+ return @tags;
+}
+
+sub delPkgs ($@)
+{
+ my $self = shift;
+
+ my %pkgs = map { $_ => 1 } @_;
+
+ # Delete the package from all involved tags
+ for my $tag ($self->tags(@_))
+ {
+ $self->{tags}{$tag}{pkgs} =
+ [ grep { not exists $pkgs{$_->{name}} } @{$self->{tags}{$tag}{pkgs}} ];
+ }
+
+ # Delete the package records
+ for my $pkg (@_)
+ {
+ delete $self->{pkgs}{$pkg};
+ }
+}
+
+sub delTags ($@)
+{
+ my $self = shift;
+
+ my %tags = map { $_ => 1 } @_;
+
+ # Delete the tag from all involved pkgs
+ for my $pkg ($self->pkgs(@_))
+ {
+ $db->{pkgs}{$pkg}{tags} =
+ [ grep { not exists $tags{$_->{name}} } @{$self->{pkgs}{$pkg}{tags}} ];
+ }
+
+ # Delete the tag records
+ for my $tag (@_)
+ {
+ delete $db->{tags}{$tag};
+ }
+}
+
+sub normalizeTagsets ($@)
+{
+ my $self = shift;
+
+ # Generate missing special::not-yet-tagged tags
+ for my $pkg (@_)
+ {
+ my $nyt = 'special::not-yet-tagged';
+ my $nytx = $nyt.'::'.substr($pkg, 0, 1);
+
+ $self->mkpkg($pkg) if not $self->pkgExists($pkg);
+ my %tags = map { $_ => 1 } $self->tags($pkg);
+ if (not %tags)
+ {
+ $self->addTag($pkg, $nyt);
+ $self->addTag($pkg, $nytx);
+ } else {
+ if (exists $tags{$nyt} and not exists $tags{$nytx})
+ {
+ $self->addTag($pkg, $nytx);
+ } elsif (exists $tags{$nytx} and not exists $tags{$nyt}) {
+ $self->addTag($pkg, $nyt);
+ }
+ }
+ }
+}
##
## Support classes for accessing packages, facets and tags
@@ -108,14 +396,14 @@
}
sub tags ($)
{
- return map { Engine::Tag->new($_->{name}) } @{$db->{pkgs}{$_[0]->name}{tags}};
+ return map { Engine::Tag->new($_) } $db->tags($_[0]->name);
}
# Returns true if the package is tagged with at least all the given tags
sub hasTag ($@)
{
my $self = shift;
- my %tags = map { $_->{name} => 1 } @{$db->{pkgs}{$self->name}{tags}};
+ my %tags = map { $_ => 1 } $db->tags($self->name);
for my $t (@_)
{
return undef if not exists $tags{$t->name()};
@@ -127,7 +415,7 @@
sub hasSomeTag ($@)
{
my $self = shift;
- my %tags = map { $_->{name} => 1 } @{$db->{pkgs}{$self->name}{tags}};
+ my %tags = map { $_ => 1 } $db->tags($self->name);
for my $t (@_)
{
return 1 if exists $tags{$t->name()};
@@ -267,7 +555,7 @@
}
sub pkgs ($)
{
- return map { Engine::Package->new($_->{name}) } @{$db->{tags}{$_[0]->name}{pkgs}};
+ return map { Engine::Package->new($_) } $db->pkgs($_[0]->name);
}
@@ -283,7 +571,8 @@
tie %packages, 'GDBM_File', $PACKAGES, &GDBM_READER, 0664;
tie %facets, 'GDBM_File', $FACETS, &GDBM_READER, 0664;
tie %tags, 'GDBM_File', $TAGS, &GDBM_READER, 0664;
- $db = retrieve($DEBTAGS);
+ $db = Engine::PkgTags->new();
+ $db->readDB();
$tied = 1;
}
@@ -315,7 +604,8 @@
tie %p, 'GDBM_File', $PACKAGES, &GDBM_READER, 0664;
tie %f, 'GDBM_File', $FACETS, &GDBM_READER, 0664;
tie %t, 'GDBM_File', $TAGS, &GDBM_READER, 0664;
- $db = retrieve($DEBTAGS) if -r $DEBTAGS;
+ $db = Engine::PkgTags->new();
+ $db->readDB();
%packages = %p;
%facets = %f;
@@ -334,16 +624,17 @@
%f = %facets;
%t = %tags;
- # Sort the arrays in db
- for my $p (values %{$db->{pkgs}})
- {
- $p->{tags} = [ sort { $a->{name} cmp $b->{name} } @{$p->{tags}} ];
- }
- for my $t (values %{$db->{tags}})
- {
- $t->{pkgs} = [ sort { $a->{name} cmp $b->{name} } @{$t->{pkgs}} ];
- }
- store $db, $DEBTAGS;
+# # Sort the arrays in db
+# for my $p (values %{$db->{pkgs}})
+# {
+# $p->{tags} = [ sort { $a->{name} cmp $b->{name} } @{$p->{tags}} ];
+# }
+# for my $t (values %{$db->{tags}})
+# {
+# $t->{pkgs} = [ sort { $a->{name} cmp $b->{name} } @{$t->{pkgs}} ];
+# }
+
+ $db->writeDB();
}
##
@@ -351,36 +642,49 @@
##
# Check if a package exists
-sub hasPackage ($) { return exists $db->{pkgs}{$_[0]}; }
-
-# Get the list of packages
-sub packages () { return map { Engine::Package->new($_) } keys %{$db->{pkgs}}; }
+sub hasPackage ($) { return $db->pkgExists($_[0]); }
# Convert package names into Engine::Package objects
-sub package (@) { return map { Engine::Package->new($_) } grep { hasPackage($_) } @_; }
+sub packages (@)
+{
+ return map { Engine::Package->new($_) } grep { hasPackage($_) } @_;
+}
+# Return all the packages we have
+sub allPackages ()
+{
+ return map { Engine::Package->new($_) } $db->pkgs();
+}
# Check if a facet exists
sub hasFacet ($) { return exists $facets{$_[0]}; }
-# Get the list of facets
-sub facets () { return map { Engine::Facet->new($_) } keys %facets; }
-
# Convert facet names into Engine::Facet objects
-sub facet (@) { return map { Engine::Facet->new($_) } grep { hasFacet($_) } @_; }
-
+sub facets (@)
+{
+ return map { Engine::Facet->new($_) } grep { hasFacet($_) } @_;
+}
-# Check if a tag exists
-sub hasTag ($) {
- return undef if not defined $_[0];
- return exists $db->{tags}{$_[0]};
+# Return all facets we have
+sub allFacets ()
+{
+ return map { Engine::Facet->new($_) } keys %facets;
}
-# Get the list of tags
-sub tags () { return map { Engine::Tag->new($_) } keys %{$db->{tags}}; }
+# Check if a tag exists
+sub hasTag ($) { return $db->tagExists($_[0]); }
# Convert tag names into Engine::Tag objects
-sub tag (@) { return map { Engine::Tag->new($_) } grep { hasTag($_) } @_; }
+sub tags (@)
+{
+ return map { Engine::Tag->new($_) } grep { hasTag($_) } @_;
+}
+
+# Return all the tags we have
+sub allTags ()
+{
+ return map { Engine::Tag->new($_) } $db->tags();
+}
##
@@ -472,7 +776,7 @@
} else {
# &main::msg("Search all\n");
# We have no index to use: filter all the packages
- return grep { matchPackage($parms, $_) } packages();
+ return grep { matchPackage($parms, $_) } allPackages();
}
}
@@ -484,7 +788,7 @@
my %tags;
# my %specialTags = map { $_->name => 1 } grep { matchTag({words => $search->{words}}, $_) } tags();
# &main::msg("specialTags: %s\n", join(', ', keys %specialTags));
- for my $p (grep { matchPackage($search, $_) } packages())
+ for my $p (grep { matchPackage($search, $_) } allPackages())
{
# &main::msg("Found %s\n", $p->name());
for my $t ($p->tags())
@@ -506,7 +810,7 @@
# {
# &main::msg("%d: %s\n", $tags{$tag}, $tag);
# }
- while (scalar(findPackages({tags => [tag(@res)], notags => $search->{notags}})) < 4)
+ while (scalar(findPackages({tags => [tags(@res)], notags => $search->{notags}})) < 4)
{
# &main::msg("No entries with %s, trying to remove %s\n", join(',', at res), $res[$#res]);
pop @res;
@@ -518,66 +822,35 @@
## Update functions
##
-sub lockdb ()
-{
- LockFile::Simple::lock($DEBTAGS) or die "Can't lock $DEBTAGS: $!";
-}
-
-sub unlockdb ()
-{
- LockFile::Simple::unlock($DEBTAGS);
-}
-
sub addTag ($@)
{
my ($p, @tags) = @_;
- @tags = grep { ! $p->hasTag($_) } @tags;
- return if not @tags;
- lockdb();
- $db = retrieve($DEBTAGS);
- for my $t (@tags)
- {
- $db->{pkgs}{$p->name}{tags} =
- [ sort { $a->{name} cmp $b->{name} }
- (@{$db->{pkgs}{$p->name}{tags}}, mkdbtag($t->name)) ];
- $db->{tags}{$t->name}{pkgs} =
- [ sort { $a->{name} cmp $b->{name} }
- (@{$db->{tags}{$t->name}{pkgs}}, mkdbpkg($p->name)) ];
- }
- store $db, $DEBTAGS;
- unlockdb();
+ $db->lockDB();
+ @tags = $db->addTag($p->name, map { $_->name } @tags);
+ $db->writeDB();
+ $db->unlockDB();
- return @tags;
+ return Engine::tags(@tags);
}
sub removeTag ($@)
{
my ($p, @tags) = @_;
- @tags = grep { $p->hasTag($_) } @tags;
- return if not @tags;
- lockdb();
- $db = retrieve($DEBTAGS);
- for my $t (@tags)
- {
- $db->{pkgs}{$p->name}{tags} =
- [ grep { $_->{name} ne $t->name } @{$db->{pkgs}{$p->name}{tags}} ];
- $db->{tags}{$t->name}{pkgs} =
- [ grep { $_->{name} ne $p->name } @{$db->{tags}{$t->name}{pkgs}} ];
- }
- store $db, $DEBTAGS;
- unlockdb();
+ $db->lockDB();
+ @tags = $db->removeTag($p->name, map { $_->name } @tags);
+ $db->writeDB();
+ $db->unlockDB();
- return @tags;
+ return Engine::tags(@tags);
}
sub applyPatch ($)
{
my ($in) = @_;
- lockdb();
- $db = retrieve($DEBTAGS);
+ $db->lockDB();
while (<$in>)
{
chop();
@@ -600,52 +873,23 @@
if ($1 eq '+')
{
- $db->{pkgs}{$pkg}{tags} =
- [ sort { $a->{name} cmp $b->{name} }
- (@{$db->{pkgs}{$pkg}{tags}}, mkdbtag($tag)) ];
- $db->{tags}{$tag}{pkgs} =
- [ sort { $a->{name} cmp $b->{name} }
- (@{$db->{tags}{$tag}{pkgs}}, mkdbpkg($pkg)) ];
+ $db->addTag($pkg, $tag);
} else {
- $db->{pkgs}{$pkg}{tags} =
- [ grep { $_->{name} ne $tag } @{$db->{pkgs}{$pkg}{tags}} ];
- $db->{tags}{$tag}{pkgs} =
- [ grep { $_->{name} ne $pkg } @{$db->{tags}{$tag}{pkgs}} ];
+ $db->removeTag($pkg, $tag);
}
} else {
warn "Cannot understand change $ch at line $.";
}
}
}
- store $db, $DEBTAGS;
- unlockdb();
+ $db->writeDB();
+ $db->unlockDB();
}
##
## DB maintainance functions
##
-sub mkdbpkg ($)
-{
- my ($pkg) = @_;
- if (not exists $db->{pkgs}{$pkg})
- {
- $db->{pkgs}{$pkg} = { name => $pkg, tags => [] };
- }
- return $db->{pkgs}{$pkg}
-}
-
-sub mkdbtag ($)
-{
- my ($tag) = @_;
- if (not exists $db->{tags}{$tag})
- {
- $db->{tags}{$tag} = { name => $tag, pkgs => [] };
- }
- confess "How can $tag not have a name?" if not defined $db->{tags}{$tag}{name};
- return $db->{tags}{$tag}
-};
-
# Get a package hash
sub getPackage ($)
{
@@ -658,7 +902,6 @@
name => $name,
sdesc => $sdesc,
ldesc => $ldesc,
- tags => [ map {$_->{name}} @{mkdbpkg($name)->{tags}} ],
}
}
@@ -706,7 +949,6 @@
name => $name,
sdesc => $sdesc,
ldesc => $ldesc,
- pkgs => [map {$_->{name}} @{mkdbtag($name)->{pkgs}}],
}
}
@@ -835,6 +1077,7 @@
# Reread the package database, updating and inserting the data it finds
open IN, $tags or die "Cannot open $tags: $!";
+ $db->clearDB();
while (<IN>)
{
chop;
@@ -842,51 +1085,14 @@
my ($pkg, $tags) = split(': ', $_);
# Check that the package exists in the package database
next if not exists $packages{$pkg};
- my $dbp = mkdbpkg($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 { $_->{name} => 1 } @{$dbp->{tags}};
- my %second = map { $_ => 1 } grep { exists $tags{$_} } split(', ', ($tags or ''));
- my %union = map { $_ => 1 } ( keys %first, keys %second );
- my (@added, @deleted);
-
- for my $tag (keys %union)
- {
- if (exists $first{$tag} and not exists $second{$tag}) {
- push (@deleted, $tag);
- } elsif (exists $second{$tag} and not exists $first{$tag}) {
- push (@added, $tag);
- }
- }
-
- if (@added or @deleted)
+ for my $tag ( grep { exists $tags{$_} } split(', ', ($tags or '')) )
{
- # Update the tags in %packages
- $dbp->{tags} = [ map { mkdbtag($_) } keys %second ];
-
- for my $tag (@added)
- {
- my $dbt = mkdbtag($tag);
- confess "Created structure with no name for $tag" if not defined $dbt->{name};
- push (@{$dbt->{pkgs}}, $dbp);
- }
-
- for my $tag (@deleted)
- {
- my $dbt = mkdbtag($tag);
- $dbt->{pkgs} = [ grep { $_->{name} != $pkg } @{$dbt->{pkgs}} ];
- }
+ $db->addTag($pkg, $tag);
}
}
close IN;
}
-use Storable;
-
# Wipe the database and recreate it from the given package database, vocabulary
# and tag database
sub init ($$$)
@@ -906,50 +1112,6 @@
print STDERR "Initializing tag data\n";
resyncTags($tags);
-# print STDERR "Creating experimental index\n";
-# my %mkdb = (
-# pkgs => {},
-# tags => {},
-# );
-# sub mktag ($);
-# local *mkpkg = sub {
-# my ($pkg) = @_;
-## print STDERR "Want pkg $pkg.\n";
-# if (not exists $mkdb{pkgs}{$pkg})
-# {
-## print STDERR "Create pkg $pkg.\n";
-# my %pkg = ( name => $pkg );
-# $mkdb{pkgs}{$pkg} = \%pkg;
-# $pkg{tags} = [map { mktag($_) } @{getPackage($pkg)->{tags}}];
-# }
-## print STDERR "Return pkg $pkg.\n";
-# return $mkdb{pkgs}{$pkg}
-#
-# };
-# local *mktag = sub {
-# my ($tag) = @_;
-## print STDERR "Want tag $tag.\n";
-# if (not exists $mkdb{tags}{$tag})
-# {
-## print STDERR "Create tag $tag.\n";
-# my %tag = ( name => $tag );
-# $mkdb{tags}{$tag} = \%tag;
-# $tag{pkgs} = [map { mkpkg($_) } @{getTag($tag)->{packages}}];
-# }
-## print STDERR "Return tag $tag.\n";
-# return $mkdb{tags}{$tag}
-# };
-# my $i = 0;
-# my $count = scalar(keys %packages);
-# for my $pkg (packages())
-# {
-# printf "%d/%d\n", ++$i, $count;
-# mkpkg($pkg);
-# }
-#
-# print STDERR "Writing experimental index\n";
-# store \%mkdb, 'debtags.store';
-
print STDERR "Writing\n";
writeFromRam();
@@ -975,66 +1137,29 @@
resyncPackages($pkgs);
resyncVocabulary($vocab);
- lockdb();
- $db = retrieve($DEBTAGS);
+ my $db = Engine::PkgTags->new();
+ $db->lockDB();
- # Cleanup $db with what has been deleted
+ # Cleanup $db from what has been deleted
my @deleted;
- for my $pkg (keys %{$db->{pkgs}})
+ for my $pkg ($db->pkgs)
{
push @deleted, $pkg if not exists $packages{$pkg};
}
- for my $pkg (@deleted)
- {
- # Delete the package from all tags that reference it
- for my $tag (map { $_->{name} } @{$db->{pkgs}{$pkg}{tags}})
- {
- $db->{tags}{$tag}{pkgs} =
- [ grep { $_->{name} ne $pkg } @{$db->{tags}{$tag}{pkgs}} ];
- }
- delete $db->{pkgs}{$pkg};
- }
+ $db->delPkgs(@deleted);
@deleted = ();
- for my $tag (keys %{$db->{tags}})
+ for my $tag ($db->tags)
{
push @deleted, $tag if not exists $tags{$tag};
}
- for my $tag (@deleted)
- {
- for my $pkg (map { $_->{name} } @{$db->{tags}{$tag}{pkgs}})
- {
- $db->{pkgs}{$pkg}{tags} =
- [ grep { $_->{name} ne $tag } @{$db->{pkgs}{$pkg}{tags}} ];
- }
- delete $db->{tags}{$tag};
- }
+ $db->delTags(@deleted);
- # Generate missing special::not-yet-tagged tags
- for my $pkg (keys %packages)
- {
- mkdbpkg($pkg) if (not exists $db->{pkgs}{$pkg});
- if (not @{$db->{pkgs}{$pkg}{tags}})
- {
- my $nyt = 'special::not-yet-tagged';
- my $nytx = $nyt.'::'.substr($pkg, 0, 1);
+ # Generate missing special::not-yet-tagged tags and perform other
+ # normalization
+ $db->normalizeTagsets(keys %packages);
- $db->{pkgs}{$pkg}{tags} =
- [ sort { $a->{name} cmp $b->{name} }
- (@{$db->{pkgs}{$pkg}{tags}}, mkdbtag($nyt)) ];
- $db->{tags}{$nyt}{pkgs} =
- [ sort { $a->{name} cmp $b->{name} }
- (@{$db->{tags}{$nyt}{pkgs}}, mkdbpkg($pkg)) ];
-
- $db->{pkgs}{$pkg}{tags} =
- [ sort { $a->{name} cmp $b->{name} }
- (@{$db->{pkgs}{$pkg}{tags}}, mkdbtag($nytx)) ];
- $db->{tags}{$nytx}{pkgs} =
- [ sort { $a->{name} cmp $b->{name} }
- (@{$db->{tags}{$nytx}{pkgs}}, mkdbpkg($pkg)) ];
- }
- }
- store $db, $DEBTAGS;
- unlockdb();
+ $db->writeDB();
+ $db->unlockDB();
untie %packages ;
untie %facets ;
Modified: central-database/branches/alioth/webfrontend/Navigation.pm
==============================================================================
--- central-database/branches/alioth/webfrontend/Navigation.pm (original)
+++ central-database/branches/alioth/webfrontend/Navigation.pm Tue Nov 15 15:21:20 2005
@@ -207,9 +207,9 @@
}
}
- @subpkgs = Engine::package(keys %sub);
+ @subpkgs = Engine::packages(keys %sub);
} else {
- @subpkgs = grep { scalar($_->tags()) } Engine::packages();
+ @subpkgs = grep { scalar($_->tags()) } Engine::allPackages();
}
##
@@ -241,7 +241,7 @@
# Facets
my $count_subpkg = scalar(@subpkgs);
- foreach my $f (Engine::facet(keys %facet_counts))
+ foreach my $f (Engine::facets(keys %facet_counts))
{
my @seen_tags;
my @tags;
Modified: central-database/branches/alioth/webfrontend/edit.cgi
==============================================================================
--- central-database/branches/alioth/webfrontend/edit.cgi (original)
+++ central-database/branches/alioth/webfrontend/edit.cgi Tue Nov 15 15:21:20 2005
@@ -85,7 +85,7 @@
#Engine::addTag($p, $t);
#Engine::removeTag($p, $t);
-($p) = Engine::package(sanitize(param('pkg')));
+($p) = Engine::packages(sanitize(param('pkg')));
if (not defined $p)
{
@@ -115,7 +115,7 @@
$bayesian = 0 if ($b eq 'false');
} elsif ($par eq 'add') {
my $tag = sanitize(param($par));
- my ($t) = Engine::tag($tag);
+ my ($t) = Engine::tags($tag);
if (not defined $t)
{
msg "$tag does not match a valid tag\n";
@@ -128,7 +128,7 @@
}
} elsif ($par eq 'del') {
my $tag = sanitize(param($par));
- my ($t) = Engine::tag($tag);
+ my ($t) = Engine::tags($tag);
if (not defined $t)
{
msg "$tag does not match a valid tag\n";
@@ -202,7 +202,7 @@
@_);
}
-for my $f (Engine::facets())
+for my $f (Engine::allFacets())
{
my @hastags;
my @tags;
Modified: central-database/branches/alioth/webfrontend/index.cgi
==============================================================================
--- central-database/branches/alioth/webfrontend/index.cgi (original)
+++ central-database/branches/alioth/webfrontend/index.cgi Tue Nov 15 15:21:20 2005
@@ -124,7 +124,7 @@
# Only take input tags once, and validate them
{
my %tags = map { $_ => 1 } @sel_tags;
- @sel_tags = Engine::tag(sort keys %tags);
+ @sel_tags = Engine::tags(sort keys %tags);
}
#Web::timing("parms");
Modified: central-database/branches/alioth/webfrontend/maint
==============================================================================
--- central-database/branches/alioth/webfrontend/maint (original)
+++ central-database/branches/alioth/webfrontend/maint Tue Nov 15 15:21:20 2005
@@ -43,7 +43,7 @@
#print STDERR "packages contain an undef package name" if exists $packages{$und};
#print STDERR "facets contain an undef facet name" if exists $facets{$und};
#print STDERR "tags contain an undef tag name" if exists $tags{$und};
- for my $p (Engine::packages())
+ for my $p (Engine::allPackages())
{
checkref('package', $p->name, $p, 'Engine::Package');
error "package name is undefined" if not defined $p->name();
@@ -56,7 +56,7 @@
$seen{$t->name} = 1;
}
}
- for my $f (Engine::facets())
+ for my $f (Engine::allFacets())
{
checkref('facet', $f, $f, 'Engine::Facet');
error "short description for facet ", $f->name(), " undefined" if not defined $f->sdesc();
@@ -68,7 +68,7 @@
$seen{$t->name} = 1;
}
}
- for my $t (Engine::tags())
+ for my $t (Engine::allTags())
{
checkref('tag', $t, $t, 'Engine::Tag');
error "short description for tag ", $t->name(), " undefined" if not defined $t->sdesc;
@@ -84,7 +84,7 @@
} elsif ($cmd eq 'dump') {
Engine::openDB();
- for my $p (sort { $a->name() cmp $b->name() } Engine::packages())
+ for my $p (sort { $a->name() cmp $b->name() } Engine::allPackages())
{
my $ldesc = substr(join(' ', split("\n", ($p->ldesc() or ''))), 0, 60);
printf "PKG name %s\n", $p->name();
@@ -92,7 +92,7 @@
printf "pkg ldesc %s\n", $ldesc;
printf "pkg tags %s\n", join(', ', map { $_->{name} } $p->tags());
}
- for my $f (sort { $a->name() cmp $b->name() } Engine::facets())
+ for my $f (sort { $a->name() cmp $b->name() } Engine::allFacets())
{
my $ldesc = substr(join(' ', split("\n", ($f->ldesc() or ''))), 0, 60);
printf "FAC name %s\n", $f->name();
@@ -100,7 +100,7 @@
printf "fac ldesc %s\n", $ldesc;
printf "fac tags %s\n", join(', ', map { $_->{name} } $f->tags());
}
- for my $t (sort { $a->name() cmp $b->name() } Engine::tags())
+ for my $t (sort { $a->name() cmp $b->name() } Engine::allTags())
{
my $ldesc = substr(join(' ', split("\n", ($t->ldesc() or ''))), 0, 60);
printf "TAG name %s\n", $t->name();
@@ -112,7 +112,7 @@
} elsif ($cmd eq 'tagcat') {
Engine::openDB();
- for my $p (Engine::packages())
+ for my $p (Engine::allPackages())
{
my @tags = map { $_->name } $p->tags;
if (@tags)
@@ -131,7 +131,7 @@
open OUT, "| tagcoll diff $orig -" or die "Cannot run tagcoll: $!";
- for my $p (Engine::packages())
+ for my $p (Engine::allPackages())
{
my @tags = map { $_->name } $p->tags;
if (@tags)
Modified: central-database/branches/alioth/webfrontend/search.cgi
==============================================================================
--- central-database/branches/alioth/webfrontend/search.cgi (original)
+++ central-database/branches/alioth/webfrontend/search.cgi Tue Nov 15 15:21:20 2005
@@ -1,8 +1,5 @@
#!/usr/bin/perl -w
-# TODO:
-# - when computing initial 'wanted' tags, if the result set is small, keep removing tags
-
use strict;
use warnings;
use English;
@@ -63,7 +60,7 @@
@unwant_tags = ('role::aux:dummy', 'role::content:data', 'role::sw:devel-lib', 'role::sw:shlib');
@want_tags = Engine::tagsForSearch($max_tags, {
words => \@sel_words,
- notags => [Engine::tag(@unwant_tags)]
+ notags => [Engine::tags(@unwant_tags)]
});
}
} elsif ($selwords = param('oldstart')) {
@@ -148,13 +145,13 @@
# Only take input tags once, and validate them
{
my %seen;
- @want_tags = Engine::tag(grep { exists $seen{$_} ? undef : $seen{$_} = 1, 1 } @want_tags);
+ @want_tags = Engine::tags(grep { exists $seen{$_} ? undef : $seen{$_} = 1, 1 } @want_tags);
%seen = ();
- @unwant_tags = Engine::tag(grep { exists $seen{$_} ? undef : $seen{$_} = 1, 1 } @unwant_tags);
+ @unwant_tags = Engine::tags(grep { exists $seen{$_} ? undef : $seen{$_} = 1, 1 } @unwant_tags);
%seen = ();
- @ignore_tags = Engine::tag(grep { exists $seen{$_} ? undef : $seen{$_} = 1, 1 } @ignore_tags);
+ @ignore_tags = Engine::tags(grep { exists $seen{$_} ? undef : $seen{$_} = 1, 1 } @ignore_tags);
}
sub linkself (@)
@@ -208,7 +205,7 @@
}
# Choose the most important ones
- at top_tags = Engine::tag(@top_tags[0 .. $max_tags]);
+ at top_tags = Engine::tags(@top_tags[0 .. $max_tags]);
#Navigation::build(@sel_tags, @sel_words);
Modified: central-database/branches/alioth/webfrontend/searchtemplate.html
==============================================================================
--- central-database/branches/alioth/webfrontend/searchtemplate.html (original)
+++ central-database/branches/alioth/webfrontend/searchtemplate.html Tue Nov 15 15:21:20 2005
@@ -219,8 +219,8 @@
[<a href="http://alioth.debian.org/projects/debtags">Alioth project page</a>]
</div>
<div class="signature">
- <a href="mailto:erich at debian.org">Erich Schubert</a>,
<a href="mailto:enrico at debian.org">Enrico Zini</a>,
+ <a href="mailto:erich at debian.org">Erich Schubert</a>,
</div>
<br />
<div class="thanks">
More information about the Debtags-commits
mailing list