X-Git-Url: https://git.distorted.org.uk/~mdw/tgal/blobdiff_plain/1408b7a293e5a35d99744aaa51192eab972a95a1..84ffdea7357ad52e4ad8df5ad57b90c7c097252b:/mason/dhandler diff --git a/mason/dhandler b/mason/dhandler index 813e637..c6f0f33 100755 --- a/mason/dhandler +++ b/mason/dhandler @@ -35,8 +35,8 @@ of the GNU Affero General Public License. - - "> + + "> <% $head %>\ <% $title %> @@ -67,9 +67,9 @@ Failed to find ‘<% $path |h %>’. %###------------------------------------------------------------------------- <%def .contact>\ <%perl> - unless ($r->path_info =~ m!/$!) { - $m->redirect(join_paths($SCRIPTURL, $path) . "/"); - } + 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; @@ -83,20 +83,45 @@ Failed to find ‘<% $path |h %>’. } (my $nosl = $path) =~ s!/$!!; + my @size = ("smallthumb", "medthumb", "bigthumb"); my %tn; - for my $f (@$ff) - { $tn{$f} = TrivGal::Image->new($path . $f->name); } + 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 ($ddd, $fff, $iii) = listdir $real . "/" . $d->name; - $tn{$d} = $iii ? - TrivGal::Image->new(join_paths $path, $d->name, $iii->name) : - undef; + 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"), +<&| .html, title => + "Folder " . $m->interp->apply_escapes($nosl || "[top]", "h"), head => $links &> -<& .breadcrumbs, what => "Folder", path => $path &> +<&| .breadcrumbs, what => "Folder", path => $path &> +
+ ">[zip] +
+ % % my $note = contents "$IMGROOT/$path/.tgal-note.html"; % if (defined $note) { @@ -107,12 +132,14 @@ Failed to find ‘<% $path |h %>’. % % if (@$dd) {

Subfolders

-% for my $size (qw{medthumb}) { +% for my $size (@size) {
% for my $d (@$dd) { - <& .thumbnail, target => $d->name . "/", comment => $d->comment, - img => $tn{$d}, size => $size, - caption => $m->interp->apply_escapes($d->name, "h") &>\ + <& .thumbnail, target => $d->name, comment => $d->comment, + tn => $tn{$d}{$size}, size => $size, + caption => + $m->interp->apply_escapes($d->name, "h") . + " [$count{$d}]" &>\ % }
% } @@ -120,11 +147,11 @@ Failed to find ‘<% $path |h %>’. % % if (@$ff) {

Images

-% for my $size (qw{medthumb}) { +% for my $size (@size) {
% for my $f (@$ff) { <& .thumbnail, target => $f->name, comment => $f->comment, - img => $tn{$f}, size => "bigthumb", + tn => $tn{$f}{$size}, size => $size, caption => $m->interp->apply_escapes($f->name, "h") &>\ % }
@@ -141,19 +168,91 @@ Failed to find ‘<% $path |h %>’. % %###------------------------------------------------------------------------- +<%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 $vw = TrivGal::Image->new($path)->scale("view"); + 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++) - { if ($ff->[$i]->name eq "$base$ext") { $fi = $i; last FILE; } } + 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]; @@ -169,12 +268,11 @@ Failed to find ‘<% $path |h %>’. } my $links = ""; - my $pre = - urlencode join_paths $SCRIPTURL, $dir; + 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}"; + $links .= sprintf " \n", $rel, + urlencode "$pre/$link{$rel}" + if exists $link{$rel}; } % @@ -189,23 +287,35 @@ Failed to find ‘<% $path |h %>’. %
% 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}) { - + % }
% -% my %img = map { $_ => TrivGal::Image->new($dir . "/" . $_->name) } @$ff; % for my $size (qw{smallthumb medthumb bigthumb}) {
% for my $f (@$ff) { - <& .thumbnail, target => $f->name, img => $img{$f}, size => $size, + <& .thumbnail, target => $f->name, + tn => $tn{$f->name}{$size}, size => $size, caption => $m->interp->apply_escapes($f->name, "h"), - focus => $f->name eq "$base$ext" &>\ + focus => $f eq $this &>\ % }
% } @@ -214,6 +324,7 @@ Failed to find ‘<% $path |h %>’. % <%args> $path + $scale => undef % @@ -227,17 +338,21 @@ Failed to find ‘<% $path |h %>’. % if (!@p) { [top] % } else { -[top] / \ +[top] / \ % STEP: for my $p (@p) { % if (defined $prev) { % $pp .= "$prev/"; -\ +\ <% $prev %> / \ % } % $prev = $p; % } <% $prev %>\ % } +% if ($m->has_content) { + +<% $m->content %>\ +% } <%args> $what @@ -247,17 +362,15 @@ Failed to find ‘<% $path |h %>’. % %###------------------------------------------------------------------------- <%def .thumbnail>\ -% my $tn; -% if (defined $img) { $tn = $img->scale($size); } -% else { $tn = "$STATICURL/folder.svg"; } +% $tn //= "$STATICURL/folder.svg"; % if ($focus) {
- +
<% $caption %>
% } else {
- - + +
<% $caption %> % if (defined $comment) { @@ -270,7 +383,7 @@ Failed to find ‘<% $path |h %>’. % <%args> $target - $img + $tn $size $caption $comment => undef @@ -284,14 +397,13 @@ Failed to find ‘<% $path |h %>’.
- "> + "> Trivial Gallery, copyright © 2021 Mark Wooding. Free software: you can modify it and/or redistribute it under the terms of the - GNU Affero + GNU Affero General Public License version 3. - Browse or download - the source code. + Browse or download the source code.
% my $user = % find_covering_file $IMGROOT, $path, ".tgal-footer.html"; @@ -309,7 +421,6 @@ Failed to find ‘<% $path |h %>’. %###------------------------------------------------------------------------- <%once> use autodie; -use Data::Dumper; use File::stat; use TrivGal; @@ -321,11 +432,18 @@ use Data::Dumper; my $path = $m->dhandler_arg; my $st = stat "$IMGROOT/$path"; my $comp; - if (!$st) { $comp = ".not-found"; } + 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"; } - $m->comp($comp, path => $path); + $r->header_out("X-AGPL-Source" => $SRCURL); + $m->comp($comp, path => $path, %ARGS); % %###----- That's all, folks -------------------------------------------------