Re: Webcam 0.2

[Beatnik]

When Stamp started Coredumping on me, I hacked this piece of code.

#!/usr/bin/perl

use Net::FTP;
use GD;
# Beatnik (c) 2000 - yadayadayada
# http://stampl.sourceforge.net
$inputfile = "/tmp/me.jpg"; # Local input filename
$outputfile = "/tmp/recent.jpg"; # Local output filename
$remotefile = "recent.jpg"; # Remote filename
$remotedir = ""; # Remote directory
$hostname = "ftp.myhost.com"; # Remote hostname
$username = "user"; # username for remote host
$password = "password"; # password for remote host
$interval = 45; # Amount of seconds to wait before uploading again
$textbot = "StamPL - Test"; # The text that should be added at the bot
+tom

for(;;) {
$texttop = localtime;
$ltop = length($texttop)*8;
$lbot = length($textbot)*8;
$result = qx|cqcam -32+ -a+ -r -j -x 320 -y 240 -q 75 > $inputfile|;
if ($result) { die $result; }
$image = GD::Image->newFromJpeg($inputfile);
$blue = $image->colorClosest(0,0,255);
$shadow = $image->colorClosest(128,128,128);
($width,$height) = $image->getBounds();
$w = $width/2;
$ttop = $w-($ltop/2);
$tbot = $w-($lbot/2);
$image->string(gdMediumBoldFont,$ttop+2,3,$texttop,$blue);
$image->string(gdMediumBoldFont,$ttop,1,$texttop,$shadow);
$image->string(gdMediumBoldFont,$tbot,($height-14),$textbot,$blue);
$image->string(gdMediumBoldFont,$tbot+2,($height-14)+2,$textbot,$shado
+w);
open(FILE,">$outputfile") || die $!;
print FILE $image->jpeg();
close(FILE);
$ftp = Net::FTP->new($hostname);
$ftp->login($username,$password);
$ftp->cwd($remotedir);
$ftp->put($outputfile,$remotefile);
$ftp->quit;
sleep($interval);
}

It uses GD (which limits palette to 256 colors :( ) and Net::FTP. It also uses cqcam (which is also used by Stamp), and it currently on Sourceforge somewhere.
Ofcourse sleep() isnt really a clean way to do it, but I didnt felt like forking :)

Greetz
Beatnik
... Quidquid perl dictum sit, altum viditur.

[peschkaj]

Dayum, that's alot of code. I wrote a piece of cam-like software today. I have found a program that works astonishingly well (gqcam) on my linux box. The only problem being that it doesn't auto upload. So, I took it upon myself to write some code for it:

#!/usr/bin/perl -w

use Net::FTP;

my $hostname;
my $username;
my $password;
my $boink;
my $directory;
my $filename;
my $ftp;
my $sleeptime;

$boink = 0;

while ($boink == 0) {
    $ftp = Net::FTP->new($hostname) or die "can't connect: $@\n";
    $ftp->login($username,$password) or die "can't login: $@\n";
    $ftp->cwd($directory) or die "can't cwd to $directory\n";
    $ftp->type(binary) or die "cannot change type to binary\n";
    $ftp->put($filename) or die "cannot put $filename\n";
    $ftp->close;
    sleep($sleeptime);
}

Althogh this is nothing revolutionary, I thought that I might as well post it because it runs under -w, as far as I am aware. I attempted to launch gqcam from the program with: `gqcam &`; but that generated error after error for the cam program. If anyone has any input on this, let me know.

[Beatnik]

The huge amount of code is mostly for GD... the timestamp and footer stuff. I can compact it to a one-liner but then again... :))
The whole purpose was to more or less mimick the Stamp app behaviour (which it kinda does).

Greetz
Beatnik
... Quidquid perl dictum sit, altum viditur.