File Coverage

blib/lib/Imager/SkinDetector.pm

Criterion	Covered	Total	%
statement	12	152	7.8
branch	0	52	0.0
condition	0	26	0.0
subroutine	4	14	28.5
pod	6	9	66.6
total	22	253	8.7

# vim: ts=4 sw=4 tw=0 et
# $Id: SkinDetector.pm 136 2008-10-18 21:11:51Z Cosimo $

package Imager::SkinDetector;

use strict;
use Carp q(croak);
use File::Temp ();
use base q(Imager);

our $VERSION = '0.05';

sub new {
    my ($class, %opt) = @_;

    return unless %opt;

    my $file = $opt{file};
    my $url  = $opt{url};

    if (! defined $file && ! defined $url) {
        return;
    }

    $class = ref($class) || $class;
    my $self = Imager->new();

    # If url, download it and open a temp file
    if (defined $url && $url =~ m{^https?://}) {
        $file = _download_temp_file($url);
    }

    if (! $self->open(file=>$file)) {
        croak $self->errstr();
    }

    bless $self, $class;
}

# A rough estimate, based on all other meaningful factors
sub contains_nudity {
    my ($img) = @_;

    # All factors should have range (0..1)
    my $skinniness = $img->skinniness();
    my $coloriness = $img->has_different_colors() || 0.0001;

    # Apply gaussian function to $coloriness.

    # We assume that 0.2 (7 distinct color hues, 0.2*36)
    # is the center and maximum of our gaussian curve,
    # rapidly decreasing to zero for values lower and higher
    # than 7.

    # If the image has a color histogram with many different
    # hue intervals (max=36) then it's unlikely it contains nudity.
    # Same goes for images with 1 or 2 distinct color hues.

    # See: http://en.wikipedia.org/wiki/Gaussian_function

    $coloriness = exp(-(($coloriness - 0.2)**2 / 20));

    my $nudity_factor = $skinniness * $coloriness;

    return $nudity_factor;
}

# Make a HTTP request and save it as temporary file
sub _download_temp_file {
    my ($url) = @_;

    eval { require LWP::Simple };
    if ($@) {
        croak "Can't download URL $url without LWP";
    }

    my $pic = LWP::Simple::get($url);
    if (! $pic) {
        croak "Failed to load image at URL $url";
    }

    my $tmpf = File::Temp->new( UNLINK => 0 );
    my $file_name = $tmpf->filename();
    binmode $tmpf;
    print $tmpf $pic;
    close $tmpf;

    return $file_name;
}

sub hue_frequencies {
    my ($img) = @_;

    return unless $img;

    my $width  = $img->getwidth() - 1;
    my $height = $img->getheight() - 1;
    my @frequency = (0) x 36;
    my ($r, $g, $b,    $h, $s, $v);
    my $color;
    my $color_interval;
    my $total = 0;

    # Sample the image and check pixel colors
    for (my $x = 0; $x < $width; $x += 5) {

        for (my $y = 0; $y < $height; $y += 5) {

            next unless $color = $img->getpixel(x => $x, y => $y);

            ($r, $g, $b) = $color->rgba();
            ($h, $s, $v) = rgb2hsv($r, $g, $b);

            $color_interval = int ($h / 10);
            $frequency[$color_interval]++;
            $total++;
        }
    }

    # Normalize frequencies, removing spurious results
    if (! $total) {
        return;
    }

    for my $value (@frequency) {
        $value /= $total;
    }

    return @frequency;
}

sub minmax {
    local $_;
    my $max = my $min = $_[0];

    for(@_) {
        $max = $_ if $_ > $max;
        $min = $_ if $_ < $min;
    }
    return($min, $max);
}

# Naive rgb-to-hsv conversion. Slooow...
sub rgb2hsv {
    my($r, $g, $b) = @_;

    #$r = 255 if $r > 255;
    #$g = 255 if $g > 255;
    #$b = 255 if $b > 255;

    my($h1, $s1, $v1);
    my($max, $min, $diff);

    ($min, $max) = minmax($r, $g, $b);
    $diff = $max - $min;

    if($max == 0) {
        $h1 = $s1 = $v1 = 0;
    }
    else {
        $v1 = $max;
        $s1 = $diff / $max;
        if($s1 == 0) {
            $h1 = 0;
        }
        else {
            # Foley & VanDam HSV space
            if ($r == $max) {
                $h1 = ($g - $b) / $diff;
            }
            if ($g == $max) {
                $h1 = 2 + ($b - $r) / $diff;
            }
            if ($b == $max) {
                $h1 = 4 + ($r - $g) / $diff;
            }

            # Convert to range [0, 360] degrees
            $h1 *= 60;
            $h1 += 360 if $h1 < 0;
        }
    }

    return($h1, $s1, $v1);
}

sub is_skin {
    my ($color) = $_[0];
    my ($r, $g, $b, $a) = $color->rgba;
    my ($h, $s, $v) = rgb2hsv($r, $g, $b);

    #print "RGBA(", join(', ', $r, $g, $b, $a), ")\n";
    #print "HSV (", join(', ', $h, $s, $v), "\n";
    #;

    # Hue 5..40 could be a good approximation of "white" skin
    if ($h >= 5 && $h <= 40 && $v > 60) {
        return 1;
    }

    # TODO Detect also black skin
    return 0;
}

sub is_fuzzy {
    my ($img) = @_;

    return unless $img;

    my $width  = $img->getwidth() - 1;
    my $height = $img->getheight() - 1;

    my $differences = 0;
    my $total_samples = 0;
    my ($r, $g, $b);

    # Sample first pixel
    my $color = $img->getpixel(x=>0, y=>0);
    my($r2, $g2, $b2, undef) = $color->rgba();
    my $pixel_diff = 0;
    my $pixel_diff_threshold = 40;

    # Sample the image and check how much "variance"
    # there is between pixels
    for (my $x = 5; $x < $width - 5; $x += 1) {

        for (my $y = 5; $y < $height - 5; $y += 1) {

            $color = $img->getpixel(x => $x, y => $y);
            ($r, $g, $b, undef) = $color->rgba();

            if ($r < 5 && $g < 5 && $b < 5) {
                next
            }

            $pixel_diff  = abs($r2 - $r);
            $pixel_diff += abs($g2 - $g);
            $pixel_diff += abs($b2 - $b);

            if ($pixel_diff > $pixel_diff_threshold) {
                $differences += $pixel_diff;
            }

            $r2 = $r;
            $g2 = $g;
            $b2 = $b;

            $total_samples++;
        }

    }

    if ($total_samples == 0) {
        return
    }

    $differences = $differences / $total_samples;

    return $differences;
}

sub has_different_colors {
    my ($img) = @_;

    # Filter out colors with <= 3%
    my $value_threshold = 0.04;

    # Extract hue histogram
    my @freq = $img->hue_frequencies();

    my $distinct = 0;
    for (@freq) {
        ++$distinct if $_ > $value_threshold;
    }

    # 36 is total possible different hue intervals
    return $distinct / 36;
}

sub skinniness {
    my ($img) = @_;

    return unless $img;

    my $width  = $img->getwidth() - 1;
    my $height = $img->getheight() - 1;

    my $skin_colors = 0;
    my $total_samples = 0;
    my $color;

    # Sample the image and check pixel colors
    for (my $x = 0; $x < $width; $x += 10) {
        for (my $y = 0; $y < $height; $y += 10) {

            $color = $img->getpixel(x => $x, y => $y);

            if ($color && is_skin($color)) {
                $skin_colors++;
            }

            $total_samples++;
        }
    }

    if ($total_samples == 0) {
        return
    }

    return $skin_colors / $total_samples;
}

1;

__END__