From: Mark Wooding Date: Wed, 15 Dec 2021 12:35:30 +0000 (+0000) Subject: Initial commit. X-Git-Url: https://git.distorted.org.uk/~mdw/tgal/commitdiff_plain/6ac5dde2c2826f066d96e167f6f1fcdc46d5fab4 Initial commit. --- 6ac5dde2c2826f066d96e167f6f1fcdc46d5fab4 diff --git a/.skelrc b/.skelrc new file mode 100644 index 0000000..c25a61c --- /dev/null +++ b/.skelrc @@ -0,0 +1,8 @@ +;;; -*-emacs-lisp-*- + +(setq skel-alist + (append + '((author . "Mark Wooding") + (licence-text . "[[agpl-3]]") + (full-title . "Trivial Gallery")) + skel-alist)) diff --git a/mason/.perl-lib/TrivGal.pm b/mason/.perl-lib/TrivGal.pm new file mode 100644 index 0000000..5bfc930 --- /dev/null +++ b/mason/.perl-lib/TrivGal.pm @@ -0,0 +1,328 @@ +### -*-cperl-*- +### +### Main output for Trivial Gallery. +### +### (c) 2021 Mark Wooding +### + +###----- Licensing notice --------------------------------------------------- +### +### This file is part of Trivial Gallery. +### +### Trivial Gallery is free software: you can redistribute it and/or modify +### it under the terms of the GNU Affero General Public License as +### published by the Free Software Foundation; either version 3 of the +### License, or (at your option) any later version. +### +### Trivial Gallery is distributed in the hope that it will be useful, but +### WITHOUT ANY WARRANTY; without even the implied warranty of +### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +### Affero General Public License for more details. +### +### You should have received a copy of the GNU Affero General Public +### License along with Trivial Gallery. If not, see +### . + +package TrivGal; + +use autodie qw{:all}; + +use Errno; +use Exporter qw{import}; +use File::Path qw{make_path}; +use File::stat; +use Image::Imlib2; +use User::pwent; +use POSIX; + +our @EXPORT; +sub export (@) { push @EXPORT, @_; } + +###-------------------------------------------------------------------------- +### Internal utilities. + +sub read_or_set ($\$@) { + my ($me, $ref, @args) = @_; + if (@args == 0) { return $$ref; } + elsif (@args == 1) { $$ref = $args[0]; return $me; } + elsif (@args > 1) { die "too many arguments"; } +} + +###-------------------------------------------------------------------------- +### Random utilities. + +export qw{join_paths}; +sub join_paths (@) { + my @p = @_; + my $p = ""; + ELT: for my $e (@p) { + $e =~ s:^/{2,}:/:; + $e =~ s,([^/])/+$,$1,; + if ($e eq "") { next ELT; } + elsif ($p eq "" || $e =~ m,^/,) { $p = $e; } + else { $p = "$p/$e"; } + } + return $p; +} + +export qw{split_path}; +sub split_path ($) { + my ($path) = @_; + + my ($dir, $base, $ext) = $path =~ m,^(?:(.*)/)?(?:([^/]*)\.)?([^./]*)$,; + if (defined $base) { $ext = ".$ext"; } + else { $base = $ext; $ext = ""; } + return ($dir, $base, $ext); +} + +export qw{urlencode}; +sub urlencode ($) { + my ($u) = @_; + $u =~ s:([^0-9a-zA-Z_./~-]):sprintf "%%%02x", ord $1:eg; + return $u; +} + +export qw{urldecode}; +sub urldecode ($) { + my ($u) = @_; + $u =~ s:\%([0-9a-fA-F]{2}):chr hex $1:eg; + return $u; +} + +###-------------------------------------------------------------------------- +### Image types. + +our %TYPE; + +package TrivGal::ImageType { + sub new ($$) { + my ($cls, $ext) = @_; + return $TYPE{$ext} = bless { ext => $ext }, $cls; + } + sub ext ($) { + my ($me, @args) = @_; + return $me->{ext}; + } + sub mimetype ($@) { + my ($me, @args) = @_; + return TrivGal::read_or_set $me, $me->{mimetype}, @args; + } + sub imlibfmt ($@) { + my ($me, @args) = @_; + return TrivGal::read_or_set $me, $me->{imlibfmt}, @args; + } +}; + +TrivGal::ImageType->new(".jpg")->mimetype("image/jpeg")->imlibfmt("jpeg"); +TrivGal::ImageType->new(".png")->mimetype("image/png")->imlibfmt("png"); + +###-------------------------------------------------------------------------- +### Configuration. + +export qw{$SCOPE $SUFFIX}; +our $SCOPE //= $::SCOPE; +our $SUFFIX //= $::SUFFIX; + +export qw{$IMGROOT $CACHE $TMP}; +our $IMGROOT //= "$ENV{HOME}/publish/$SCOPE-html$SUFFIX/tgal-images"; +our $CACHE //= + ($ENV{XDG_CACHE_HOME} // "$ENV{HOME}/.cache") . + "/tgal/$SCOPE$SUFFIX"; +our $TMP //= "$CACHE/tmp"; + +export qw{$ROOTURL $IMGURL $CACHEURL $STATICURL $SCRIPTURL}; +my $user = getpwuid($>)->name; +our $ROOTURL //= "/~$user"; +our $IMGURL //= "$ROOTURL/tgal-images"; +our $CACHEURL //= "$ROOTURL/tgal-cache"; +our $STATICURL //= "$ROOTURL/tgal-static"; +our $SCRIPTURL; + +export qw{%SIZE}; +our %SIZE = (thumb => 228, view => 1200); + +export qw{init}; +my $initp = 0; +sub init () { + my $m = HTML::Mason::Request->instance; + my $r = $m->cgi_request; + + $m->interp->set_escape(u => sub { my ($r) = @_; $$r = urlencode $$r; }); + + return unless !$initp; + + $SCRIPTURL //= $r->subprocess_env("SCRIPT_NAME"); + $initp = 1; +} + +###-------------------------------------------------------------------------- +### Temporary files. + +export qw{clean_temp_files}; +sub clean_temp_files () { + my $d; + + eval { opendir $d, $TMP; }; + if ($@) { + if ($@->isa("autodie::exception") && $@->errno == ENOENT) { return; } + else { die $@; } + } + my $now = time; + FILE: while (my $name = readdir $d) { + next FILE unless $name =~ /^t(\d+)\-/; + my $pid = $1; + next FILE if kill 0, $pid; + my $f = "$TMP/$name"; + my $st = stat $name; + next FILE if $now - $st->mtime() < 300; + unlink $f; + } + closedir $d; +} + +###-------------------------------------------------------------------------- +### Scaled images. + +export qw{scaled}; +sub scaled ($$) { + my ($scale, $path) = @_; + + my $sz = $SIZE{$scale} or die "unknown scale `$scale'"; + my $imgpath = "$IMGROOT/$path"; + my $ist = stat $imgpath or die "no image `$path'"; + my $thumb = "$CACHE/scaled.$scale/$path"; + my $thumburl = "$CACHEURL/scaled.$scale/$path"; + my $tst = stat $thumb; + if (defined $tst && $tst->mtime > $ist->mtime) { return $thumburl; } + my ($dir, $base, $ext) = split_path $thumb; + my $ty = $TYPE{lc $ext} or die "unknown type `$ext'"; + + my $img = Image::Imlib2->load($imgpath); + my ($wd, $ht) = ($img->width, $img->height); + my $max = $wd > $ht ? $wd : $ht; + if ($max <= $sz) { return "$IMGURL/$path"; } + my $sc = $sz/$max; + my $scaled = $img->create_scaled_image($sc*$wd, $sc*$ht); + + $scaled->image_set_format($ty->imlibfmt); + $scaled->set_quality(90); + my $new = "$TMP/t${$}$ext"; + make_path $TMP; + $scaled->save($new); + make_path $dir; + rename $new, $thumb; + return $thumburl; +} + +###-------------------------------------------------------------------------- +### Directory listings. + +package TrivGal::Item { + sub new ($$) { + my ($cls, $name) = @_; + return bless { name => $name }, $cls; + } + sub name ($@) { + my ($me, @args) = @_; + return TrivGal::read_or_set $me, $me->{name}, @args; + } + sub comment ($@) { + my ($me, @args) = @_; + return TrivGal::read_or_set $me, $me->{comment}, @args; + } +}; + +export qw{listdir}; +sub listdir ($) { + my ($path) = @_; + my (@d, @f); + my $ix = undef; + + if (-f "$path/.tgal.index") { + open my $f, "<", "$path/.tgal.index"; + my $item = undef; + my $comment = undef; + LINE: while (<$f>) { + chomp; + next LINE if /^\s*(\#|$)/; + if (s/^\s+//) { + die "no item" unless $item; + $comment = defined $comment ? $comment . "\n" . $_ : $_; + } else { + if ($item && $comment) { $item->comment($comment); } + my ($indexp, $name, $c) = /(!\s+)?(\S+)\s*(\S|\S.*\S)?\s*$/; + $name = urldecode $name; + my $list; + if ($name =~ m!/$!) { + $list = \@d; + die "can't index a folder" if $indexp; + } else { + $list = \@f; + my ($dir, $base, $ext) = TrivGal::split_path $name; + die "unknown image type" unless $TYPE{lc $ext}; + if ($indexp) { + die "two index images" if defined $ix; + $ix = $item; + } + } + $item = TrivGal::Item->new($name); + $comment = $c; + push @$list, $item; + } + } + if ($item && $comment) { $item->comment($comment); } + close $f; + } else { + opendir $d, $path; + my @e = readdir $d; + closedir $d; + + ENT: for my $e (sort @e) { + my ($dir, $base, $ext) = split_path $e; + my $dotp = $e =~ /^\./; + my $st = stat "$path/$e"; + my $list = undef; + if ($dotp || !($st->mode&0004)) { } + elsif (-d $st) { $list = \@d; } + elsif ($TYPE{lc $ext} && -f $st) { $list = \@f; } + $list and push @$list, TrivGal::Item->new($e); + } + $ix = $f[0] if @f; + } + + return (\@d, \@f, $ix); +} + +export qw{contents}; +sub contents ($) { + my ($file) = @_; + my $contents = ""; + my $f; + local $@; + eval { open $f, "<", "$file"; }; + if ($@) { + if ($@->isa("autodie::exception") && $@->errno == ENOENT) + { return undef; } + die $@; + } + while (sysread $f, $buf, 16384) { $contents .= $buf; } + close $f; + return $contents; +} + +export qw{find_covering_file}; +sub find_covering_file ($$$) { + my ($top, $path, $name) = @_; + for (;;) { + my $stuff = contents "$top/$path/$name"; return $stuff if defined $stuff; + if ($path eq "") { return undef; } + if ($path =~ m!^(.*)/[^/]+/?!) { $path = $1; } + else { $path = ""; } + } +} + +###----- That's all, folks -------------------------------------------------- + +clean_temp_files; + +1; diff --git a/mason/dhandler b/mason/dhandler new file mode 100755 index 0000000..4355b7a --- /dev/null +++ b/mason/dhandler @@ -0,0 +1,317 @@ +%### -*-html-*- +%### +%### Main output for Trivial Gallery. +%### +%### (c) 2021 Mark Wooding +%### +% +%###----- Licensing notice -------------------------------------------------- +%### +%### This file is part of Trivial Gallery. +%### +%### Trivial Gallery is free software: you can redistribute it and/or modify +%### it under the terms of the GNU Affero General Public License as +%### published by the Free Software Foundation; either version 3 of the +%### License, or (at your option) any later version. +%### +%### Trivial Gallery is distributed in the hope that it will be useful, but +%### WITHOUT ANY WARRANTY; without even the implied warranty of +%### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%### Affero General Public License for more details. +%### +%### You should have received a copy of the GNU Affero General Public +%### License along with Trivial Gallery. If not, see +%### . +% +%###------------------------------------------------------------------------- +<%def .html>\ +% $r->content_type("text/html; charset=\"utf-8\""); + + + + + + + "> +<% $head %>\ + <% $title %> + + +<% $m->content %> + +\ +% +<%args> + $title + $head => "" + + +% +%###------------------------------------------------------------------------- +<%def .not-found>\ +<&| .html, title => "Not found" &> +

Not found

+Failed to find ‘<% $path |h %>’. + +% return 404; +% +<%args> + $path + + +% +%###------------------------------------------------------------------------- +<%def .contact>\ +<%perl> + unless ($r->path_info =~ m!/$!) { + $m->redirect(join_paths($SCRIPTURL, $path) . "/"); + } + my $real = join_paths $IMGROOT, $path; + my $url = join_paths $SCRIPTURL, $path; + my ($dd, $ff, $ii) = listdir $real; + my $links = ""; + my $uplink; + if ($path eq "" || $path eq "/") { $uplink = undef; } + else { + ($uplink = $path) =~ s![^/]*/$!!; + $links .= sprintf " \n", + urlencode "$SCRIPTURL/$uplink"; + } + (my $nosl = $path) =~ s!/$!!; + +% +<&| .html, title => "Folder " . $m->interp->apply_escapes($nosl || "[top]", "h"), + head => $links &> +<& .breadcrumbs, what => "Folder", path => $path &> +% +% my $note = contents "$IMGROOT/$path/.tgal-note.html"; +% if (defined $note) { +
+<% $note %> +
+% } +% +% if (@$dd) { +

Subfolders

+ +% } +% +% if (@$ff) { +

Images

+ +% } +% +
+<& .footer, path => $path &> + +% +<%args> + $path + + +% +%###------------------------------------------------------------------------- +<%def .image>\ +<%perl> + my ($dir, $base, $ext) = split_path $path; + my $real = join_paths $IMGROOT, $path; + my $url = join_paths $IMGURL, $path; + my $realdir = join_paths $IMGROOT, $dir; + my $urldir = join_paths $SCRIPTURL, $dir; + my ($dd, $ff, $ii) = listdir $realdir; + my $vw = scaled "view", $path; + + my $fi = undef; + FILE: for (my $i = 0; $i < @$ff; $i++) + { if ($ff->[$i]->name eq "$base$ext") { $fi = $i; last FILE; } } + defined $fi or die "image not found in its folder?"; + my $this = $ff->[$fi]; + + my %link; + $link{up} = ""; + if ($fi != 0) { + $link{first} = $ff->[0]->name; + $link{prev} = $ff->[$fi - 1]->name; + } + if ($fi != @$ff - 1) { + $link{last} = $ff->[-1]->name; + $link{next} = $ff->[$fi + 1]->name; + } + + my $links = ""; + my $pre = + urlencode join_paths $SCRIPTURL, $dir; + for my $rel (qw{up first prev next last}) { + exists $link{$rel} and + $links .= sprintf " \n", + $rel, urlencode "$pre/$link{$rel}"; + } + +% +<&| .html, title => "Image " . $m->interp->apply_escapes($path, "h"), + head => $links &> +<& .breadcrumbs, what => "Image", path => $path &> +% if ($this->comment) { +
+

<% $this->comment %> +

+% } +% +
+% if ($link{prev}) { + +% } + + + +% if ($link{next}) { + +% } +
+% +
+% for my $f (@$ff) { + <& .thumbnail, target => $f->name, img => $dir . "/" . $f->name, + caption => $m->interp->apply_escapes($f->name, "h"), + focus => $f->name eq "$base$ext" &>\ +% } +
+<& .footer, path => $dir &> + +% +<%args> + $path + + +% +%###------------------------------------------------------------------------- +<%def .breadcrumbs>\ +% $path =~ s!/$!!; +% my @p = split m!/!, $path; +% my $pp = ""; +% my $prev = undef; +

<% $what %> \ +% if (!@p) { +[top] +% } else { +[top] / \ +% STEP: for my $p (@p) { +% if (defined $prev) { +% $pp .= "$prev/"; +\ +<% $prev %> / \ +% } +% $prev = $p; +% } +<% $prev %>\ +% } +

+<%args> + $what + $path + + +% +%###------------------------------------------------------------------------- +<%def .thumbnail>\ +% my $tn; +% if (defined $img) { $tn = scaled "thumb", $img; } +% else { $tn = "$STATICURL/folder.svg"; } +% if ($focus) { +
+ +
<% $caption %>
+% } else { + +% +<%args> + $target + $img + $caption + $comment => undef + $focus => 0 + + +% +%###------------------------------------------------------------------------- +<%def .footer>\ +<%perl> + + +<%args> + $path + + +% +%###------------------------------------------------------------------------- +<%once> + use autodie; +use Data::Dumper; + use File::stat; + + use TrivGal; + +% +<%init> + TrivGal->init; + + my $path = $m->dhandler_arg; + my $st = stat "$IMGROOT/$path"; + my $comp; + if (!$st) { $comp = ".not-found"; } + elsif (-d $st) { $comp = ".contact"; } + elsif (-f $st) { $comp = ".image"; } + else { $comp = ".not-found"; } + $m->comp($comp, path => $path); + +% +%###----- That's all, folks ------------------------------------------------- diff --git a/static/agpl.png b/static/agpl.png new file mode 100644 index 0000000..ff8c3b7 Binary files /dev/null and b/static/agpl.png differ diff --git a/static/folder.svg b/static/folder.svg new file mode 100644 index 0000000..cb50205 --- /dev/null +++ b/static/folder.svg @@ -0,0 +1,454 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + image/svg+xml + + + + + + Jakub Steiner + + + + http://jimmac.musichall.cz + + + folder + directory + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/static/tgal.css b/static/tgal.css new file mode 100644 index 0000000..d5f5807 --- /dev/null +++ b/static/tgal.css @@ -0,0 +1,154 @@ +/* -*-css-*- + * + * Style sheet for Trivial Gallery. + * + * (c) 2021 Mark Wooding + */ + +/*----- Licensing notice --------------------------------------------------* + * + * This file is part of Trivial Gallery. + * + * Trivial Gallery is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation; either version 3 of the + * License, or (at your option) any later version. + * + * Trivial Gallery is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public + * License along with Trivial Gallery. If not, see + * . + */ + +html { height: 100%; } +body { + height: calc(100% - 2ex); + display: flex; flex-direction: column; + margin-top: 0; margin-bottom: 0; + background-color: white; + color: black; + margin: 1ex 2em; +} + +a { text-decoration: none; } +a:link { color: blue; } +a:link:active, a:visited { color: darkblue; } +a:link:hover, a:visited:hover { background: #ccc; } + +h1 { + padding: 0.47ex 0; + border-bottom: thick black solid; + margin-top: 0.5ex; margin-bottom: 1.41ex; + font-weight: bold; + font-size: 200%; +} +h1 + h2, div.toc + h2, h1 + div > h2 { + border-top: none; + padding-top: 1ex; + margin-top: 0; +} +h2 { border-top: thin black solid; padding-top: 1ex; } +h2, h3 { margin-top: 3ex; } +h2 { font-size: x-large; } +h3 { font-size: large; } +h4, h5, h6 { display: run-in; } +h1, h2, h3, h4, h5, h6 { font-family: sans-serif; font-weight bold; } + +hr { width: calc(100% - 4em); } +div.fill { flex-grow: 1; } + +div.footer { + border-top: medium black solid; + margin-top: 3.43ex; + padding-top: 1ex; + font-size: small; + font-style: italic; + text-align: right; +} +div.footer img.licence { float: left; margin: 1ex; } +div.footitem { + margin-top: 1ex; margin-bottom: 1ex; + clear: both; +} + +div.gallery { + display: block; + text-align: center; +} + +div.pic { + display: inline-block; + vertical-align: top; + width: 228px; + margin: 1em; +} + +div.pic a:link { display: inline-block; } + +img.thumb { + width: 228px; height: 228px; + object-fit: contain; +} + +div.comment { + border: thin black solid; + max-width: 40em; + align-self: center; + background-color: #ccc; + padding-left: 1em; padding-right: 1em; + margin-top: 2ex; margin-bottom: 2ex; +} + +div.caption { + display: block; + width: 228px; + white-space: normal; +} +div.caption span.name { font-family: sans-serif; } +div.caption span.comment { font-style: italic; margin-inline-start: 1em; } + +div.viewnav { + flex-grow: 1; flex-basis: 0; + display: flex; flex-direction: row; + position: relative; +} +div.prev, div.next { + position: absolute; + height: 100%; + display: flex; flex-direction: row; align-items: center; +} +div.prev { left: 0%; } +div.next { right: 0%; } +a.prev, a.next { + font-size: 400%; + font-weight: bold; + background-color: #0006; + min-width: 1em; + text-align: center; + min-height: 3ex; +} +a.view { + flex-grow: 1; flex-basis: 0; + display: flex; flex-direction: column; +} +a:link:hover.view { background: inherit; } + +a.view img { + min-width: 0; min-height: 0; + max-width: 100%; max-height: 100%; + flex-grow: 1; flex-basis: 0; + object-fit: contain; +} + +div.thumbstrip { + width: 100%; + overflow-x: auto; + text-align: center; + white-space: nowrap; +} + +/*----- That's all, folks -------------------------------------------------*/ diff --git a/static/tgal.js b/static/tgal.js new file mode 100644 index 0000000..de05593 --- /dev/null +++ b/static/tgal.js @@ -0,0 +1,56 @@ +/* -*-javascript-*- + * + * Interactive features for Trivial Gallery. + * + * (c) 2021 Mark Wooding + */ + +/*----- Licensing notice --------------------------------------------------* + * + * This file is part of Trivial Gallery. + * + * Trivial Gallery is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation; either version 3 of the + * License, or (at your option) any later version. + * + * Trivial Gallery is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public + * License along with Trivial Gallery. If not, see + * . + */ + +/* Handle keyboard interaction. */ +addEventListener("keydown", function (ev) { + var dir; + if (ev.key === " " || ev.key === "ArrowRight") dir = "next"; + else if (ev.key === " " || ev.key === "ArrowRight") dir = "next"; + else if (ev.key === "Backspace" || ev.key === "ArrowLeft") dir = "prev"; + else if (ev.key === "^") dir = "up"; + else if (ev.key === "<") dir = "first"; + else if (ev.key === ">") dir = "last"; + else return; + var elt = document.querySelector("link[rel=" + dir + "]"); + if (!elt) return; + location = elt.getAttribute("href"); + ev.stopPropagation(); +}, true); + +/* Scroll the thumbnail strip so that the current image is in the middle. */ +(function () { + var strip = document.querySelector("div.thumbstrip"); + var focus = document.querySelector("#focusthumb"); + if (strip && focus) { + var stripbox = strip.getBoundingClientRect(); + var focusbox = focus.getBoundingClientRect(); + strip.scrollLeft += + (focusbox.x - stripbox.x) - + (stripbox.width - focusbox.width)/2; + } +})(); + +/*----- That's all, folks -------------------------------------------------*/