[Debtags-commits] [svn] r1460 -
central-database/branches/alioth/webfrontend
Enrico Zini
enrico at costa.debian.org
Mon Oct 31 19:02:45 UTC 2005
Author: enrico
Date: Mon Oct 31 19:02:45 2005
New Revision: 1460
Added:
central-database/branches/alioth/webfrontend/Web.pm
- copied, changed from r1456, central-database/branches/alioth/webfrontend/index.cgi
Modified:
central-database/branches/alioth/webfrontend/index.cgi
Log:
Added web utils module
Copied: central-database/branches/alioth/webfrontend/Web.pm (from r1456, central-database/branches/alioth/webfrontend/index.cgi)
==============================================================================
--- central-database/branches/alioth/webfrontend/index.cgi (original)
+++ central-database/branches/alioth/webfrontend/Web.pm Mon Oct 31 19:02:45 2005
@@ -1,33 +1,32 @@
-#!/usr/bin/perl -w
+package Web;
-#
-# WARNING:
-#
-# This is not the cleanest code, and it really needs a rewrite
-# Use at your own risk!
-#
+require Exporter;
+ at ISA = qw(Exporter);
+ at EXPORT_OK = qw(msg);
use strict;
use warnings;
-use English;
-use CGI qw/:standard/;
-use HTML::Template;
-use URI::Escape;
-use Engine;
-use Navigation;
-##
-## Configuration options
-##
+use Carp;
+#use CGI qw/:standard/;
+#use HTML::Template;
+#use URI::Escape;
+#use Engine;
+#use Navigation;
+
+our $log;
+
+$SIG{__WARN__} = sub {
+ $log .= $_[0]."\n";
+};
+
+$SIG{__DIE__} = sub {
+ $log .= $_[0]."\n";
+
+ print "Content-type: text/plain\n\n$log\n";
+ die $_[0];
+};
-#my $release="unstable";
-
-
-##
-## Generic functions
-##
-
-my $log;
# Log a message
sub msg ($@)
{
@@ -36,337 +35,17 @@
printf STDERR $format, @list;
}
-# Returns the facet name for a tag
-sub facet ($) { return (split('::', $_[0]))[0] or 'legacy'; }
-
-#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";
-
-# Parse input values
-my (@sel_tags, @sel_words);
-
-for my $par (param())
+sub log_html ()
{
-# 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')
+ if ($log)
{
- 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);
-# msg "Found: %s->%s\n", $par, $selwords;
- if ($selwords && $selwords =~ m/([a-z0-9\-:.,]+)/)
- {
- @sel_words = split(/\s+/, $1);
- }
- }
-}
-
-# Only take input tags once, and validate them
-{
- my %tags = map { $_ => 1 } @sel_tags;
- @sel_tags = Engine::tag(sort keys %tags);
-}
-
-#msg "Tags: %s\n", join(', ', map { $_->name } @sel_tags);
-
-
-##
-## Build navigation
-##
-
-Navigation::build(@sel_tags, @sel_words);
-
-
-##
-## Build structures for HTML::Template
-##
-
-my @ht_facets;
-my @ht_curpkgs;
-my @ht_subpkgs;
-
-
-# Compute tag statistics
-my %facet_counts;
-my %tag_counts;
-for my $p (@Navigation::pkgs, @Navigation::subpkgs)
-{
- foreach my $t ($p->tags())
- {
- $tag_counts{$t->name} += 1;
- $facet_counts{$t->facet->name} += 1;
- }
-}
-
-# Select the child tags
-my %seen = map { $_->name => 1 } @sel_tags;
-
-# Facets
-my $count_unselected = 0;
-my $count_subpkg = scalar(@Navigation::subpkgs);
-foreach my $f (Engine::facet(keys %facet_counts))
-{
- my @seen_tags;
- my @tags;
- foreach my $t ($f->tags())
- {
- # Skip the empty tags
- next if not $tag_counts{$t->name};
-
- if (exists $seen{$t->name})
- {
- push @seen_tags, {
- NAME => $t->name,
- SDESC => $t->sdesc,
- LDESC => $t->ldesc,
- COUNT => $tag_counts{$t->name},
- REMURL =>
- "?tags=".uri_escape(join(",", map { $_->name } grep { $_ != $t } @sel_tags)),
- };
- } else {
- ++$count_unselected;
- if ($count_subpkg) {
- push @tags, {
- NAME => $t->name,
- SDESC => $t->sdesc,
- LDESC => $t->ldesc,
- COUNT => $tag_counts{$t->name},
- };
- }
- }
-
- }
- push @ht_facets, {
- NAME => $f->name,
- SDESC => $f->sdesc,
- LDESC => $f->ldesc,
- SEEN => \@seen_tags,
- TAGS => \@tags,
- COUNT => $facet_counts{$f->name},
- SELCOUNT => scalar(@seen_tags),
- UNSCOUNT => scalar(@tags),
- TAGCOUNT => scalar(@seen_tags) + scalar(@tags),
- } if scalar(@seen_tags) or scalar(@tags);
-}
-sub bystats ($$)
-{
- my ($a, $b) = @_;
- return $b->{SELCOUNT} <=> $a->{SELCOUNT}
- if $b->{SELCOUNT} != $a->{SELCOUNT};
- return $b->{TAGCOUNT} <=> $a->{TAGCOUNT}
- if $b->{TAGCOUNT} != $a->{TAGCOUNT};
- return $a->{SDESC} cmp $b->{SDESC};
-
-}
- at ht_facets = sort bystats @ht_facets;
-
-# Package groups
-
-# Sort packages by their tagset
-sub bytagset ($$)
-{
- my ($a, $b) = @_;
- my @atags = sort map { $_->name } $a->tags;
- my @btags = sort map { $_->name } $b->tags;
-
- # Smallest tagsets first
- return scalar(@atags) <=> scalar(@btags) if (scalar(@atags) != scalar(@btags));
-
- for my $i (0 .. $#atags)
- {
- return $atags[$i] cmp $btags[$i] if $atags[$i] ne $btags[$i];
- }
- return 0;
-}
-
-# Packages in subgroups
-my $subgroup_count= 0;
-my $last_sec_start = 0;
-my $lastts = '';
-foreach my $p (sort bytagset @Navigation::pkgs)
-{
- my @tags = sort { $a->name() cmp $b->name() } grep { !$seen{$_->name()} } $p->tags();
-
- if (! @tags)
- {
- # This is a package really in the current group
- push @ht_curpkgs, {
- NAME => $p->name(),
- SDESC => $p->sdesc(),
- LDESC => $p->ldesc(),
- URL => "edit.cgi?pkg=".uri_escape($p->name()).
- "&tags=".uri_escape(join(',', map{$_->name()} @sel_tags)),
- };
- } else {
- # This is a package pulled from a subgroup
- my %data;
-
- my $ts = join(',', @tags);
- if ($ts ne $lastts)
- {
- # We are at a tagset change
- ++$subgroup_count;
-
- $data{SECTION} =
- [ map { NAME=>$_->sdesc() },
- sort { $a->sdesc cmp $b->sdesc }
- grep { !$seen{$_->name} } @tags ];
-
- # Initialize with current position, we'll subtract it from the start of
- # next section when it happens
- if (@ht_subpkgs)
- {
- $ht_subpkgs[$#ht_subpkgs]{LAST} = 1;
- $ht_subpkgs[$last_sec_start]{COUNT} = @ht_subpkgs - $last_sec_start;
- $last_sec_start = @ht_subpkgs;
- }
-
- $lastts = $ts;
- }
- $data{NAME} = $p->name();
- $data{SDESC} = $p->sdesc();
- $data{LDESC} = $p->ldesc();
- $data{URL} = "edit.cgi?pkg=".uri_escape($p->name()).
- "&tags=".uri_escape(join(',', map{$_->name()} @sel_tags)),
-
- push @ht_subpkgs, \%data;
- }
-}
-if (@ht_subpkgs)
-{
- $ht_subpkgs[$#ht_subpkgs]->{LAST} = 1;
- $ht_subpkgs[$last_sec_start]{COUNT} = @ht_subpkgs - $last_sec_start;
-}
-
-#msg "%d facets, %d pkgs, %d curpkgs, %d subpkgs\n", scalar(@ht_facets), scalar(@Navigation::pkgs), scalar(@ht_curpkgs), scalar @ht_subpkgs;
-
-
-##
-## Compile template structures
-##
-
-$template->param(CURTAGS => join(',', map{$_->name} @sel_tags));
-$template->param(CURWORDS => join(' ', at sel_words));
-
-$template->param(FACETS => \@ht_facets);
-$template->param(CURPKGS => \@ht_curpkgs);
-$template->param(SUBPKGS => \@ht_subpkgs);
-
-my $facet_intro;
-my $c = scalar(keys %tag_counts);
-if ($c == 0)
-{
- $facet_intro = "There is <b>no</b> tag ";
-} elsif ($c == 1) {
- $facet_intro = "There is <b>one</b> tag ";
-} else {
- $facet_intro = "There are <b>$c</b> tags ";
-}
-if ($count_unselected == 0)
-{
- $facet_intro .= "currently selected."
-} else {
- $c = scalar keys %facet_counts;
- if ($c == 1)
- {
- $facet_intro .= "in <b>one</b> facet. ";
- } else {
- $facet_intro .= sprintf "in <b>%d</b> facets. ", $c;
- }
- $c = scalar(@sel_tags);
- if ($c == 0)
- {
- $facet_intro .= "<b>None</b> is currently selected.";
- }
- elsif ($c == 1)
- {
- $facet_intro .= "<b>One</b> is currently selected.";
- } else {
- $facet_intro .= sprintf "<b>%d</b> are currently selected.", $c;
- }
-}
-$template->param(FACET_INTRO => $facet_intro);
-
-my $curpkgs_intro;
-my $curpkgs_also;
-my $cur = scalar(@ht_curpkgs);
-my $sub = scalar(@ht_subpkgs);
-if ($cur == 0)
-{
- $curpkgs_intro = "There is <b>no</b> package in this group. ";
- $curpkgs_also = '';
-} elsif ($cur == 1) {
- $curpkgs_intro = "There is <b>one</b> package in this group. ";
- $curpkgs_also = ' also';
-} else {
- $curpkgs_intro = "There are <b>$cur</b> packages in this group. ";
- $curpkgs_also = ' also';
-}
-if ($sub == 0)
-{
- $curpkgs_intro .= "More packages can be found by further refining the selection."
-} else {
- my $cp_verb;
- if ($sub == 1) {
- $curpkgs_intro .= "<b>One</b> package from ";
- $cp_verb = "is";
+ my $res = $log;
+ $res =~ s/\n/<br>/g;
+ return $res;
} else {
- $curpkgs_intro .= "<b>$sub</b> packages from ";
- $cp_verb = "are";
- }
- if ($subgroup_count == 1) {
- $curpkgs_intro .= "<b>one</b> subgroup $cp_verb$curpkgs_also displayed below.";
- } else {
- $curpkgs_intro .= "<b>$subgroup_count</b> subgroups $cp_verb$curpkgs_also displayed below.";
+ return "";
}
}
-$template->param(PKGS_INTRO => $curpkgs_intro);
-
-if ($log)
-{
- $log =~ s/\n/<br>/g;
- $template->param(LOG => $log);
-}
-
-# Finally, output
-print "Content-Type: text/html\n\n";
-print $template->output();
-exit 0;
+1;
# vim:set ts=4 sw=4:
Modified: central-database/branches/alioth/webfrontend/index.cgi
==============================================================================
--- central-database/branches/alioth/webfrontend/index.cgi (original)
+++ central-database/branches/alioth/webfrontend/index.cgi Mon Oct 31 19:02:45 2005
@@ -15,6 +15,7 @@
use URI::Escape;
use Engine;
use Navigation;
+use Web qw/msg/;
##
## Configuration options
@@ -27,15 +28,6 @@
## Generic functions
##
-my $log;
-# Log a message
-sub msg ($@)
-{
- 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'; }
@@ -358,10 +350,9 @@
}
$template->param(PKGS_INTRO => $curpkgs_intro);
-if ($log)
+if ($Web::log)
{
- $log =~ s/\n/<br>/g;
- $template->param(LOG => $log);
+ $template->param(LOG => Web::log_html());
}
# Finally, output
More information about the Debtags-commits
mailing list