%### -*-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!/$!!; my @size = ("smallthumb", "medthumb", "bigthumb"); my %tn; my %count; for my $f (@$ff) { my $img = TrivGal::Image->new($path . $f->name); for my $size (@size) { $tn{$f}{$size} = $img->scale($size); } } for my $d (@$dd) { my $p = join_paths $path, $d->name; my ($ddd, $fff, $iii); ($ddd, $fff, $iii) = listdir join_paths $IMGROOT, $p; my $count = ""; $count .= scalar(@$ddd) . "/" if @$ddd; $count .= scalar(@$fff) if @$fff; $count{$d} = $count; DIR: for (;;) { if (defined $iii) { my $index = join_paths $p, $iii->name; my $img = TrivGal::Image->new($index); for my $size (@size) { $tn{$d}{$size} = $img->scale($size); } last DIR; } if (!@$ddd) { $tn{$d} = undef; last DIR; } $p = join_paths $p, $ddd->[0]->name; ($ddd, $fff, $iii) = listdir join_paths $IMGROOT, $p; } } % <&| .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

% for my $size (@size) { % } % } % % if (@$ff) {

Images

% for my $size (@size) { % } % } %
<& .footer, path => $path &> % <%args> $path % %###------------------------------------------------------------------------- <%def .zip>\ <%perl> my $st = stat "$IMGROOT/$path"; if (!$st) { $m->comp(".not-found", path => $path); return; } my $zip = "$TMP/t$$-download.zip"; my $err = "$TMP/t$$-download.stderr"; my $kid = fork; if (!$kid) { untie *STDIN; open STDIN, "/dev/null"; untie *STDERR; open STDERR, ">", $err; chdir "$IMGROOT/$path"; exec "zip", "-qr", $zip, "."; exit 127; } waitpid $kid, 0; % % if ($?) { <&| .html, title => "Zip failed (rc = $?)" &>
<%perl>
	open my $f, "<", $err;
	my $buf;
	while (read $f, $buf, 16384) { $m->print($buf); }

% } else { <%perl> $r->content_type("application/zip"); open my $f, "<", $zip; binmode $f; my $buf; while (read $f, $buf, 16384) { $m->print($buf); } % } % <%perl> eval { unlink $zip; }; eval { unlink $err; }; % <%args> $path % %###------------------------------------------------------------------------- <%def .image>\ <%perl> my ($dir, $base, $ext) = split_path $path; if (defined $scale) { my $img = TrivGal::Image->new($path); $m->redirect($img->scale($scale, 1)); } 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 @thumbsz = qw{smallthumb medthumb bigthumb}; my @imgsz = sort { $SIZE{$a} <=> $SIZE{$b} } keys %SIZE; my ($wd, $ht, $max); my %tn; my %vw; my $fi = undef; FILE: for (my $i = 0; $i < @$ff; $i++) { my $f = $ff->[$i]; my $img = TrivGal::Image->new(join_paths $dir, $f->name); for my $sz (@thumbsz) { $tn{$f->name}{$sz} = $img->scale($sz); } if ($ff->[$i]->name eq "$base$ext") { $fi = $i; ($wd, $ht) = ($img->wd, $img->ht); $max = $img->sz; SIZE: for my $sc (@imgsz) { my $sz = $SIZE{$sc}; last SIZE if $max < $sz; $vw{$sc} = $img->scale($sc); } } } 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}) { $links .= sprintf " \n", $rel, urlencode "$pre/$link{$rel}" if exists $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}) { % } % my ($hoff, $voff) = (60, 480); % SIZE: for (my $i = 0; $i < @imgsz; $i++) { % my $scale = $imgsz[$i]; % last SIZE unless exists $vw{$scale}; % my $scsz = $SIZE{$scale}; % my $f = $scsz/$max; % my ($thiswd, $thisht) = map int, ($f*$wd + $hoff, $f*$ht + $voff); % } "> % if ($link{next}) { % }
% % for my $size (qw{smallthumb medthumb bigthumb}) {
% for my $f (@$ff) { <& .thumbnail, target => $f->name, tn => $tn{$f->name}{$size}, size => $size, caption => $m->interp->apply_escapes($f->name, "h"), focus => $f eq $this &>\ % }
% } <& .footer, path => $dir &> % <%args> $path $scale => undef % %###------------------------------------------------------------------------- <%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 %>\ % } % if ($m->has_content) { <% $m->content %>\ % }

<%args> $what $path % %###------------------------------------------------------------------------- <%def .thumbnail>\ % $tn //= "$STATICURL/folder.svg"; % if ($focus) {
<% $caption %>
% } else {
<% $caption %> % if (defined $comment) { <% $comment %> % }
% }
% <%args> $target $tn $size $caption $comment => undef $focus => 0 % %###------------------------------------------------------------------------- <%def .footer>\ <%perl> <%args> $path % %###------------------------------------------------------------------------- <%once> use autodie; 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"; if ($path =~ /^ (.*) (\.(?: zip)) $/x) { $st = stat "$IMGROOT/$1"; if ($st) { $path = $1; $comp = $2; } } } elsif (-d $st) { $comp = ".contact"; } elsif (-f $st) { $comp = ".image"; } else { $comp = ".not-found"; } $r->header_out("X-AGPL-Source" => $SRCURL); $m->comp($comp, path => $path, %ARGS); % %###----- That's all, folks -------------------------------------------------