X-Git-Url: https://git.sesse.net/?p=pr0n;a=blobdiff_plain;f=perl%2FSesse%2Fpr0n%2FCommon.pm;h=098c9d36d22ea766ce6f828dc6f0633f15fa00a6;hp=024d220f4628dd39df35a4deeb8cd5d2b3efd8a6;hb=237f1387a5410de5b85f2d9ee564c193ea896bf9;hpb=6aab2b85ef880b18dc8f1a575d477f942db7c58b diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm index 024d220..098c9d3 100644 --- a/perl/Sesse/pr0n/Common.pm +++ b/perl/Sesse/pr0n/Common.pm @@ -24,6 +24,7 @@ use LWP::Simple; # use Image::Info; use Image::ExifTool; use HTML::Entities; +use URI::Escape; BEGIN { use Exporter (); @@ -129,6 +130,8 @@ sub get_query_string { while (my ($key, $value) = each %$param) { next unless defined($value); next if (defined($defparam->{$key}) && $value == $defparam->{$key}); + + $value = pretty_escape($value); $str .= ($first) ? "?" : ';'; $str .= "$key=$value"; @@ -136,6 +139,27 @@ sub get_query_string { } return $str; } + +sub pretty_escape { + my $value = shift; + + $value = URI::Escape::uri_escape($value); + + # Unescape a few for prettiness (we'll need something for a real _, though) + $value =~ s/%20/_/g; + $value =~ s/%2F/\//g; + + return $value; +} + +sub pretty_unescape { + my $value = shift; + + # URI unescaping is already done for us + $value =~ s/_/ /g; + + return $value; +} sub print_link { my ($r, $title, $baseurl, $param, $defparam, $accesskey) = @_; @@ -188,7 +212,9 @@ sub update_image_info { my ($r, $id, $width, $height) = @_; # Also find the date taken if appropriate (from the EXIF tag etc.) - my $info = Image::ExifTool::ImageInfo(get_disk_location($r, $id)); + my $exiftool = Image::ExifTool->new; + $exiftool->ExtractInfo(get_disk_location($r, $id)); + my $info = $exiftool->GetInfo(); my $datetime = undef; if (defined($info->{'DateTimeOriginal'})) { @@ -205,11 +231,12 @@ sub update_image_info { undef, $width, $height, $datetime, $id) or die "Couldn't update width/height in SQL: $!"; + # EXIF information $dbh->do('DELETE FROM exif_info WHERE image=?', undef, $id) or die "Couldn't delete old EXIF information in SQL: $!"; - my $q = $dbh->prepare('INSERT INTO exif_info (image,tag,value) VALUES (?,?,?)') + my $q = $dbh->prepare('INSERT INTO exif_info (image,key,value) VALUES (?,?,?)') or die "Couldn't prepare inserting EXIF information: $!"; for my $key (keys %$info) { @@ -218,6 +245,20 @@ sub update_image_info { or die "Couldn't insert EXIF information in database: $!"; } + # Tags + my @tags = $exiftool->GetValue('Keywords', 'ValueConv'); + $dbh->do('DELETE FROM tags WHERE image=?', + undef, $id) + or die "Couldn't delete old tag information in SQL: $!"; + + my $q = $dbh->prepare('INSERT INTO tags (image,tag) VALUES (?,?)') + or die "Couldn't prepare inserting tag information: $!"; + + for my $tag (@tags) { + $q->execute($id, guess_charset($tag)) + or die "Couldn't insert tag information in database: $!"; + } + # update the last_picture cache as well (this should of course be done # via a trigger, but this is less complicated :-) ) $dbh->do('UPDATE last_picture_cache SET last_picture=GREATEST(last_picture, ?) WHERE (vhost,event)=(SELECT vhost,event FROM images WHERE id=?)', @@ -404,7 +445,7 @@ sub ensure_cached { $parms{'interlace'} = 'Plane'; } if (defined($sf)) { - $parms{'scaling-factor'} = $sf; + $parms{'sampling-factor'} = $sf; } $err = $cimg->write(%parms); }