X-Git-Url: https://git.distorted.org.uk/~mdw/tgal/blobdiff_plain/6ac5dde2c2826f066d96e167f6f1fcdc46d5fab4..f615860793ef624269d888e88385647c73043938:/mason/.perl-lib/TrivGal.pm diff --git a/mason/.perl-lib/TrivGal.pm b/mason/.perl-lib/TrivGal.pm index 5bfc930..ea3b47a 100644 --- a/mason/.perl-lib/TrivGal.pm +++ b/mason/.perl-lib/TrivGal.pm @@ -29,8 +29,8 @@ use autodie qw{:all}; use Errno; use Exporter qw{import}; -use File::Path qw{make_path}; use File::stat; +use Image::ExifTool qw{}; use Image::Imlib2; use User::pwent; use POSIX; @@ -111,7 +111,7 @@ package TrivGal::ImageType { 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"); @@ -138,8 +138,14 @@ our $CACHEURL //= "$ROOTURL/tgal-cache"; our $STATICURL //= "$ROOTURL/tgal-static"; our $SCRIPTURL; +export qw{$SRCURL}; +our $SRCURL = "https://git.distorted.org.uk/~mdw/tgal/"; + export qw{%SIZE}; -our %SIZE = (thumb => 228, view => 1200); +our %SIZE = (smallthumb => 96, + medthumb => 144, + bigthumb => 228, + view => 1200); export qw{init}; my $initp = 0; @@ -183,35 +189,73 @@ sub clean_temp_files () { ###-------------------------------------------------------------------------- ### 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; +my %ORIENT = + (1 => [0, 0], + 2 => [0, 1], + 3 => [2, 0], + 4 => [2, 1], + 5 => [3, 1], + 6 => [1, 0], + 7 => [1, 1], + 8 => [3, 0]); + +package TrivGal::Image { + use File::Path qw{make_path}; + use File::stat; + + sub new ($$) { + my ($cls, $path) = @_; + my $imgpath = "$IMGROOT/$path"; + my $st = stat $imgpath or die "no image `$path'"; + return bless { + path => $path, + mtime => $st->mtime, + img => undef + }, $cls; + } + + sub scale ($$) { + my ($me, $scale) = @_; + + 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 ($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; + } } ###-------------------------------------------------------------------------- @@ -230,7 +274,7 @@ package TrivGal::Item { my ($me, @args) = @_; return TrivGal::read_or_set $me, $me->{comment}, @args; } -}; +} export qw{listdir}; sub listdir ($) { @@ -273,6 +317,9 @@ sub listdir ($) { if ($item && $comment) { $item->comment($comment); } close $f; } else { + my $st = stat "$path/$e"; + unless ($st->mode&0004) { return ([], [], undef); } + opendir $d, $path; my @e = readdir $d; closedir $d; @@ -282,7 +329,7 @@ sub listdir ($) { my $dotp = $e =~ /^\./; my $st = stat "$path/$e"; my $list = undef; - if ($dotp || !($st->mode&0004)) { } + if ($dotp) { } elsif (-d $st) { $list = \@d; } elsif ($TYPE{lc $ext} && -f $st) { $list = \@f; } $list and push @$list, TrivGal::Item->new($e);