package mugshot; use me; use strict; use CGI; use MIME::Base64; use Time::localtime qw(localtime); use Time::Local; sub mugshot { my $q = new CGI; $q->import_names('R'); print $q->header(); if ($R::command eq "sendpic") { #my $data = decode_base64($R::img); #open (MYDATA,">/wwwroot/extranet/mugs/$R::termid.jpg"); # binmode MYDATA; # print MYDATA $data; #close (MYDATA); my $img = $R::image; if($img){ my $capture_img = "/wwwroot/extranet/mugs/$R::termid.jpg"; unlink($capture_img) if -e $capture_img; my @urls = split(',',$img); my $uri = $urls[1]; my $data = decode_base64($uri); open FILE,">$capture_img"; binmode FILE; print FILE $data; close FILE; ResizeImg($capture_img,179,240); ResizeImg($capture_img,70,90,1); print "done=done&name=$R::termid.jpg"; } } elsif ($R::action eq "camera") { my $datafile = slurpanyfile("/wwwroot/extranet/cam/webcamonly.html"); $datafile =~ s/\[termid\]/$R::termid/gsi; $datafile =~ s/\[termname\]/$R::termname/gsi; print $datafile; } else { print "No param"; } } sub slurpanyfile { open(IN, "< $_[0]");# or die "can't open $_[0]: $!"; binmode (IN); seek(IN, 0, 0); sysread (IN, my $slurp, -s IN); close(IN); return $slurp; } sub ResizeImg { my ($file,$width_max,$height_max,$nn) = @_; $width_max ||=150; $height_max||=150; &resizeGD($file,$width_max,$height_max,$nn); } sub resizeGD { my ($file,$width_max,$height_max,$nn) = @_; eval { require GD; }; return if $@; GD::Image->trueColor(1); my $image = GD::Image->new($file); return unless $image; my ($width,$height) = $image->getBounds(); my $thumb; $image->transparent($image->colorAllocate(255,255,255)); my $k_w = $width_max / $width; my $k_h = $height_max / $height; my $k = ($k_h < $k_w ? $k_h : $k_w); my $width1 = int(0.99+$width * $k); my $height1 = int(0.99+$height * $k); $thumb = GD::Image->new($width1,$height1); $thumb->copyResampled($image, 0,0,0,0, $width1, $height1, $width, $height); my $jpegdata = $thumb->jpeg(100); $file=~s/\.(jpg|jpeg|gif|png|bmp)$//i; $file = $file."_".$nn if $nn; open(FILE,">$file.jpg")||die"can't write th:$!"; binmode FILE; print FILE $jpegdata; close(FILE); } 1;