Cookie Notice

As far as I know, and as far as I remember, nothing in this page does anything with Cookies.

2010/05/03

So, 1000 words each?

I have a webcam. I run it via camorama and it takes a shot every 20 minutes. I start it and forget it, mostly using it as a rear-view mirror to tell me if someone is coming up behind me. (I have a real mirror too. I hate people sneaking up on me.)
So, I end up with lots of shots that look like this, like the wall behind me with the lights off. They're all the same shot, except they're not. They are different pictures of the same view, and thus have different sizes and different hashes. Which meant that all the standard measures of uniqueness I knew how to code are useless.
So, I did some looking and some coding, and I found a means using ImageMagick to pull some data out, which I could then use to tell ... it's not really motion-sensing, but rather whether the light is on or not. Which is enough.


#!/usr/bin/perl

use 5.010 ;
use strict ;
use warnings ;
use lib '/home/jacoby/lib' ;
use Carp ;
use Cwd 'abs_path' ;
use Data::Dumper ;
use Digest::SHA1 ;
use File::Copy ;
use HOP ':all' ;
use subs qw{ main all_files image_check } ;

my %digest ;
main '/home/jacoby/Webcam/' ;
exit ;

sub main {
    my ( $dir ) = @_ ;
    my $first = '' ;
    my $prev = '' ;
    for my $curr ( all_files $dir ) {
        my $del = 0 ;
        if ( $prev ne '' ) {
            my $check = image_check( $prev , $curr ) ;
            say join "\t" , $check , $prev , $curr ;
            $del = 1 if $check < 1 ;
            }
        if ( $del ) {
            unlink $curr ;
            next ; 
            }
        $first = $curr if $first eq '' ;
        $prev = $curr ;
        }
    } ;

sub image_check {
    my ( $pic1 , $pic2 ) = @_ ;
    my $out = qx{ compare -verbose -metric MAE $pic1 $pic2 /dev/null 2>&1 } ;
    my ( $all ) = grep m{all}mx , split m{\n} , $out ;
    $all = ( split m{\s+}mx , $all )[2] ;
    $all = int $all ;
    return $all  < 800 ? 0 : 1 ;
    }

sub all_files {
    my $dir = shift ;
    return sort { $a cmp $b } <webcam*.png> ;
    }
There are a few modules in there that I don't need, or at least that I don't need at this point in the process. There's also a qx() where I should be using Image::Magick, I know, but I just could not get that working. I tried both CPAN (which has had networking troubles for me) and apt-get (which is kinda hammered due to Lucid coming out), and neither made me happy. I figure this is another issue and I can make it better later. And better it is, because after running it, I get this:


Well, I think it's an improvement....