X-Git-Url: https://git.sesse.net/?p=pr0n;a=blobdiff_plain;f=perl%2FSesse%2Fpr0n%2FCommon.pm;h=43ea98853ffbd6e41f9e108512009d46063f1cb5;hp=073996f187bc06783d1dc8ac8c27019e6974d691;hb=c98436420fa7749e3af1f3698ccf9958dffbd4db;hpb=927b8258de3030178d59304b9b45648930482d49 diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm index 073996f..43ea988 100644 --- a/perl/Sesse/pr0n/Common.pm +++ b/perl/Sesse/pr0n/Common.pm @@ -131,11 +131,7 @@ sub get_query_string { next unless defined($value); next if (defined($defparam->{$key}) && $value == $defparam->{$key}); - $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; + $value = pretty_escape($value); $str .= ($first) ? "?" : ';'; $str .= "$key=$value"; @@ -144,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'})) { @@ -212,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) { @@ -225,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=?)',