Refactor the charset guessing.

[pr0n] / perl / Sesse / pr0n / Common.pm

diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm
index 1c864fc6d8a88b07ad5b599cfa54b8389ff9671d..bc598545a4b97e66da5a478710fbb6ff671ade62 100644 (file)
--- a/perl/Sesse/pr0n/Common.pm
+++ b/perl/Sesse/pr0n/Common.pm
@@ -11,6 +11,8 @@ use Apache2::Const -compile => ':common';
 use Apache2::Log;
 use ModPerl::Util;
 
+use Carp;
+use Encode;
 use DBI;
 use DBD::Pg;
 use Image::Magick;
@@ -31,7 +33,7 @@ BEGIN {
                require Sesse::pr0n::Config_local;
        };
 
-       $VERSION     = "v2.10";
+       $VERSION     = "v2.12";
        @ISA         = qw(Exporter);
        @EXPORT      = qw(&error &dberror);
        %EXPORT_TAGS = qw();
@@ -67,6 +69,7 @@ sub error {
         footer($r);
 
        $r->log->error($err);
+       $r->log->error("Stack trace follows: " . Carp::longmess());
 
        ModPerl::Util::exit();
 }
@@ -126,7 +129,7 @@ sub get_query_string {
                next unless defined($value);
                next if (defined($defparam->{$key}) && $value == $defparam->{$key});
        
-               $str .= ($first) ? "?" : '&';
+               $str .= ($first) ? "?" : ';';
                $str .= "$key=$value";
                $first = 0;
        }
@@ -134,8 +137,12 @@ sub get_query_string {
 }
 
 sub print_link {
-       my ($r, $title, $baseurl, $param, $defparam) = @_;
-       my $str = "<a href=\"$baseurl" . get_query_string($param, $defparam) . "\">$title</a>";
+       my ($r, $title, $baseurl, $param, $defparam, $accesskey) = @_;
+       my $str = "<a href=\"$baseurl" . get_query_string($param, $defparam) . "\"";
+       if (defined($accesskey) && length($accesskey) == 1) {
+               $str .= " accesskey=\"$accesskey\"";
+       }
+       $str .= ">$title</a>";
        $r->print($str);
 }
 
@@ -519,6 +526,48 @@ sub gcd {
        return gcd($b, $a % $b);
 }
 
+sub add_new_event {
+       my ($dbh, $id, $date, $desc, $vhost) = @_;
+       my @errors = ();
+
+       if (!defined($id) || $id =~ /^\s*$/ || $id !~ /^([a-zA-Z0-9-]+)$/) {
+               push @errors, "Manglende eller ugyldig ID.";
+       }
+       if (!defined($date) || $date =~ /^\s*$/ || $date =~ /[<>&]/ || length($date) > 100) {
+               push @errors, "Manglende eller ugyldig dato.";
+       }
+       if (!defined($desc) || $desc =~ /^\s*$/ || $desc =~ /[<>&]/ || length($desc) > 100) {
+               push @errors, "Manglende eller ugyldig beskrivelse.";
+       }
+       
+       if (scalar @errors > 0) {
+               return @errors;
+       }
+               
+       $dbh->do("INSERT INTO events (id,date,name,vhost) VALUES (?,?,?,?)",
+               undef, $id, $date, $desc, $vhost)
+               or return ("Kunne ikke sette inn ny hendelse" . $dbh->errstr);
+       $dbh->do("INSERT INTO last_picture_cache (event,last_picture) VALUES (?,NULL)",
+               undef, $id)
+               or return ("Kunne ikke sette inn ny cache-rad" . $dbh->errstr);
+
+       return ();
+}
+
+sub guess_charset {
+       my $text = shift;
+       my $decoded;
+
+       eval {
+               $decoded = Encode::decode("utf-8", $text, Encode::FB_CROAK);
+       };
+       if ($@) {
+               $decoded = Encode::decode("iso8859-1", $text);
+       }
+
+       return $decoded;
+}
+
 1;