www: Replace "versions" tab with separate page
This gets rid of the last remaining feature that only worked with Javascript.
This commit is contained in:
Yorhel
parent
962a7c848a
commit
18b9666e32
3 changed files with 94 additions and 397 deletions
207
www/index.pl
207
www/index.pl
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
use v5.26;
|
||||
use warnings;
|
||||
use TUWF ':html5_', ':xml', 'uri_escape';
|
||||
use TUWF ':html5_', 'uri_escape';
|
||||
use POSIX 'ceil';
|
||||
use List::Util 'uniq', 'min';
|
||||
use SQL::Interp 'sql', 'sql_interp';
|
||||
|
|
@ -200,6 +200,19 @@ sub man_pref_name {
|
|||
}
|
||||
|
||||
|
||||
sub man_languages {
|
||||
my($name, $sect) = @_;
|
||||
[ map $_->{lang}, tuwf->dbAlli(
|
||||
"SELECT DISTINCT substring(l.locale from '^[^.]+') AS lang
|
||||
FROM files f
|
||||
JOIN mans m ON m.id = f.man
|
||||
JOIN locales l ON l.id = f.locale
|
||||
WHERE m.name =", \$name, 'AND m.section =', \$sect, "
|
||||
ORDER BY substring(l.locale from '^[^.]+') NULLS FIRST"
|
||||
)->@* ];
|
||||
}
|
||||
|
||||
|
||||
sub framework_ {
|
||||
my $content = pop;
|
||||
my(%o) = @_;
|
||||
|
|
@ -226,7 +239,6 @@ sub framework_ {
|
|||
};
|
||||
span_ 'all manual pages are copyrighted by their respective authors.';
|
||||
};
|
||||
script_ type => 'text/javascript', src => '/man.js?2', '';
|
||||
}
|
||||
};
|
||||
|
||||
|
|
@ -290,7 +302,7 @@ TUWF::get '/' => sub {
|
|||
framework_ title => 'Man Pages Archive', mainclass => 'thin', sub {
|
||||
h1_ 'Welcome to Manned.org';
|
||||
h2_ 'The archive for man pages';
|
||||
lit sprintf <<' _', map num($stats->{$_}), qw|hashes mans files packages|;
|
||||
lit_ sprintf <<' _', map num($stats->{$_}), qw|hashes mans files packages|;
|
||||
<p>
|
||||
Indexing <b>%s</b> versions of <b>%s</b> manual pages found in
|
||||
<b>%s</b> files of <b>%s</b> packages.
|
||||
|
|
@ -354,7 +366,7 @@ TUWF::get '/' => sub {
|
|||
TUWF::get '/info/about' => sub {
|
||||
framework_ title => 'About', mainclass => 'thin', sub {
|
||||
h1_ 'About Manned.org';
|
||||
lit <<' _';
|
||||
lit_ <<' _';
|
||||
<h2 id="goal">Goal</h2>
|
||||
<p>
|
||||
The state of online indices of manual pages used to be a sad one. Existing
|
||||
|
|
@ -688,14 +700,7 @@ sub man_nav_ {
|
|||
'SELECT DISTINCT section FROM mans WHERE name =', \$man->{name}, 'ORDER BY section'
|
||||
)->@*;
|
||||
|
||||
my @lang = map $_->{lang}, tuwf->dbAlli(
|
||||
"SELECT DISTINCT substring(l.locale from '^[^.]+') AS lang
|
||||
FROM files f
|
||||
JOIN mans m ON m.id = f.man
|
||||
JOIN locales l ON l.id = f.locale
|
||||
WHERE m.name =", \$man->{name}, 'AND m.section =', \$man->{section}, "
|
||||
ORDER BY substring(l.locale from '^[^.]+') NULLS FIRST"
|
||||
)->@*;
|
||||
my $lang = man_languages $man->{name}, $man->{section};
|
||||
|
||||
nav_ sub {
|
||||
form_ action => '/sysredir/'.$url->mansect(), method => 'get',
|
||||
|
|
@ -736,11 +741,11 @@ sub man_nav_ {
|
|||
}
|
||||
}
|
||||
|
||||
if(@lang > 1) {
|
||||
if(@$lang > 1) {
|
||||
b_ 'Languages';
|
||||
p_ sub {
|
||||
(my $cur = $man->{locale}||'') =~ s/\..*//;
|
||||
for (@lang) {
|
||||
for (@$lang) {
|
||||
if(($_||'') eq $cur) {
|
||||
i_ $_ || 'default';
|
||||
} else {
|
||||
|
|
@ -796,7 +801,7 @@ sub man_page {
|
|||
if($url->{fmt} eq 'raw') {
|
||||
tuwf->resHeader('Content-Type', 'text/plain; charset=UTF-8');
|
||||
tuwf->resHeader('Content-Disposition', sprintf 'filename="%s.%s"', $man->{name}, $man->{section});
|
||||
lit $content->{content};
|
||||
lit_ $content->{content};
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -806,7 +811,7 @@ sub man_page {
|
|||
# This feature is a WIP and not advertised at the moment, anyway.
|
||||
tuwf->resHeader('Content-Type', 'text/plain; charset=UTF-8');
|
||||
tuwf->resHeader('Content-Disposition', sprintf 'filename="%s.%s.txt"', $man->{name}, $man->{section});
|
||||
lit $fmt;
|
||||
lit_ $fmt;
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -823,34 +828,19 @@ sub man_page {
|
|||
qq{\n<a href="#head$c" id="head$c">$1</a>\n}
|
||||
}eg;
|
||||
|
||||
my $hasversions = tuwf->dbVali(
|
||||
'SELECT 1
|
||||
FROM files f
|
||||
JOIN mans m ON m.id = f.man
|
||||
JOIN locales l ON l.id = f.locale
|
||||
WHERE m.name =', \$man->{name}, 'AND m.section =', \$man->{section}, '
|
||||
AND l.locale =', \$man->{locale}, '
|
||||
AND f.shorthash <> ', \$man->{shorthash}, '
|
||||
LIMIT 1'
|
||||
);
|
||||
my @htmllang = $man->{locale} =~ /^([a-z]{2,3})(?:_([A-Z]{2}))?(?:$|@|\.)/ ? (lang => $1.($2?"-$2":'')) : ();
|
||||
|
||||
framework_ title => $man->{name}, mainclass => 'manpage', sub {
|
||||
man_nav_ $man, $url, \@toc, \@htmllang;
|
||||
div_ id => 'manbuttons', sub {
|
||||
h1_ $man->{name};
|
||||
ul_ 'data-hash' => $content->{hash},
|
||||
'data-name' => $man->{name},
|
||||
'data-section' => $man->{section},
|
||||
'data-locale' => $man->{locale}||'',
|
||||
'data-hasversions' => $hasversions?1:0,
|
||||
sub {
|
||||
ul_ sub {
|
||||
li_ sub { a_ href => $url->set(fmt => 'raw'), 'source' };
|
||||
li_ sub { a_ href => $url->set(system => sysbyid->{$man->{system}}{short}, package => undef, shorthash => shorthash_to_hex $man->{shorthash}), 'permalink' };
|
||||
li_ sub { a_ href => "/ver.".shorthash_to_hex($man->{shorthash}).($man->{locale}?".$man->{locale}":'')."/$man->{name}.$man->{section}", 'versions' };
|
||||
li_ sub { a_ href => "/loc/$content->{hash}", 'locations' };
|
||||
}
|
||||
};
|
||||
div_ id => 'manres', class => 'hidden', '';
|
||||
pre_ @htmllang, sub { lit_ $fmt };
|
||||
};
|
||||
}
|
||||
|
|
@ -1129,11 +1119,11 @@ TUWF::get qr{/loc/([a-fA-F0-9]{40})}, sub {
|
|||
td_ 'Package';
|
||||
td_ 'Path';
|
||||
}};
|
||||
my $lastrel = '';
|
||||
tr_ sub {
|
||||
my $sys = sysbyid->{$_->{system}};
|
||||
td_ sub {
|
||||
txt_ $sys->{release};
|
||||
} if $sys->{release};
|
||||
td_ $lastrel eq $sys->{release} ? '' : $sys->{release} if $sys->{release};
|
||||
$lastrel = $sys->{release};
|
||||
td_ sub {
|
||||
a_ href => "/pkg/$sys->{short}/$_->{package}/$_->{version}", $_->{package}.'-'.$_->{version};
|
||||
};
|
||||
|
|
@ -1146,100 +1136,79 @@ TUWF::get qr{/loc/([a-fA-F0-9]{40})}, sub {
|
|||
};
|
||||
|
||||
|
||||
TUWF::get '/json/tree.json' => sub {
|
||||
my $f = tuwf->validate(get =>
|
||||
name => { default => '', maxlength => 256 },
|
||||
section => { default => '', maxlength => 32 },
|
||||
locale => { default => sub{$_[0]}, maxlength => 32 },
|
||||
cur => { default => '', regex => qr/^[a-fA-F0-9]{40}$/ },
|
||||
hash => { default => '', regex => qr/^[a-fA-F0-9]{40}$/ },
|
||||
)->data;
|
||||
return tuwf->resNotFound() if !$f->{hash} && !($f->{section} && $f->{name});
|
||||
# /ver[.$shorthash][.$lang]/$name.$section
|
||||
TUWF::get qr{/ver(?:\.([a-fA-F0-9]{8}))?(?:\.([^/]+))?/([^/]+)\.([0-9a-zA-Z])}, sub {
|
||||
my($shorthash, $lang, $name, $sect) = tuwf->captures(1,2,3,4);
|
||||
$shorthash = $shorthash ? shorthash_to_int $shorthash : -1;
|
||||
($lang ||= '') =~ s/\..*//;
|
||||
|
||||
my $l = tuwf->dbAlli("
|
||||
SELECT p.system, p.name AS package, v.version, v.released, v.id AS verid, m.name, m.section, f.filename, f.shorthash, l.locale
|
||||
my $l = tuwf->dbAlli('
|
||||
SELECT p.system, p.name AS package, v.version, f.shorthash
|
||||
FROM files f
|
||||
JOIN locales l ON l.id = f.locale
|
||||
JOIN mans m ON m.id = f.man
|
||||
JOIN package_versions v ON v.id = f.pkgver
|
||||
JOIN packages p ON p.id = v.package
|
||||
JOIN systems s ON s.id = p.system
|
||||
WHERE", sql_and(
|
||||
length $f->{hash} ? sql 'f.content = (SELECT id FROM contents WHERE hash = decode(', \$f->{hash}, ", 'hex'))" : (),
|
||||
length $f->{name} ? sql 'm.name =', \$f->{name} : (),
|
||||
length $f->{section} ? sql 'm.section =', \$f->{section} : (),
|
||||
defined $f->{locale} ? sql 'l.locale =', \$f->{locale} : (),
|
||||
), '
|
||||
ORDER BY s.name, s.id DESC, p.name, v.released DESC, m.name, l.locale, f.filename
|
||||
WHERE f.man = (SELECT id FROM mans WHERE name =', \$name, 'AND section =', \$sect, ')
|
||||
AND f.locale IN(SELECT id FROM locales WHERE locale', $lang ? ('ILIKE', \(escape_like($lang).'%')) : ("= ''"), ')
|
||||
ORDER BY p.system DESC, p.name, v.released DESC, f.shorthash
|
||||
');
|
||||
|
||||
# Convert the list into a tree
|
||||
my $cur = $f->{cur} ? shorthash_to_int substr $f->{cur}, 0, 8 : 0;
|
||||
my $tree = [];
|
||||
my($sys, $sysver, $pkg, $pkgver);
|
||||
for my $m (@$l) {
|
||||
my $sysname = sysbyid->{$m->{system}}{name};
|
||||
if(!$sys || $sysname ne $sys->{name}) {
|
||||
$sys = { name => $sysname, childs => [] };
|
||||
$sysver = undef;
|
||||
push @$tree, $sys;
|
||||
}
|
||||
my $langs = man_languages $name, $sect;
|
||||
|
||||
my $sysversion = sysbyid->{$m->{system}}{release} || '';
|
||||
if(!$sysver || $sysversion ne $sysver->{name}) {
|
||||
$sysver = { name => $sysversion, childs => [] };
|
||||
$pkg = undef;
|
||||
push @{$sys->{childs}}, $sysver;
|
||||
}
|
||||
my %sys;
|
||||
push $sys{ sysbyid->{$_->{system}}{name} }->@*, $_ for @$l;
|
||||
|
||||
if(!$pkg || $m->{package} ne $pkg->{name}) {
|
||||
$pkg = { name => $m->{package}, table => [] };
|
||||
$pkgver = undef;
|
||||
push @{$sysver->{childs}}, $pkg;
|
||||
}
|
||||
my $title = "Versions of $name($sect)".($lang ? " in locale $lang" : '');
|
||||
framework_ title => $title, mainclass => 'verpage', sub {
|
||||
h1_ $title;
|
||||
|
||||
push @{$pkg->{table}}, [
|
||||
$pkgver && $pkgver eq $m->{version} ? {name=>''} :
|
||||
{name => $m->{version}, href => "/pkg/".sysbyid->{$m->{system}}{short}."/$m->{package}/$m->{version}"},
|
||||
{ name => "$m->{name}($m->{section})",
|
||||
$f->{hash} || $cur == $m->{shorthash} ? ()
|
||||
: (href => sprintf('/%s/%s', $m->{name}, shorthash_to_hex $m->{shorthash}))
|
||||
},
|
||||
{ name => shorthash_to_hex($m->{shorthash}),
|
||||
$f->{hash} || $cur == $m->{shorthash} ? ()
|
||||
: (href => sprintf('/%s/%s', $m->{name}, shorthash_to_hex $m->{shorthash}))
|
||||
},
|
||||
{ name => $m->{filename} }
|
||||
];
|
||||
$pkgver = $m->{version};
|
||||
}
|
||||
|
||||
# Determine which elements to show/hide by default.
|
||||
# It might make more sense to do this in JS, but since I am utterly
|
||||
# incapable of writing maintainable JS I'm doing it here in order to keep the
|
||||
# JS stupid and simple.
|
||||
# TODO: Highlight systems/packages where the 'current' man page is?
|
||||
for my $sys (@$tree) {
|
||||
$sys->{expand} = 1 if $sys->{childs}[0]{name}; # Expand all systems that have named versions
|
||||
$sys->{expand} = 1 if $f->{hash}; # Expand everything on 'location'
|
||||
|
||||
my $i = 0;
|
||||
for my $sysver (@{$sys->{childs}}) {
|
||||
$i++;
|
||||
$sysver->{expand} = 1 if !$sysver->{name}; # Expand unnamed versions (since you can't click them)
|
||||
$sysver->{expand} = 1 if $f->{hash}; # Expand everything on 'location'
|
||||
$sysver->{hide} = 1 if $i > 3 && @{$sys->{childs}} > 5; # Show only the first 3 versions
|
||||
|
||||
for my $pkg (@{$sysver->{childs}}) {
|
||||
$pkg->{expand} = 1 if @{$sysver->{childs}} <= 3; # Expand everything if there's not too many things to expand
|
||||
$pkg->{expand} = 1 if $f->{hash}; # Expand everything on 'location'
|
||||
|
||||
# TODO: Show/Hide duplicate hashes?
|
||||
p_ sub {
|
||||
txt_ 'Available languages: ';
|
||||
for (0..$#{$langs}) {
|
||||
txt_ ', ' if $_ > 0;
|
||||
if(($langs->[$_]||'') eq $lang) {
|
||||
i_ $langs->[$_] || 'default';
|
||||
} else {
|
||||
a_ href => '/ver'.($langs->[$_]?".$langs->[$_]":'')."/$name.$sect", $langs->[$_] || 'default';
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
txt_ '.';
|
||||
} if @$langs > 1;
|
||||
|
||||
tuwf->resJSON($tree);
|
||||
p_ sub {
|
||||
txt_ 'System index: ';
|
||||
my @sys = sort keys %sys;
|
||||
for (0..$#sys) {
|
||||
txt_ ', ' if $_ > 0;
|
||||
a_ href => "#$sys[$_]", $sys[$_];
|
||||
}
|
||||
txt_ '.';
|
||||
} if keys %sys > 1;
|
||||
|
||||
for my $sysname (sort keys %sys) {
|
||||
h2_ sub { a_ href => "#$sysname", id => "$sysname", $sysname };
|
||||
table_ sub {
|
||||
thead_ sub { tr_ sub {
|
||||
td_ 'Release' if sysbyid->{$sys{$sysname}[0]{system}}{release};
|
||||
td_ 'Package';
|
||||
td_ 'Hash';
|
||||
}};
|
||||
my $lastrel = '';
|
||||
tr_ sub {
|
||||
my $sys = sysbyid->{$_->{system}};
|
||||
td_ $lastrel eq $sys->{release} ? '' : $sys->{release} if $sys->{release};
|
||||
$lastrel = $sys->{release};
|
||||
td_ sub {
|
||||
a_ href => "/pkg/$sys->{short}/$_->{package}/$_->{version}", $_->{package}.'-'.$_->{version};
|
||||
};
|
||||
td_ class => 'sh', sub {
|
||||
my $hex = shorthash_to_hex $_->{shorthash};
|
||||
txt_ $hex if $_->{shorthash} == $shorthash;
|
||||
a_ href => "/man.$hex/$sys->{short}/$name.$sect", $hex if $_->{shorthash} != $shorthash;
|
||||
};
|
||||
} for $sys{$sysname}->@*;
|
||||
};
|
||||
}
|
||||
};
|
||||
};
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue