X-Git-Url: https://git.sesse.net/?p=pr0n;a=blobdiff_plain;f=perl%2FSesse%2Fpr0n%2FCommon.pm;h=43ea98853ffbd6e41f9e108512009d46063f1cb5;hp=e12e8dc53efa85bba94a5a3221c37ab58025980f;hb=4e9898a97f5c3c52d1277ed73cb4365b8644870a;hpb=fa10473159be03eb924e50cdb4688540c78f89b1 diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm index e12e8dc..43ea988 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 (); @@ -130,8 +131,7 @@ sub get_query_string { next unless defined($value); next if (defined($defparam->{$key}) && $value == $defparam->{$key}); - # FIXME: We'll need to escape _ here somehow - $value =~ s/ /_/g; + $value = pretty_escape($value); $str .= ($first) ? "?" : ';'; $str .= "$key=$value"; @@ -140,6 +140,44 @@ sub get_query_string { return $str; } +# This is not perfect (it can't handle "_ " right, for one), but it will do for now +sub weird_space_encode { + my $val = shift; + if ($val =~ /_/) { + return "_" x (length($val) * 2); + } else { + return "_" x (length($val) * 2 - 1); + } +} + +sub weird_space_unencode { + my $val = shift; + if (length($val) % 2 == 0) { + return "_" x (length($val) / 2); + } else { + return " " x ((length($val) + 1) / 2); + } +} + +sub pretty_escape { + my $value = shift; + + $value =~ s/(([_ ])\2*)/weird_space_encode($1)/ge; + $value = URI::Escape::uri_escape($value); + $value =~ s/%2F/\//g; + + return $value; +} + +sub pretty_unescape { + my $value = shift; + + # URI unescaping is already done for us + $value =~ s/(_+)/weird_space_unencode($1)/ge; + + return $value; +} + sub print_link { my ($r, $title, $baseurl, $param, $defparam, $accesskey) = @_; my $str = "new; + $exiftool->ExtractInfo(get_disk_location($r, $id)); + my $info = $exiftool->GetInfo(); my $datetime = undef; if (defined($info->{'DateTimeOriginal'})) { @@ -208,11 +248,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) { @@ -221,6 +262,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=?)',