Fix some Perl deprecation warnings. Patches from xim.

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

diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm
index 72f3b75b15d80fc1442a32e10efe2c216a404a20..559d6339f38b206498902f801ffa721d777c6593 100644 (file)
--- a/perl/Sesse/pr0n/Common.pm
+++ b/perl/Sesse/pr0n/Common.pm
@@ -39,7 +39,7 @@ BEGIN {
                require Sesse::pr0n::Config_local;
        };
 
-       $VERSION     = "v2.71";
+       $VERSION     = "v2.72";
        @ISA         = qw(Exporter);
        @EXPORT      = qw(&error &dberror);
        %EXPORT_TAGS = qw();
@@ -211,7 +211,7 @@ sub get_base {
        my $r = shift;
        return $r->dir_config('ImageBase');
 }
-
+                               
 sub get_disk_location {
        my ($r, $id) = @_;
         my $dir = POSIX::floor($id / 256);
@@ -231,6 +231,23 @@ sub get_cache_location {
        }
 }
 
+sub ensure_disk_location_exists {
+       my ($r, $id) = @_;
+       my $dir = POSIX::floor($id / 256);
+
+       my $img_dir = get_base($r) . "/images/$dir/";
+       if (! -d $img_dir) {
+               $r->log->info("Need to create new image directory $img_dir");
+               mkdir($img_dir) or die "Couldn't create new image directory $img_dir";
+       }
+
+       my $cache_dir = get_base($r) . "/cache/$dir/";
+       if (! -d $cache_dir) {
+               $r->log->info("Need to create new cache directory $cache_dir");
+               mkdir($cache_dir) or die "Couldn't create new image directory $cache_dir";
+       }
+}
+
 sub get_mipmap_location {
        my ($r, $id, $width, $height) = @_;
         my $dir = POSIX::floor($id / 256);
@@ -1100,8 +1117,6 @@ sub purge_cache {
        }
        $regex .= "(\\?.*)?\$";
        $r->headers_out->{'X-Pr0n-Purge'} = $regex;
-
-       $r->log->info($r->headers_out->{'X-Pr0n-Purge'});
 }
                                
 # Find a list of all cache URLs for a given image, given what we have on disk.