[Debtags-commits] [svn] r1443 -
central-database/branches/alioth/webfrontend
Enrico Zini
enrico at costa.debian.org
Sun Oct 30 16:49:32 UTC 2005
Author: enrico
Date: Sun Oct 30 16:49:31 2005
New Revision: 1443
Modified:
central-database/branches/alioth/webfrontend/Engine.pm
central-database/branches/alioth/webfrontend/index.cgi
central-database/branches/alioth/webfrontend/maint
Log:
Navigation (finally) works
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 16:49:31 2005
@@ -14,35 +14,6 @@
our $BASEDIR = ".";
##
-## Fields of the package, facet and tag hashes
-##
-
-# Layout of a package hash
-# {
-# name => package name
-# sdesc => short description
-# ldesc => long description
-# tags => [ tag names ]
-# }
-
-# Layout of a facet hash
-# Value: {
-# name => facet name
-# sdesc => short description
-# ldesc => long description
-# tags => [ tag names ]
-# }
-
-# Layout of a tag hash
-# Value: {
-# name => tag name
-# sdesc => short description
-# ldesc => long description
-# pkgs => [ package names ]
-# }
-
-
-##
## Variables of the singleton module
##
@@ -55,6 +26,160 @@
##
+## Support classes for accessing packages, facets and tags
+##
+
+package Engine::Package;
+
+use strict;
+use warnings;
+use Carp;
+
+sub new ($$)
+{
+ my ($class, $pkg) = @_;
+ return bless {
+ name => $pkg
+ }, $class;
+}
+
+sub load_data ($)
+{
+ my ($self) = @_;
+
+ # Load data from disk
+ my $data = $packages{$self->{name}};
+
+ # If there's nothing to load, give up
+ return if not defined $data;
+
+ my ($sdesc, $ldesc) = split("\0", $data);
+
+ $self->{sdesc} = $sdesc;
+ $self->{ldesc} = $ldesc;
+}
+
+sub name ($) { return $_[0]->{name}; }
+sub sdesc ($)
+{
+ my ($self) = @_;
+ $self->load_data() if not defined $self->{sdesc};
+ return $self->{sdesc};
+}
+sub ldesc ($)
+{
+ my ($self) = @_;
+ $self->load_data() if not defined $self->{sdesc};
+ return $self->{ldesc};
+}
+sub tags ($)
+{
+ return map { Engine::Tag->new($_->{name}) } @{$db->{pkgs}{$_[0]->name}{tags}};
+}
+
+package Engine::Facet;
+
+use strict;
+use warnings;
+
+sub new ($$)
+{
+ my ($class, $pkg) = @_;
+ return bless {
+ name => $pkg
+ }, $class;
+}
+
+sub load_data ($)
+{
+ my ($self) = @_;
+
+ # Load data from disk
+ my $data = $facets{$self->name};
+
+ # If there's nothing to load, give up
+ return if not defined $data;
+
+ my ($sdesc, $ldesc, $tags) = split("\0", $data);
+
+ $self->{sdesc} = $sdesc;
+ $self->{ldesc} = $ldesc;
+ $self->{tags} => [ map { Engine::Tag->new($_) } split(', ', ($tags or '')) ],
+}
+
+sub name ($) { return $_[0]->{name}; }
+sub sdesc ($)
+{
+ my ($self) = @_;
+ $self->load_data() if not defined $self->{sdesc};
+ return $self->{sdesc};
+}
+sub ldesc ($)
+{
+ my ($self) = @_;
+ $self->load_data() if not defined $self->{sdesc};
+ return $self->{ldesc};
+}
+sub tags ($)
+{
+ my ($self) = @_;
+ $self->load_data() if not defined $self->{tags};
+ return defined $self->{tags} ? @{$self->{tags}} : ();
+}
+
+
+
+package Engine::Tag;
+
+use strict;
+use warnings;
+use Carp;
+
+sub new ($$)
+{
+ my ($class, $pkg) = @_;
+ confess "pkg is undef" if not defined $pkg;
+ return bless {
+ name => $pkg
+ }, $class;
+}
+
+sub load_data ($)
+{
+ my ($self) = @_;
+
+ # Load data from disk
+ my $data = $tags{$self->{name}};
+
+ # If there's nothing to load, give up
+ return if not defined $data;
+
+ ($self->{sdesc}, $self->{ldesc}) = split("\0", $data);
+}
+
+sub name ($) { return $_[0]->{name}; }
+sub facet ($) { return Engine::Facet->new((split('::', $_[0]->{name}))[0] or 'legacy'); }
+sub sdesc ($)
+{
+ my ($self) = @_;
+ $self->load_data() if not defined $self->{sdesc};
+ return $self->{sdesc};
+}
+sub ldesc ($)
+{
+ my ($self) = @_;
+ $self->load_data() if not defined $self->{sdesc};
+ return $self->{ldesc};
+}
+sub pkgs ($)
+{
+ return map { Engine::Package->new($_->{name}) } @{$db->{tags}{$_[0]->name}{pkgs}};
+}
+
+
+package Engine;
+
+##
## Low-level DB I/O
##
@@ -96,7 +221,7 @@
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;
- $db = retrieve('debtags.store');
+ $db = retrieve('debtags.store') if -r 'debtags.store';
%packages = %p;
%facets = %f;
@@ -117,11 +242,118 @@
store $db, 'debtags.store';
}
-# Get the list of package names
-sub packages () { return keys %packages; }
+##
+## High-level accessors
+##
# Check if a package exists
-sub hasPackage ($) { return exists $packages{$_[0]}; }
+sub hasPackage ($) { return exists $db->{pkgs}{$_[0]}; }
+
+# Get the list of packages
+sub packages () { return map { Engine::Package->new($_) } keys %{$db->{pkgs}}; }
+
+# Convert package names into Engine::Package objects
+sub package (@) { return map { Engine::Package->new($_) } grep { hasPackage($_) } @_; }
+
+
+# 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($_) } @_; }
+
+
+# Check if a tag exists
+sub hasTag ($) { return exists $db->{tags}{$_[0]}; }
+
+# Get the list of tags
+sub tags () { return map { Engine::Tag->new($_) } keys %{$db->{tags}}; }
+
+# Convert tag names into Engine::Tag objects
+sub tag (@) { return map { Engine::Tag->new($_) } grep { hasTag($_) } @_; }
+
+
+##
+## Query functions
+##
+
+sub matchPackage ($$)
+{
+ my ($parms, $p) = @_;
+
+# &main::msg("Match %s with t:%s w:%s\n", $p->name(), join(', ', @{$parms->{tags}}), join(', ', @{$parms->{words}}));
+
+ if (@{$parms->{tags}})
+ {
+ my %tags = map { $_->name() => 1 } $p->tags();
+ for my $i (@{$parms->{tags}})
+ {
+ return undef if not exists $tags{$i->name()};
+ }
+ }
+ for my $w (@{$parms->{words}})
+ {
+ return undef if
+ index($p->name(), $w) == -1 &&
+ index($p->sdesc(), $w) == -1 &&
+ index($p->ldesc(), $w) == -1;
+ }
+
+# &main::msg("OK %s\n", $p->name());
+ return 1;
+}
+
+# Search for packages using zero or more of the following parameters:
+#
+# tags => [ tag1, tag2.. ]
+# words => [ word1, word2.. ]
+#
+sub findPackages ($)
+{
+ my ($parms) = @_;
+
+ if (my @tags = @{$parms->{tags}})
+ {
+# &main::msg("Tags search (%s)\n", join(', ', @tags));
+ # Use the last tag as the beginning of the search, because it is usually
+ # the one with the least matches
+ my $t = $tags[$#tags];
+# &main::msg("Tag used: %s with %d packages.\n", $t->{name}, scalar(@{$t->{packages}}));
+ return grep { matchPackage($parms, $_) } $t->pkgs();
+ } else {
+# &main::msg("Search all\n");
+ # We have no index to use: filter all the packages
+ return grep { matchPackage($parms, $_) } packages();
+ }
+}
+
+##
+## 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 ($)
@@ -135,7 +367,7 @@
name => $name,
sdesc => $sdesc,
ldesc => $ldesc,
- tags => [ map {$_->{name}} @{$db->{pkgs}{$name}{tags}} ],
+ tags => [ map {$_->{name}} @{mkdbpkg($name)->{tags}} ],
}
}
@@ -148,12 +380,6 @@
$packages{$pkg->{name}} = join("\0", ($pkg->{sdesc} or ''), ($pkg->{ldesc} or ''));
}
-# Get the list of facet names
-sub facets () { return keys %facets; }
-
-# Check if a facet exists
-sub hasFacet ($) { return exists $facets{$_[0]}; }
-
# Get a facet hash
sub getFacet ($)
{
@@ -177,12 +403,6 @@
$facets{$fac->{name}} = join("\0", ($fac->{sdesc} or ''), ($fac->{ldesc} or ''), join(', ', @{$fac->{tags}}));
}
-# Get the list of tag names
-sub tags () { return keys %tags; }
-
-# Check if a tag exists
-sub hasTag ($) { return exists $tags{$_[0]}; }
-
# Get a tag hash
sub getTag ($)
{
@@ -195,7 +415,7 @@
name => $name,
sdesc => $sdesc,
ldesc => $ldesc,
- pkgs => [map {$_->{name}} @{$db->{tags}{$name}{pkgs}}],
+ pkgs => [map {$_->{name}} @{mkdbtag($name)->{pkgs}}],
}
}
@@ -207,65 +427,6 @@
$tags{$tag->{name}} = join("\0", ($tag->{sdesc} or ''), ($tag->{ldesc} or ''));
}
-##
-## Query functions
-##
-
-sub matchPackage ($$)
-{
- my ($parms, $p) = @_;
-
-# &main::msg("Match %s with t:%s w:%s\n", $p->{name}, join(', ', @{$parms->{tags}}), join(', ', @{$parms->{words}}));
-
- if (@{$parms->{tags}})
- {
- my %tags = map { $_ => 1 } @{$p->{tags}};
- for my $i (@{$parms->{tags}})
- {
- return undef if not exists $tags{$i};
- }
- }
- for my $w (@{$parms->{words}})
- {
- return undef if
- index($p->{name}, $w) == -1 &&
- index($p->{sdesc}, $w) == -1 &&
- index($p->{ldesc}, $w) == -1;
- }
-
-# &main::msg("OK %s\n", $p->{name});
- return 1;
-}
-
-# Search for packages using zero or more of the following parameters:
-#
-# tags => [ tag1, tag2.. ]
-# words => [ word1, word2.. ]
-#
-sub findPackages ($)
-{
- my ($parms) = @_;
-
- if (my @tags = @{$parms->{tags}})
- {
-# &main::msg("Tags search (%s)\n", join(', ', @tags));
- # Use the last tag as the beginning of the search, because it is usually
- # the one with the least matches
- my $t = getTag($tags[$#tags]);
-# &main::msg("Tag used: %s with %d packages.\n", $t->{name}, scalar(@{$t->{packages}}));
- return grep { matchPackage($parms, $_) }
- map { getPackage($_) } @{$t->{pkgs}};
- } else {
-# &main::msg("Search all\n");
- # We have no index to use: filter all the packages
- return grep { matchPackage($parms, $_) }
- map { getPackage($_) } packages();
- }
-}
-
-##
-## DB maintainance functions
-##
# Update the package informations in the database from an updated package
# database
@@ -390,26 +551,6 @@
}
}
-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, tags => [] };
- }
- return $db->{tags}{$tag}
-};
-
# Set the tag information in the database to that of the given tag source
sub resyncTags ($)
{
@@ -422,6 +563,8 @@
chop;
die "Cannot parse line \"$_\"" if (/[^:,] /);
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;
@@ -446,11 +589,12 @@
if (@added or @deleted)
{
# Update the tags in %packages
- $dbp->{tags} = [ keys %second ];
+ $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);
}
Modified: central-database/branches/alioth/webfrontend/index.cgi
==============================================================================
--- central-database/branches/alioth/webfrontend/index.cgi (original)
+++ central-database/branches/alioth/webfrontend/index.cgi Sun Oct 30 16:49:31 2005
@@ -22,7 +22,7 @@
##
my $release="unstable";
-my $packages_limit=10; # always show when below this
+my $packages_limit = 15; # always show when below this
my $useless_limit=0.6; # don't put everything into one subgroup.
my $subgroup_limit=3; # don't make smaller subgroups
@@ -36,8 +36,12 @@
{
my ($format, @list) = @_;
$log .= sprintf($format, @list);
+ printf STDERR $format, @list;
}
+# Returns the facet name for a tag
+sub facet ($) { return (split('::', $_[0]))[0] or 'legacy'; }
+
# Returns true if the has contains all the values in the vector
sub contains ($\@)
{
@@ -50,18 +54,11 @@
return 1;
}
-# Get the facet name for a tag
-sub facet ($)
-{
- my ($tag) = @_;
- return $tag =~ /^(.+?)::/ ? $1 : 'legacy';
-}
-
# Returns true if the has contains at least one of the values in the vector
sub intersects ($\@)
{
- my ($pkg, $vec) = @_;
- my %hash = map { $_ => 1 } @{$pkg->{tags}};
+ my ($p, $vec) = @_;
+ my %hash = map { $_ => 1 } $p->tags();
for my $i (@$vec)
{
return 1 if exists $hash{$i};
@@ -101,25 +98,25 @@
{
my $tag = param($par);
next if $tag eq ':NONE:';
- msg "Found: %s->%s\n", $par, $tag;
+# msg "Found: %s->%s\n", $par, $tag;
push @sel_tags, $tag if ($tag =~ /^[a-z0-9\-:]+$/);
}
elsif ($par eq 'tags')
{
my $seltags = param($par);
- msg "Found: %s->%s\n", $par, $seltags;
+# msg "Found: %s->%s\n", $par, $seltags;
if ($seltags && $seltags =~ m/([a-z0-9\-:.,]+)/)
{
push @sel_tags, split(/,/, $1);
- } else {
- $packages_limit = 0;
- $subgroup_limit = 0;
+# } else {
+# $packages_limit = 0;
+# $subgroup_limit = 0;
}
}
elsif ($par eq 'words')
{
my $selwords = param($par);
- msg "Found: %s->%s\n", $par, $selwords;
+# msg "Found: %s->%s\n", $par, $selwords;
if ($selwords && $selwords =~ m/([a-z0-9\-:.,]+)/)
{
@sel_words = split(/\s+/, $1);
@@ -130,27 +127,51 @@
# Only take input tags once, and validate them
{
my %tags = map { $_ => 1 } @sel_tags;
- @sel_tags = sort grep { Engine::hasTag($_) } keys %tags;
+ @sel_tags = Engine::tag(sort keys %tags);
}
-#msg "Tags: %s\n", join(', ', @sel_tags);
+#msg "Tags: %s\n", join(', ', map { $_->name } @sel_tags);
+
##
## Package selection
##
# Get the list of packages we should display
-# and count the tag cardinalities
-my (@pkgs, %tag_counts);
+# and count the tag cardinalities and the tagset cardinalities
+my (%tag_counts);
+
+# Packages by tagset
+my %ts;
+
+# Current tagset
+my $curts = join(',', sort map{$_->name} @sel_tags);
+
+# Packages that have exactly the current tagset
+my @curpkgs;
+
+# Packages that have more tags than the current tagset
+my @subpkgs;
+
for my $p (Engine::findPackages({tags => \@sel_tags, words => \@sel_words}))
{
-# msg "Try: %s\n", $p->{name};
- next if not @{$p->{tags}};
-# msg "Kept: %s\n", $p->{name};
- push @pkgs, $p;
- foreach my $tag (@{$p->{tags}})
+ next if not $p->tags();
+
+ # Compute tag statistics
+ foreach my $t ($p->tags())
{
- $tag_counts{$tag} += 1;
+ $tag_counts{$t->name()} += 1;
+ }
+
+ # Compute tagset statistics
+ my $ts = join(',', sort map{$_->name} $p->tags);
+ # Store packages by tagset
+ push(@{$ts{$ts}}, $p);
+
+ if ($ts eq $curts) {
+ push @curpkgs, $p
+ } else {
+ push @subpkgs, $p;
}
}
@@ -163,63 +184,92 @@
##
# we now try to build a reasonable set of tags to choose from
-my @tag_newtags;
-my %work_stats = %tag_counts;
+my %seen = map { $_->name => 1 } @sel_tags;
-# Get the facet with the higher cardinality
-sub best_facet ()
-{
- my %fstats;
- for my $tag (keys %work_stats)
- {
- $fstats{facet($tag)} += $work_stats{$tag};
- }
- return (sort { $fstats{$b} <=> $fstats{$a} } keys %fstats)[0];
-}
+# Select the child tags
+my @tag_newtags = Engine::tag(grep { !$seen{$_} } keys %tag_counts);
-# Remove all tags belonging to this facet, and all packages tagged with tags in
-# this facet, from the working set. Returns the list of tags removed.
-sub detach_facet ($)
+# If the packages in the current level are just a few, add from the less
+# crowded tagsets
+my @pkgs = @curpkgs;
+if (@pkgs < $packages_limit)
{
- my ($facet) = @_;
-
- my @tags = grep { facet($_) eq $facet } keys %work_stats;
- for my $tag (@tags)
+ for my $pkgs ( sort { scalar(@$a) <=> scalar(@$b) } values %ts )
{
- delete $work_stats{$tag};
+ last if @pkgs > $packages_limit;
+ push @pkgs, @$pkgs;
}
-
- # Remove uninteresting packages
- for (my $i = 0; $i < @pkgs; )
- {
- if (intersects($pkgs[$i], @tags))
- {
- if ($i == $#pkgs)
- {
- pop(@pkgs);
- } else {
- $pkgs[$i] = pop(@pkgs);
- }
- } else {
- $i++;
- }
- }
-
- return @tags;
}
-#printf STDERR "BEGIN %d\n", scalar(keys(%work_stats));
-while (scalar keys %work_stats > $packages_limit)
-{
- my $facet = best_facet();
- my @tags = detach_facet($facet);
-
-# msg("Selected %s, %d items, %d remaining\n", $facet, scalar @tags, scalar keys %work_stats);
+#my %work_stats = %tag_counts;
+#
+## Get the facet with the higher cardinality
+#sub best_facet ()
+#{
+# my %fstats;
+# for my $tag (keys %work_stats)
+# {
+# $fstats{facet($tag)} += $work_stats{$tag};
+# }
+# my $max = 0;
+# my $maxfac;
+# while (my ($fac, $n) = each %fstats)
+# {
+# if ($n > $max)
+# {
+# $max = $n;
+# $maxfac = $fac;
+# }
+# }
+# return $maxfac;
+#}
+#
+## Remove all tags belonging to this facet, and all packages tagged with tags in
+## this facet, from the working set. Returns the list of tags removed.
+#sub detach_facet ($)
+#{
+# my ($facet) = @_;
+#
+# my @tags = grep { facet($_) eq $facet } keys %work_stats;
+# for my $tag (@tags)
+# {
+# delete $work_stats{$tag};
+# }
+#
+# # Remove uninteresting packages
+# for (my $i = 0; $i < @pkgs; )
+# {
+# if (intersects($pkgs[$i], @tags))
+# {
+# if ($i == $#pkgs)
+# {
+# pop(@pkgs);
+# } else {
+# $pkgs[$i] = pop(@pkgs);
+# }
+# } else {
+# $i++;
+# }
+# }
+#
+# return @tags;
+#}
+#
+##printf STDERR "BEGIN %d\n", scalar(keys(%work_stats));
+#my $i = 0;
+#while (scalar keys %work_stats > $packages_limit)
+#{
+# my $facet = best_facet();
+# my @tags = detach_facet($facet);
+#
+## msg("Selected %s, %d items, %d remaining\n", $facet, scalar @tags, scalar keys %work_stats);
+#
+# push @tag_newtags, @tags;
+# ++$i;
+#}
- push @tag_newtags, @tags;
-}
-#msg("Done. %d tags, %d packages.\n", scalar(@tag_newtags), scalar keys %work_pkgs);
+#msg("Done. %d tags, %d packages, %d iterations.\n", scalar(@tag_newtags), scalar @pkgs, $i);
##
@@ -241,22 +291,22 @@
my @ht_seltags;
for (my $i = 0; $i < @sel_tags; $i++)
{
- my $t = Engine::getTag($sel_tags[$i]);
- my @othertags=@sel_tags;
- splice(@othertags,$i,1);
+ my $t = $sel_tags[$i];
+ my @othertags = map { $_->name } @sel_tags;
+ splice(@othertags, $i, 1);
my $url ="?tags=".uri_escape(join(",", at othertags));
- push @{$seltags_perfacet{facet($t->{name})}}, {
- TAG => $t->{name},
- DESC => $t->{sdesc},
- COUNT => $tag_counts{$t->{name}},
+ push @{$seltags_perfacet{$t->facet()->name()}}, {
+ TAG => $t->name(),
+ DESC => $t->sdesc(),
+ COUNT => $tag_counts{$t->name()},
URL => $url
};
push @ht_seltags, {
- TAG => $t->{name},
- DESC => $t->{sdesc},
- COUNT => $tag_counts{$t->{name}},
+ TAG => $t->name(),
+ DESC => $t->sdesc(),
+ COUNT => $tag_counts{$t->name()},
URL => $url
};
}
@@ -264,28 +314,26 @@
# Further selectable tags in the navigation part
my $cur_fac;
my @ht_newfacets;
-foreach my $tag (sort @tag_newtags)
+foreach my $t (sort { $a->name cmp $b->name } @tag_newtags)
{
- my $facet = facet($tag);
- if (not defined $cur_fac or $cur_fac ne $facet)
+ my $f = $t->facet();
+ if (not defined $cur_fac or $cur_fac ne $f->name())
{
- my $f = Engine::getFacet($facet);
push @ht_newfacets, {
- NAME => $facet,
- DESC => $f->{sdesc},
+ NAME => $f->name(),
+ DESC => $f->sdesc(),
COUNT => 0,
- SELTAGS => exists $seltags_perfacet{$facet} ? $seltags_perfacet{$facet} : [],
+ SELTAGS => exists $seltags_perfacet{$f->name()} ? $seltags_perfacet{$f->name()} : [],
TAGS => []
};
- $cur_fac = $facet;
+ $cur_fac = $f->name();
}
- my $t = Engine::getTag($tag);
- $ht_newfacets[$#ht_newfacets]{COUNT} += $tag_counts{$tag};
+ $ht_newfacets[$#ht_newfacets]{COUNT} += $tag_counts{$t->name()};
push @{$ht_newfacets[$#ht_newfacets]{TAGS}}, {
- TAG => $tag,
- DESC => $t->{sdesc},
- COUNT => $tag_counts{$tag},
- URL => "?tags=".uri_escape(join(",", at sel_tags,$tag))
+ TAG => $t->name(),
+ DESC => $t->sdesc(),
+ COUNT => $tag_counts{$t->name()},
+ URL => "?tags=".uri_escape(join(",", map { $_->name } @sel_tags, $t))
};
}
@@ -295,17 +343,18 @@
my $count=0;
foreach my $pkg (@pkgs) {
$count++;
- my @tags = sort @{$pkg->{tags}};
- if ($lastsection ne join(" ", @tags)) {
+ my @tags = sort { $a->name() cmp $b->name() } $pkg->tags();
+ my $tags = join(" ", map { $_->name() } @tags);
+ if ($lastsection ne $tags) {
push @ht_pkgs, {
- SECTION => join(", ",sort(map { $_->{sdesc} } map { Engine::getTag($_) } @tags)),
+ SECTION => join(", ",sort(map { $_->sdesc() } @tags)),
};
- $lastsection = join(" ", @tags);
+ $lastsection = $tags;
}
- my ($description) = $pkg->{sdesc};
+ my ($description) = $pkg->sdesc();
push @ht_pkgs, {
- PACKAGE => $pkg->{name},
- URL => "edit.cgi?package=".uri_escape($pkg->{name})."&tags=".uri_escape(join(',', at sel_tags)),
+ PACKAGE => $pkg->name(),
+ URL => "edit.cgi?package=".uri_escape($pkg->name())."&tags=".uri_escape(join(',',map{$_->name()} @sel_tags)),
ODDROW => ($count % 2),
DESC => $description
}
@@ -316,7 +365,7 @@
$template->param(NEWFACETS => \@ht_newfacets);
$template->param(NUMPACKAGES => scalar(@pkgs));
$template->param(PACKAGES => \@ht_pkgs);
-$template->param(CURTAGS => join(',', at sel_tags));
+$template->param(CURTAGS => join(',', map{$_->name} @sel_tags));
$template->param(CURWORDS => join(' ', at sel_words));
$log =~ s/\n/<br>/g;
$template->param(LOG => $log);
Modified: central-database/branches/alioth/webfrontend/maint
==============================================================================
--- central-database/branches/alioth/webfrontend/maint (original)
+++ central-database/branches/alioth/webfrontend/maint Sun Oct 30 16:49:31 2005
@@ -37,78 +37,70 @@
#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 $pkg (Engine::packages())
+ for my $p (Engine::packages())
{
- my $p = Engine::getPackage($pkg);
- checkref('package', $pkg, $p, 'HASH');
- error "short description for package $pkg undefined" if not defined $p->{sdesc};
- checkref('tags in package', $pkg, $p->{tags}, 'ARRAY');
+ checkref('package', $p->name, $p, 'Engine::Package');
+ error "package name is undefined" if not defined $p->name();
+ error "short description for package ", $p->name(), " undefined" if not defined $p->sdesc();
my %seen;
- for my $t (@{$p->{tags}})
+ for my $t ($p->tags())
{
- error "package $pkg contains an undef tag" if not defined $t;
- error "package $pkg contains the duplicate tag $t" if exists $seen{$t};
- $seen{$t} = 1;
+ error "package ", $p->name(), " contains an undef tag" if not defined $t;
+ error "package ", $p->name(), " contains the duplicate tag ", $t->name if exists $seen{$t->name};
+ $seen{$t->name} = 1;
}
}
- for my $facet (Engine::facets())
+ for my $f (Engine::facets())
{
- my $f = Engine::getFacet($facet);
- checkref('facet', $facet, $f, 'HASH');
- error "short description for facet $facet undefined" if not defined $f->{sdesc};
- checkref('tags in facet', $facet, $f->{tags}, 'ARRAY');
+ checkref('facet', $f, $f, 'Engine::Facet');
+ error "short description for facet ", $f->name(), " undefined" if not defined $f->sdesc();
my %seen;
- for my $t (@{$f->{tags}})
+ for my $t ($f->tags())
{
- error "facet $facet contains an undef tag" if not defined $t;
- error "facet $facet contains the duplicate tag $t" if exists $seen{$t};
- $seen{$t} = 1;
+ error "facet ", $f->name, " contains an undef tag" if not defined $t;
+ error "facet ", $f->name, " contains the duplicate tag ", $t->name if exists $seen{$t->name};
+ $seen{$t->name} = 1;
}
}
- for my $tag (Engine::tags())
+ for my $t (Engine::tags())
{
- my $t = Engine::getTag($tag);
- checkref('tag', $tag, $t, 'HASH');
- error "short description for tag $tag undefined" if not defined $t->{sdesc};
- checkref('packages in tag', $tag, $t->{pkgs}, 'ARRAY');
+ checkref('tag', $t, $t, 'Engine::Tag');
+ error "short description for tag ", $t->name(), " undefined" if not defined $t->sdesc;
my %seen;
- for my $t (@{$t->{pkgs}})
+ for my $p ($t->pkgs())
{
- error "tag $tag contains an undef tag" if not defined $t;
- error "tag $tag contains the duplicate tag $t" if exists $seen{$t};
- $seen{$t} = 1;
+ error "tag ", $t->name, " contains an undef tag" if not defined $p;
+ error "tag ", $t->name, " contains the duplicate tag ", $p->name if exists $seen{$p->name};
+ $seen{$p->name} = 1;
}
}
Engine::closeDB();
} elsif ($cmd eq 'dump') {
Engine::openDB();
- for my $pkg (Engine::packages())
+ for my $p (Engine::packages())
{
- my $p = Engine::getPackage($pkg);
- my $ldesc = substr(join(' ', split("\n", ($p->{ldesc} or ''))), 0, 60);
- printf "PKG name %s\n", $p->{name};
- printf "pkg sdesc %s\n", $p->{sdesc};
+ my $ldesc = substr(join(' ', split("\n", ($p->ldesc() or ''))), 0, 60);
+ printf "PKG name %s\n", $p->name();
+ printf "pkg sdesc %s\n", $p->sdesc();
printf "pkg ldesc %s\n", $ldesc;
- printf "pkg tags %s\n", join(', ', @{$p->{tags}});
+ printf "pkg tags %s\n", join(', ', map { $_->{name} } $p->tags());
}
- for my $facet (Engine::facets())
+ for my $f (Engine::facets())
{
- my $f = Engine::getFacet($facet);
- my $ldesc = substr(join(' ', split("\n", ($f->{ldesc} or ''))), 0, 60);
- printf "FAC name %s\n", $f->{name};
- printf "fac sdesc %s\n", ($f->{sdesc} or '(undef)');
+ my $ldesc = substr(join(' ', split("\n", ($f->ldesc() or ''))), 0, 60);
+ printf "FAC name %s\n", $f->name();
+ printf "fac sdesc %s\n", ($f->sdesc() or '(undef)');
printf "fac ldesc %s\n", $ldesc;
- printf "fac tags %s\n", join(', ', @{$f->{tags}});
+ printf "fac tags %s\n", join(', ', map { $_->{name} } $f->tags());
}
- for my $tag (Engine::tags())
+ for my $t (Engine::tags())
{
- my $t = Engine::getTag($tag);
- my $ldesc = substr(join(' ', split("\n", ($t->{ldesc} or ''))), 0, 60);
- printf "TAG name %s\n", $t->{name};
- printf "tag sdesc %s\n", ($t->{sdesc} or '(undef)');
+ my $ldesc = substr(join(' ', split("\n", ($t->ldesc() or ''))), 0, 60);
+ printf "TAG name %s\n", $t->name();
+ printf "tag sdesc %s\n", ($t->sdesc() or '(undef)');
printf "tag ldesc %s\n", $ldesc;
- printf "tag packages %s\n", join(', ', @{$t->{pkgs}});
+ printf "tag packages %s\n", join(', ', map { $_->{name} } $t->pkgs());
}
Engine::closeDB();
} else {
More information about the Debtags-commits
mailing list