X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/tgal/blobdiff_plain/0485371ea73360e10ac5f2558788b4ff29abae53..e9f8c99ed456dc006c02e2dbde1568b5bb04476b:/mason/.perl-lib/TrivGal.pm diff --git a/mason/.perl-lib/TrivGal.pm b/mason/.perl-lib/TrivGal.pm index eb82db2..2bd64ed 100644 --- a/mason/.perl-lib/TrivGal.pm +++ b/mason/.perl-lib/TrivGal.pm @@ -30,8 +30,9 @@ use autodie qw{:all}; use Errno; use Exporter qw{import}; use File::stat; +use Graphics::Magick; use Image::ExifTool qw{}; -use Image::Imlib2; +use Image::Size qw{}; use User::pwent; use POSIX; @@ -92,33 +93,6 @@ sub urldecode ($) { 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. @@ -147,8 +121,19 @@ our $SRCURL = "https://git.distorted.org.uk/~mdw/tgal/"; export qw{%SIZE}; our %SIZE = (smallthumb => 96, medthumb => 144, - bigthumb => 228, - view => 1200); + bigthumb => 216, + tiny => 320, + small => 480, + embed => 720, + medium => 1080, + big => 1600, + large => 2400, + huge => 3600, + vast => 5400, + immense => 8100); + +export qw{%TYPE}; +our %TYPE = map { $_ => 1 } qw{.jpg .png}; export qw{init}; my $initp = 0; @@ -211,53 +196,92 @@ package TrivGal::Image { my $imgpath = "$IMGROOT/$path"; my $st = stat $imgpath or die "no image `$path'"; return bless { - path => $path, + path => $path, imgpath => $imgpath, mtime => $st->mtime, - img => undef + img => undef, + rot => undef, flip => undef, + wd => undef, ht => undef, + _wd => undef, _ht => undef, + sz => undef }, $cls; } - sub scale ($$) { - my ($me, $scale) = @_; + sub _getsz ($) { + my ($me) = @_; + return if defined $me->{_wd}; + + my ($wd, $ht, $err) = Image::Size::imgsize $me->{imgpath}; + defined $wd or die "failed to read size of `$me->{path}': $err"; + my $sz = $wd; if ($sz < $ht) { $sz = $ht; } + @$me{"_wd", "_ht", "sz"} = ($wd, $ht, $sz); + } + + sub _getexif ($) { + my ($me) = @_; + return if defined $me->{wd}; + + $me->_getsz; + my $exif = new Image::ExifTool; $exif->ExtractInfo($me->{imgpath}); + my $orient = $exif->GetValue("Orientation", "ValueConv"); + my ($wd, $ht) = @$me{"_wd", "_ht"}; + my ($rot, $flip); + if (defined $orient) { ($rot, $flip) = $ORIENT{$orient}->@*; } + else { ($rot, $flip) = (0, 0); } + if ($rot%2) { ($wd, $ht) = ($ht, $wd); } + @$me{"rot", "flip", "wd", "ht"} = ($rot, $flip, $wd, $ht); + } + + sub sz ($) { my ($me) = @_; $me->_getsz; return $me->{sz}; } + sub wd ($) { my ($me) = @_; $me->_getexif; return $me->{wd}; } + sub ht ($) { my ($me) = @_; $me->_getexif; return $me->{ht}; } + + sub _check_gm ($) { + my ($rc) = @_; + "$rc" and die "failed to hack `$me->{img}': $rc"; + } + + sub scale ($$;$) { + my ($me, $scale, $forcep) = @_; + my $m = HTML::Mason::Request->instance; my $path = $me->{path}; my $sz = $SIZE{$scale} or die "unknown scale `$scale'"; - my $thumb = "$CACHE/scale.$sz/$path"; - my $thumburl = "$CACHEURL/scale.$sz/$path"; - my $st = stat $thumb; - if (defined $st && $st->mtime > $me->{mtime}) { return $thumburl; } - - my ($dir, $base, $ext) = TrivGal::split_path $thumb; - my $ty = $TYPE{lc $ext} or die "unknown type `$ext'"; - - my $img = $me->{img}; - unless (defined $img) { - my $imgpath = "$IMGROOT/$path"; - my $exif = new Image::ExifTool; - $exif->ExtractInfo($imgpath); - my $orient = $exif->GetValue("Orientation", "ValueConv"); - $img = $me->{img} = Image::Imlib2->load($imgpath); - if (defined $orient) { - my ($rot, $flip) = @{$ORIENT{$orient}}; - if ($rot) { $img->image_orientate($rot); } - if ($flip) { $img->flip_horizontal(); } + my $url; + + if ($me->sz <= $sz) + { $url = $m->interp->apply_escapes("$IMGURL/$path", "u"); } + else { + my $tail = "scale.$sz/$path"; + my $thumb = "$CACHE/$tail"; + my $thumburl = $m->interp->apply_escapes("$CACHEURL/$tail", "u"); + + my $st = stat $thumb; + if ($st && $st->mtime > $me->{mtime}) + { $url = $thumburl; } + elsif (!$forcep) { + $url = + $m->interp->apply_escapes("$SCRIPTURL/$path", "u") . + "?scale=$scale"; + } else { + my $img = $me->{img}; + unless (defined $img) { + $img = $me->{img} = Graphics::Magick->new; + _check_gm $img->Read($me->{imgpath}); + } + + my ($dir, undef, $ext) = TrivGal::split_path $thumb; + $img = $img->Clone; + my $new = "$TMP/t$$-thumb$ext"; + _check_gm $img->Resize(geometry => $sz); + make_path $TMP, { mode => 0771 }; + _check_gm $img->Write($new); + make_path $dir, { mode => 0771 }; + rename $new, $thumb; + $url = $thumburl; } } - 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; + return $url; } } @@ -285,6 +309,7 @@ sub listdir ($) { my (@d, @f); my $ix = undef; + $path =~ s#/$##; if (-f "$path/.tgal.index") { open my $f, "<", "$path/.tgal.index"; my $item = undef; @@ -297,12 +322,14 @@ sub listdir ($) { $comment = defined $comment ? $comment . "\n" . $_ : $_; } else { if ($item && $comment) { $item->comment($comment); } - my ($indexp, $name, $c) = - /^ (! \s+)? # index flag + my ($flags, $name, $c) = + /^ (?: ([-!]+) \s+)? # flags (\S+) \s* # filename (\S | \S.*\S )? # start of the comment \s* $/x; + my $indexp = $flags =~ /!/; + my $hidep = $flags =~ /-/; $name = urldecode $name; my $list; $item = TrivGal::Item->new($name); @@ -311,7 +338,7 @@ sub listdir ($) { die "can't index a folder" if $indexp; } else { $list = \@f; - my ($dir, $base, $ext) = TrivGal::split_path $name; + my (undef, undef, $ext) = split_path $name; die "unknown image type" unless $TYPE{lc $ext}; if ($indexp) { die "two index images" if defined $ix; @@ -319,7 +346,7 @@ sub listdir ($) { } } $comment = $c; - push @$list, $item; + push @$list, $item unless $hidep; } } if ($item && $comment) { $item->comment($comment); } @@ -333,12 +360,12 @@ sub listdir ($) { closedir $d; ENT: for my $e (sort @e) { - my ($dir, $base, $ext) = split_path $e; + my (undef, undef, $ext) = split_path $e; my $dotp = $e =~ /^\./; my $st = stat "$path/$e"; my $list = undef; if ($dotp) { } - elsif (-d $st) { $list = \@d; } + elsif (-d $st) { $list = \@d; $e .= "/"; } elsif ($TYPE{lc $ext} && -f $st) { $list = \@f; } $list and push @$list, TrivGal::Item->new($e); }