A few minor optimizations + better ordering of systems in manselect()

schema.sql

@@ -1,7 +1,7 @@
 
 -- TODO: "system" -> "repository"?
 -- TODO: index of (reverse) man page references?
--- TODO: Probably want an index on man(name) and man(hash)
+-- TODO: Probably want an index on man(name). Or try swapping column order in the unique index.
 -- TODO: Use some consistent naming of tables and columns
 
 
@@ -49,6 +49,9 @@ CREATE TABLE man (
 );
 
 
+CREATE INDEX ON man USING hash (hash);
+
+
 INSERT INTO systems (id, name, release, short, relorder) VALUES
   (1, 'Arch Linux', NULL,   'arch', 0),
   (2, 'Ubuntu',     '4.10', 'ubuntu-warty', 0),

www/index.pl

@@ -22,6 +22,17 @@ TUWF::set(
   db_login => [undef, undef, undef],
   debug => 1,
   xml_pretty => 2,
+  # Cache the system information
+  pre_request_handler => sub {
+    my $self = shift;
+    if(!$self->{systems}) {
+      $self->{systems} = $self->dbSystemGet;
+      $_->{full} = $_->{name}.($_->{release}?' '.$_->{release}:'') for(@{$self->{systems}});
+      $self->{sysbyid} = { map +($_->{id}, $_), @{$self->{systems}} };
+      $self->{sysbyshort} = { map +($_->{short}, $_), @{$self->{systems}} };
+    }
+    1;
+  },
 );
 
 
@@ -39,8 +50,6 @@ TUWF::run();
 
 sub home {
   my $self = shift;
-  my $sys = $self->dbSystemGet;
-
   $self->htmlHeader(title => 'Man Pages Archive');
   h1 'Man Pages Archive';
   p 'Welcome blah mission etc.';
@@ -49,9 +58,9 @@ sub home {
 
   h2 'Browse!';
   ul;
-   for(@$sys) {
+   for(@{$self->{systems}}) {
      li;
-      a href => "/browse/$_->{short}", $_->{release} ? "$_->{name} $_->{release}" : $_->{name};
+      a href => "/browse/$_->{short}", $_->{full};
      end;
    }
   end;
@@ -69,7 +78,7 @@ sub home {
 sub browsesys {
   my($self, $short) = @_;
 
-  my $sys = $self->dbSystemGet($short)->[0];
+  my $sys = $self->{sysbyshort}{$short};
   return $self->resNotFound if !$sys;
 
   my $chr = $ENV{QUERY_STRING} ? $ENV{QUERY_STRING} : $ENV{QUERY_STRING} eq '' ? 'a' : '0';
@@ -103,7 +112,7 @@ sub browsesys {
 sub browsepkg {
   my($self, $short, $name) = @_;
 
-  my $sys = $self->dbSystemGet($short)->[0];
+  my $sys = $self->{sysbyshort}{$short};
   return $self->resNotFound if !$sys;
 
   my $pkgs = $self->dbPackageGet($sys->{id}, $name);
@@ -148,11 +157,12 @@ sub manselect {
 
   my %sys;
   push @{$sys{$_->{system}}}, $_ for (@$lst);
+
   dl id => 'nav';
-   for my $sys (sort keys %sys) {
+   for my $sys (sort { my $x=$self->{sysbyid}{$a}; my $y=$self->{sysbyid}{$b}; $x->{name} cmp $y->{name} or $y->{relorder} <=> $x->{relorder} } keys %sys) {
      my %pkgs;
      push @{$pkgs{"$_->{package}-$_->{version}"}}, $_ for @{$sys{$sys}};
-     dt $sys;
+     dt $self->{sysbyid}{$sys}{full};
      dd;
       # TODO: This package sorting sucks. Versions should be date-sorted, in descending order.
       for my $pkg (sort keys %pkgs) {
@@ -240,7 +250,7 @@ sub manhtml {
 # Given the name and optionally the section or hash of a man page, check with a
 # list of man pages with the same name to select the right hash for display.
 sub gethash {
-  my($name, $sect, $hash, $list) = @_;
+  my($self, $name, $sect, $hash, $list) = @_;
 
   # If we already have a shorthash, just get the full hash
   if($hash) {
@@ -253,7 +263,7 @@ sub gethash {
     !(($a->{locale}||'') =~ /^(en|$)/) != !(($b->{locale}||'') =~ /^(en|$)/)
       ? (($a->{locale}||'') =~ /^(en|$)/ ? -1 : 1)
     # Newer versions of a package have higher priority
-    : $a->{sysid} == $b->{sysid} && $a->{package} eq $b->{package} && $a->{version} ne $b->{version}
+    : $a->{system} == $b->{system} && $a->{package} eq $b->{package} && $a->{version} ne $b->{version}
       ? $b->{released} cmp $a->{released}
     # Section prefix match.
     : $sect && !($a->{section} =~ /^\Q$sect/) != !($b->{section} =~ /^\Q$sect/)
@@ -265,8 +275,11 @@ sub gethash {
     : substr($a->{section},0,1) ne substr($b->{section},0,1)
       ? $a->{section} cmp $b->{section}
     # Prefer Arch over other systems
-    : $a->{sysid} != $b->{sysid}
+    : $a->{system} != $b->{system}
-      ? ($a->{sysid} == 1 ? -1 : 1)
+      ? ($a->{system} == 1 ? -1 : 1)
+    # Prefer a later system release over an older one
+    : $a->{system} != $b->{system} && $self->{sysbyid}{$a->{system}}{name} eq $self->{sysbyid}{$b->{system}}{name}
+      ? $self->{sysbyid}{$b->{system}}{relorder} <=> $self->{sysbyid}{$a->{system}}{relorder}
     # Sections without appendix before sections with appendix
     : $a->{section} ne $b->{section}
       ? $a->{section} cmp $b->{section}
@@ -284,7 +297,7 @@ sub man {
   my $sect = $name =~ s/\.([0-9n])$// ? $1 : undef;
   my $m = $self->dbManInfo(name => $name);
   return $self->resNotFound() if !@$m;
-  $hash = gethash($name, $sect, $hash, $m);
+  $hash = gethash($self, $name, $sect, $hash, $m);
 
   $self->htmlHeader(title => $name);
   manselect $self, $m, $hash;
@@ -311,7 +324,7 @@ sub man {
     my $l = $self->dbManInfo(hash => $hash);
     for(@$l) {
       Tr;
-       td $_->{system};
+       td $self->{sysbyid}{$_->{system}}{full};
        td "$_->{category}/$_->{package}";
        td $_->{version};
        td;
@@ -326,9 +339,9 @@ sub man {
   end;
 
   div id => 'contents';
-    h2 'Contents';
+   h2 'Contents';
-    my $c = $self->dbManContent($hash);
+   my $c = $self->dbManContent($hash);
-    pre; lit manhtml manfmt $c; end;
+   pre; lit manhtml manfmt $c; end;
   end;
   $self->htmlFooter;
 }
@@ -378,11 +391,26 @@ sub htmlHeader {
 
 
 sub htmlFooter {
+  my $self = shift;
+
      div id => 'footer';
        lit '2012 manned.org';
      end;
    end 'body';
   end 'html';
+
+  # write the SQL queries as a HTML comment when debugging is enabled
+  # (stolen from VNDB code)
+  if($self->debug) {
+    lit "\n<!--\n SQL Queries:\n";
+    for (@{$self->{_TUWF}{DB}{queries}}) {
+      my $q = !ref $_->[0] ? $_->[0] :
+        $_->[0][0].(exists $_->[0][1] ? ' | "'.join('", "', map defined()?$_:'NULL', @{$_->[0]}[1..$#{$_->[0]}]).'"' : '');
+      $q =~ s/^\s//g;
+      lit sprintf "  [%6.2fms] %s\n", $_->[1]*1000, $q;
+    }
+    lit "-->\n";
+  }
 }
 
 
@@ -397,7 +425,6 @@ sub dbManInfo {
   my $s = shift;
   my %o = @_;
 
-  # TODO: Option to only fetch the latest version of a package?
   my %where = (
     $o{name}      ? ('m.name = ?' => $o{name}) : (),
     $o{package}   ? ('m.package = ?' => $o{package}) : (),
@@ -409,24 +436,20 @@ sub dbManInfo {
 
   # TODO: Flags to indicate what to information to fetch
   return $s->dbAll(q{
-    SELECT s.id AS sysid, s.name||' '||COALESCE(s.release, '') AS system, p.category, p.name AS package, p.version, p.released, m.name, m.section, m.filename, m.locale, encode(m.hash, 'hex') AS hash
+    SELECT p.system, p.category, p.name AS package, p.version, p.released, m.name, m.section, m.filename, m.locale, encode(m.hash, 'hex') AS hash
       FROM package p
       JOIN man m ON m.package = p.id
-      JOIN systems s ON s.id = p.system
         !W
   }, \%where);
 }
 
 
 sub dbSystemGet {
-  my($s, $short) = @_;
+  return shift->dbAll('SELECT id, name, release, short, relorder FROM systems ORDER BY name, relorder');
-  return $s->dbAll(
-    'SELECT id, name, release, short FROM systems !W ORDER BY name, relorder',
-    $short ? {'short = ?' => $short } : {}
-  );
 }
 
 
+# TODO: Optimize
 sub dbPackageList {
   my($s, $sysid, $char) = @_;
 
@@ -437,7 +460,6 @@ sub dbPackageList {
     defined($char) && !$char ? ( '(ASCII(name) < 97 OR ASCII(name) > 122) AND (ASCII(name) < 65 OR ASCII(name) > 90)' => 1 ) : (),
   );
 
-  # TODO: Optimize this one
   return $s->dbAll(q{
       SELECT DISTINCT name, category
         FROM package p
@@ -447,6 +469,7 @@ sub dbPackageList {
 }
 
 
+# TODO: Optimize?
 sub dbPackageGet {
   my($s, $sysid, $name) = @_;