[Debtags-commits] [svn] r1437 -
central-database/branches/alioth/webfrontend
Enrico Zini
enrico at costa.debian.org
Sun Oct 30 11:27:59 UTC 2005
Author: enrico
Date: Sun Oct 30 11:27:58 2005
New Revision: 1437
Modified:
central-database/branches/alioth/webfrontend/Engine.pm
central-database/branches/alioth/webfrontend/browsetemplate.html
central-database/branches/alioth/webfrontend/index.cgi
Log:
Navigation starts to work
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 11:27:58 2005
@@ -52,6 +52,7 @@
## Low-level DB I/O
##
+# Open the database in read-only mode
sub openDB ()
{
tie %packages, 'GDBM_File', $BASEDIR.'/packages.gdbm', &GDBM_READER, 0640;
@@ -60,21 +61,32 @@
$tied = 1;
}
+# Close the database
sub closeDB ()
{
untie %packages;
+ undef %packages;
untie %facets;
+ undef %facets;
untie %tags;
+ undef %tags;
$tied = 0;
}
+# Reopen the database after modifications
sub reopenDB ()
{
closeDB();
openDB();
}
+# Get the list of package names
sub packages () { return keys %packages; }
+
+# Check if a package exists
+sub hasPackage ($) { return exists $packages{$_[0]}; }
+
+# Get a package hash
sub getPackage ($)
{
my ($name) = @_;
@@ -88,13 +100,21 @@
tags => [ split(', ', ($tags or '')) ],
}
}
+
+# Set the value of a package, by its hash
sub setPackage ($)
{
my ($pkg) = @_;
$packages{$pkg->{name}} = join("\0", ($pkg->{sdesc} or ''), ($pkg->{ldesc} or ''), join(', ', @{$pkg->{tags}}));
}
+# 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 ($)
{
my ($name) = @_;
@@ -108,13 +128,21 @@
tags => [ split(', ', ($tags or '')) ],
}
}
+
+# Set the values of a facet, by its hash
sub setFacet ($)
{
my ($fac) = @_;
$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 ($)
{
my ($name) = @_;
@@ -128,6 +156,8 @@
packages => [ split(', ', ($pkgs or '')) ],
}
}
+
+# Set the values of a tag, by its hash
sub setTag ($)
{
my ($tag) = @_;
@@ -135,11 +165,68 @@
$tags{$tag->{name}} = join("\0", ($tag->{sdesc} or ''), ($tag->{ldesc} or ''), join(', ', @{$tag->{packages}}));
}
+##
+## Query functions
+##
+
+sub matchPackage ($$)
+{
+ my ($parms, $p) = @_;
+
+# &main::msg("Match t:%s w:%s\n", 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->{packages}};
+ } 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
sub resyncPackages ($)
{
my ($pkgdb) = @_;
@@ -184,6 +271,7 @@
}
}
+# Update the vocabulary informations in the database from an updated vocabulary
sub resyncVocabulary ($)
{
my ($vocab) = @_;
@@ -260,6 +348,7 @@
}
}
+# Set the tag information in the database to that of the given tag source
sub resyncTags ($)
{
my ($tags) = @_;
@@ -268,7 +357,11 @@
open IN, $tags or die "Cannot open $tags: $!";
while (<IN>)
{
- my ($pkg, $tags) = split(': ', @_);
+ chop;
+ die "Cannot parse line \"$_\"" if (/[^:,] /);
+ my ($pkg, $tags) = split(': ', $_);
+
+ #printf STDERR "Pkg: %s, tags: %s\n", $pkg, $tags;
# Compute the difference between the previous tagset and the
# one we just read
@@ -312,6 +405,8 @@
close IN;
}
+# Wipe the database and recreate it from the given package database, vocabulary
+# and tag database
sub init ($$$)
{
my ($pkgs, $vocab, $tags) = @_;
@@ -325,7 +420,7 @@
resyncPackages($pkgs);
resyncVocabulary($vocab);
- resyncTags($vocab);
+ resyncTags($tags);
untie %packages ;
untie %facets ;
@@ -334,6 +429,7 @@
openDB() if $reopen;
}
+# Update the database with a newer package database and vocabulary
sub resync ($$)
{
my ($pkgs, $vocab) = @_;
@@ -356,3 +452,4 @@
}
1;
+# vim:set ts=4 sw=4:
Modified: central-database/branches/alioth/webfrontend/browsetemplate.html
==============================================================================
--- central-database/branches/alioth/webfrontend/browsetemplate.html (original)
+++ central-database/branches/alioth/webfrontend/browsetemplate.html Sun Oct 30 11:27:58 2005
@@ -1,53 +1,83 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="en">
<head>
-<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
-<title>Debian Tag Browser</title>
-<meta name="Description" content="">
-<meta name="Language" content="English">
-<meta name="Author" content="Erich Schubert, erich at debian.org">
-<meta name="Generator" content="packagebrowser">
-<link rev="made" href="mailto:erich at debian.org">
-<link href="main.css" rel="stylesheet" type="text/css">
+ <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+ <title>Debian Tag Browser</title>
+ <meta name="Description" content="">
+ <meta name="Language" content="English">
+ <meta name="Author" content="Erich Schubert, erich at debian.org">
+ <meta name="Generator" content="packagebrowser">
+ <link rev="made" href="mailto:erich at debian.org">
+ <link href="main.css" rel="stylesheet" type="text/css">
</head>
-<body text="#000000" bgcolor="#FFFFFF" link="#0000FF" vlink="#800080" alink="#FF0000">
-<h1>Debian Package Browser</h1>
-<p><a href="index.cgi">Return to the package browser start page</a></p>
-<p>Please <em>help</em> sorting the
-<a href="index.cgi?tags=special::not-yet-tagged">not yet tagged</a> packages.
-For more information visit the
-<a href="http://debtags.alioth.debian.org/">Debian Usability Project Homepage</a> at <a href="http://alioth.debian.org/">Alioth</a>.</p>
-<hr class="close">
-<TMPL_IF NAME="HAVETAGS">
- <h2>Selected tags:</h2>
- <TMPL_LOOP NAME="HAVETAGS">
- <b><TMPL_VAR NAME="DESC"></b> (<a href="<TMPL_VAR NAME="URL">">remove</a>)
- </TMPL_LOOP>
- </p>
-</TMPL_IF>
-<TMPL_IF NAME="NEWTAGS">
- <h2>Automatic Subgroups:</h2>
- <TMPL_LOOP NAME="NEWTAGS">
- <a href="<TMPL_VAR NAME="URL">"><TMPL_VAR NAME="DESC"></a><br>
- </TMPL_LOOP>
-</TMPL_IF>
-<hr class="close">
-<TMPL_UNLESS NAME="NUMPACKAGES">
- <p>No Packages shown. All packages can be found in the subcategories.</p>
-<TMPL_ELSE>
- <p><b><TMPL_VAR NAME="NUMPACKAGES"></b> Packages in this group or in minor subgroups:</p>
- <table border=0>
- <TMPL_LOOP NAME="PACKAGES">
- <TMPL_IF SECTION><tr class="section"><td colspan=2 class="section">
- <TMPL_VAR NAME="SECTION"></td></tr>
- <TMPL_ELSE><TMPL_IF ODDROW><tr class="oddrow">
- <TMPL_ELSE><tr class="evenrow"></TMPL_IF>
- <td valign=top><a href="<TMPL_VAR NAME="URL">"><TMPL_VAR NAME="PACKAGE"></a></td>
- <td valign=top><TMPL_VAR NAME="DESC"></td></tr>
- </TMPL_IF>
- </TMPL_LOOP>
- </table>
-</TMPL_UNLESS>
+<body>
+ <h1>Debian Package Browser</h1>
+
+ <TMPL_VAR NAME="LOG">
+
+ <form name="search" method="get">
+ <input type="hidden" name="tags" value='<tmpl_var name="CURTAGS">'>
+ <input type="submit">
+
+ <p><a href="index.cgi">Return to the package browser start page</a></p>
+ <p>Please <em>help</em> sorting the
+ <a href="index.cgi?tags=special::not-yet-tagged">not yet tagged</a> packages.
+ For more information visit the
+ <a href="http://debtags.alioth.debian.org/">Debian Usability Project Homepage</a> at <a href="http://alioth.debian.org/">Alioth</a>.</p>
+
+ <hr class="close" />
+
+ <tmpl_if NAME="HAVETAGS">
+ <h2>Selected tags:</h2>
+ <TMPL_LOOP NAME="HAVETAGS">
+ <b><TMPL_VAR NAME="DESC"></b> (<a href="<TMPL_VAR NAME="URL">">remove</a>)
+ </TMPL_LOOP>
+ </p>
+ </tmpl_if>
+
+ <tmpl_if name="NEWFACETS">
+ <h2>Automatic Subgroups:</h2>
+ <tmpl_loop name="NEWFACETS">
+ <p><tmpl_var name="DESC"> (<tmpl_var name="COUNT"> packages):<br />
+ <blockquote>
+ <tmpl_loop name="SELTAGS">
+ <a href='<tmpl_var name="URL">'><tmpl_var name="DESC"></a> (<tmpl_var name="COUNT"> packages)<br />
+ </tmpl_loop>
+
+ <select name="facet-<tmpl_var name="NAME">">
+ <option value=":NONE:">Add one
+ <tmpl_loop name="TAGS">
+ <option value='<tmpl_var name="TAG">'><tmpl_var name="DESC">
+
+ <!--<a href="<TMPL_VAR NAME="URL">"><TMPL_VAR NAME="DESC"></a> (<TMPL_VAR NAME="COUNT"> packages)<br />-->
+ </tmpl_loop>
+ </select>
+ </blockquote>
+ </p>
+ </tmpl_loop>
+ </tmpl_if>
+
+ <hr class="close">
+
+ <TMPL_UNLESS NAME="NUMPACKAGES">
+ <p>No Packages shown. All packages can be found in the subcategories.</p>
+ <TMPL_ELSE>
+ <p><b><TMPL_VAR NAME="NUMPACKAGES"></b> Packages in this group or in minor subgroups:</p>
+ <table border=0>
+ <TMPL_LOOP NAME="PACKAGES">
+ <TMPL_IF SECTION><tr class="section"><td colspan=2 class="section">
+ <TMPL_VAR NAME="SECTION"></td></tr>
+ <TMPL_ELSE><TMPL_IF ODDROW><tr class="oddrow">
+ <TMPL_ELSE><tr class="evenrow"></TMPL_IF>
+ <td valign=top><a href="<TMPL_VAR NAME="URL">"><TMPL_VAR NAME="PACKAGE"></a></td>
+ <td valign=top><TMPL_VAR NAME="DESC"></td></tr>
+ </TMPL_IF>
+ </TMPL_LOOP>
+ </table>
+ </TMPL_UNLESS>
+
+ </form>
+
<table border="0" width="100%" class="close">
<tr>
<td align="left" class="close">
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 11:27:58 2005
@@ -8,242 +8,320 @@
#
use strict;
+use warnings;
use English;
use CGI qw/:standard/;
use HTML::Template;
-use DBI;
use URI::Escape;
-use Cache::FileCache;
-use Storable qw(freeze thaw);
+#use Cache::FileCache;
+#use Storable qw(freeze thaw);
+use Engine;
+
+##
+## Configuration options
+##
-#### configuration options
my $release="unstable";
my $packages_limit=10; # 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
-my $db_datasource='DBI:mysql:database=debpackages';
-my $db_user="";
-my $db_pass="";
-my $qry_onetag="SELECT r.Package, r.Tag".
- " FROM packagetags AS r, packagetags AS r2".
- " WHERE r.Package = r2.Package AND r2.Tag = ?";
-my $qry_all="SELECT r.Package, r.Tag".
- " FROM packagetags AS r";
-my $qry_pkgdesc="SELECT Description FROM packages WHERE package = ?";
-my $qry_taglist="SELECT Tag,Title FROM tagsdesc ORDER BY Title";
-my $cache = new Cache::FileCache( { 'namespace' => 'browser', 'default_expires_in' => 600 } );
-
-sub array_index($$);
-#### open database connection
-my $dbh = DBI->connect($db_datasource,$db_user,$db_pass);
-#### load the template file
+##
+## Generic functions
+##
+
+my $log;
+# Log a message
+sub msg ($@)
+{
+ my ($format, @list) = @_;
+ $log .= sprintf($format, @list);
+}
+
+# Returns true if the has contains all the values in the vector
+sub contains ($\@)
+{
+ my ($pkg, $vec) = @_;
+ my %hash = map { $_ => 1 } @{$pkg->{tags}};
+ for my $i (@$vec)
+ {
+ return undef if not exists $hash{$i};
+ }
+ 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}};
+ for my $i (@$vec)
+ {
+ return 1 if exists $hash{$i};
+ }
+ return undef;
+}
+
+#sub array_index ($$);
+#sub array_index($$) { my($haystack,$needle) = @_;
+# for (my $i=0; $i <= $#$haystack; $i++) {
+# return $i if ($$haystack[$i] eq $needle);
+# }
+# return -1;
+#}
+
+
+##
+## Startup
+##
+
+# Open database connection
+Engine::openDB();
+
+# Load the template file
my $template = HTML::Template->new(
filename => 'browsetemplate.html',
die_on_bad_params => 0)
|| die "Could not open template";
-my $seltags="";
-my $param=param("tags");
-if ($param && $param =~ m/([a-z0-9\-:.,]+)/) { $seltags=$1; }
-
-unless($seltags) { $packages_limit=0; $subgroup_limit=0; }
-
-my @sel_tags=split(/,/,$seltags);
-
-my $matchingdat;
-if ($#sel_tags < 0) {
- # Load parents and their descriptions.
- my $sth = $dbh->prepare($qry_all);
- $sth->execute();
- $matchingdat=$sth->fetchall_arrayref;
- $sth->finish;
-} else {
- # use the last tag which usually is the one with the least matches
- my $tag = $sel_tags[$#sel_tags];
- my $sth = $dbh->prepare($qry_onetag);
- $sth->execute($tag);
- $matchingdat=$sth->fetchall_arrayref;
- $sth->finish;
-}
-# now convert the matching packages data to an more accessable data
-# structure...
-my %pkg_tags;
-foreach my $dataset (@$matchingdat) {
- my ($package,$tag) = @$dataset;
- unless ($pkg_tags{$package}) { $pkg_tags{$package}=[]; }
- push @{$pkg_tags{$package}},$tag;
-}
-
-# Now do the complete filtering
-PACKAGE: foreach my $package (keys %pkg_tags) {
- my @tags = @{$pkg_tags{$package}};
- foreach my $sel_tag (@sel_tags) {
- my $i=array_index(\@tags,$sel_tag);
- if ($i == -1) {
- delete $pkg_tags{$package};
- next PACKAGE;
- }
- splice(@tags,$i,1);
- }
- @tags = sort @tags;
- $pkg_tags{$package} = \@tags;
-}
-
-# during this run, count the number of tag hits as well.
-my %tag_counts;
-foreach my $package (keys %pkg_tags) {
- my @tags = @{$pkg_tags{$package}};
- foreach my $tag (@tags) {
+# Parse input values
+my (@sel_tags, @sel_words);
+
+for my $par (param())
+{
+# msg "Testing: %s\n", $par;
+ if ($par =~ /^facet-/)
+ {
+ my $tag = param($par);
+ next if $tag eq ':NONE:';
+ 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;
+ if ($seltags && $seltags =~ m/([a-z0-9\-:.,]+)/)
+ {
+ push @sel_tags, split(/,/, $1);
+ } else {
+ $packages_limit = 0;
+ $subgroup_limit = 0;
+ }
+ }
+ elsif ($par eq 'words')
+ {
+ my $selwords = param($par);
+ if ($selwords && $selwords =~ m/([a-z0-9\-:.,]+)/)
+ {
+ @sel_words = split(/,/, $1);
+ }
+ }
+}
+
+# Only take input tags once, and validate them
+{
+ my %tags = map { $_ => 1 } @sel_tags;
+ @sel_tags = sort grep { Engine::hasTag($_) } keys %tags;
+}
+
+#msg "Tags: %s\n", join(', ', @sel_tags);
+
+##
+## Package selection
+##
+
+# Get the list of packages we should display
+# and count the tag cardinalities
+my (@pkgs, %tag_counts);
+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}})
+ {
$tag_counts{$tag} += 1;
}
}
+msg "Found %d packages\n", scalar(@pkgs);
+
+#printf STDERR "Start: %d packages\n", scalar(@pkgs);
+
+##
+## Building navigation
+##
+
# we now try to build a reasonable set of tags to choose from
my @tag_newtags;
-my @remaining_pkgs;
-my $frozentags = $cache->get( (join "+", at sel_tags)."+newtags" );
-if (not defined $frozentags) {
- my %remaining_pkg_tags=%pkg_tags;
- my %remaining_counts=%tag_counts;
-
- my $num_packages=scalar keys %pkg_tags;
-
- # remove the already selected tags
- foreach my $tag (@sel_tags) {
- delete $remaining_counts{$tag};
- }
- while (%remaining_counts && ( (scalar keys %remaining_pkg_tags) > $packages_limit)) {
- # now find the "best" remaining tag
- my ($best_tag,$best_count)=("",0);
- for my $tag (keys %remaining_counts) {
- if ($remaining_counts{$tag} > $best_count) {
- if ($tag_counts{$tag} < $useless_limit * $num_packages) {
- $best_tag=$tag;
- $best_count = $remaining_counts{$tag};
- }
- }
- }
- last if ($best_count < $subgroup_limit);
- last unless $best_tag;
- push @tag_newtags,$best_tag;
-
- # now rebuild the data structure:
- # ignore all packages that are in these "best" categorys
- %remaining_counts=();
- PACKAGE: foreach my $package (keys %remaining_pkg_tags) {
- my @tags = @{$pkg_tags{$package}};
- # if the package has the currently found tag, remove it.
- foreach my $tag (@tags) {
- if ($tag eq $best_tag) {
- delete $remaining_pkg_tags{$package};
- next PACKAGE;
- }
- }
- # else count the remaining tags
- foreach my $tag (@tags) {
- $remaining_counts{$tag} += 1;
- }
- }
- # remove the already selected tags
- foreach my $tag (@sel_tags) {
- delete $remaining_counts{$tag};
- }
+
+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};
+ }
+ return (sort { $fstats{$b} <=> $fstats{$a} } keys %fstats)[0];
+}
+
+# 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};
}
- sub pkgsorter {
- my @atags = @{$pkg_tags{$a}};
- my @btags = @{$pkg_tags{$b}};
- my $min = ($#atags < $#btags) ? $#atags : $#btags;
- for (my $i=0; $i<=$min; $i++) {
- if ($atags[$i] ne $btags[$i]) {
- return $atags[$i] cmp $btags[$i];
+ # 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++;
}
- if ($#atags > $min) { return +1; }
- if ($#btags > $min) { return -1; }
- return ($a cmp $b);
}
- @remaining_pkgs = (sort pkgsorter keys %remaining_pkg_tags);
-
- # sort the remaining tags by number of original hits
- @tag_newtags = sort { $tag_counts{$b} <=> $tag_counts{$a} } @tag_newtags;
- $cache->set( (join "+", at sel_tags)."+newtags", (freeze \@tag_newtags) );
- $cache->set( (join "+", at sel_tags)."+pkgs", (freeze \@remaining_pkgs) );
-} else {
- @tag_newtags = @{ thaw( $frozentags ) };
- @remaining_pkgs = @{ thaw( $cache->get( (join "+", at sel_tags)."+pkgs" )) };
+ return @tags;
}
-# Build a list of all known tags
-my %tag_desc;
-my $sth = $dbh->prepare($qry_taglist);
-$sth->execute();
-while (my $taginfo=$sth->fetchrow_arrayref) {
- my ($tag,$desc) = @$taginfo;
- $tag_desc{$tag} = $desc;
+#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);
+
+ push @tag_newtags, @tags;
}
-$sth->finish;
+#msg("Done. %d tags, %d packages.\n", scalar(@tag_newtags), scalar keys %work_pkgs);
+
+
+##
+## Output results
+##
+
+# Build a list of all known tags
+#my %tag_desc;
+#for my $tag (Engine::tags())
+#{
+# my $t = Engine::getTag($tag);
+# $tag_desc{$tag} = $t->{sdesc};
+#}
## Build HTML::Template data structures
-my @ht_newtags;
-foreach my $tag (@tag_newtags) {
- push @ht_newtags, {
- TAG => $tag,
- DESC => $tag_desc{$tag},
- COUNT => $tag_counts{$tag},
- URL => "?tags=".uri_escape(join(",", at sel_tags,$tag))
- };
-}
+
+# Currently selected tags
+my %seltags_perfacet;
my @ht_seltags;
-for (my $i=0; $i<=$#sel_tags; $i++) {
+for (my $i = 0; $i < @sel_tags; $i++)
+{
+ my $t = Engine::getTag($sel_tags[$i]);
my @othertags=@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}},
+ URL => $url
+ };
+
push @ht_seltags, {
- TAG => $sel_tags[$i],
- DESC => $tag_desc{$sel_tags[$i]},
- URL => "?tags=".uri_escape(join(",", at othertags))
+ TAG => $t->{name},
+ DESC => $t->{sdesc},
+ COUNT => $tag_counts{$t->{name}},
+ URL => $url
};
}
-$sth = $dbh->prepare($qry_pkgdesc);
+
+# Further selectable tags in the navigation part
+my $cur_fac;
+my @ht_newfacets;
+foreach my $tag (sort @tag_newtags)
+{
+ my $facet = facet($tag);
+ if (not defined $cur_fac or $cur_fac ne $facet)
+ {
+ my $f = Engine::getFacet($facet);
+ push @ht_newfacets, {
+ NAME => $facet,
+ DESC => $f->{sdesc},
+ COUNT => 0,
+ SELTAGS => exists $seltags_perfacet{$facet} ? $seltags_perfacet{$facet} : [],
+ TAGS => []
+ };
+ $cur_fac = $facet;
+ }
+ my $t = Engine::getTag($tag);
+ $ht_newfacets[$#ht_newfacets]{COUNT} += $tag_counts{$tag};
+ push @{$ht_newfacets[$#ht_newfacets]{TAGS}}, {
+ TAG => $tag,
+ DESC => $t->{sdesc},
+ COUNT => $tag_counts{$tag},
+ URL => "?tags=".uri_escape(join(",", at sel_tags,$tag))
+ };
+}
+
+# Packages in the current view
my @ht_pkgs;
my $lastsection="";
my $count=0;
-foreach my $package (@remaining_pkgs) {
+foreach my $pkg (@pkgs) {
$count++;
- next unless defined $pkg_tags{$package};
- my @tags = @{$pkg_tags{$package}};
- if ($lastsection ne join(" ",sort @tags)) {
+ my @tags = sort @{$pkg->{tags}};
+ if ($lastsection ne join(" ", @tags)) {
push @ht_pkgs, {
- SECTION => join(", ",sort(map { $tag_desc{$_} } @tags)),
+ SECTION => join(", ",sort(map { $_->{sdesc} } map { Engine::getTag($_) } @tags)),
};
- $lastsection = join(" ",sort @tags);
+ $lastsection = join(" ", @tags);
}
- $sth->execute($package);
- my ($description) = $sth->fetchrow_array;
+ my ($description) = $pkg->{sdesc};
push @ht_pkgs, {
- PACKAGE => $package,
- URL => "edit.cgi?package=".uri_escape($package)."&tags=".uri_escape($seltags),
+ PACKAGE => $pkg->{name},
+ URL => "edit.cgi?package=".uri_escape($pkg->{name})."&tags=".uri_escape(join(',', at sel_tags)),
ODDROW => ($count % 2),
DESC => $description
}
}
-$sth->finish();
-# fill out the template
+# Fill in the template
$template->param(HAVETAGS => \@ht_seltags);
-$template->param(NEWTAGS => \@ht_newtags);
-$template->param(NUMPACKAGES => ($#remaining_pkgs + 1));
+$template->param(NEWFACETS => \@ht_newfacets);
+$template->param(NUMPACKAGES => scalar(@pkgs));
$template->param(PACKAGES => \@ht_pkgs);
+$template->param(CURTAGS => join(',', at sel_tags));
+$log =~ s/\n/<br>/g;
+$template->param(LOG => $log);
+# Finally, output
print "Content-Type: text/html\n\n";
print $template->output();
-sub array_index($$) { my($haystack,$needle) = @_;
- for (my $i=0; $i <= $#$haystack; $i++) {
- return $i if ($$haystack[$i] eq $needle);
- }
- return -1;
-}
-# vim:set sw=2:
+exit 0;
+# vim:set ts=4 sw=4:
More information about the Debtags-commits
mailing list