Examples - WWW::Mechanize::Firefox example programs.
This is a documentation only module showing the examples that are included in the WWW::Mechanize::Firefox distribution.
This file was auto-generated via the gen_examples_pod.pl program that is also included in the examples directory.
gen_examples_pod.pl
The following is a list of the 3 example programs that are included in the WWW::Mechanize::Firefox distribution.
"Example: facecrop.pl" Extract faces from images
"Example: facetest.pl" Draw pretty boxes around detected face areas
"Example: sifttest.pl" Find commonalities between two images
#!perl -w use strict; use Getopt::Long; use Pod::Usage; use List::Util qw(max); use Imager; use Imager::Fill; use Image::CCV qw(detect_faces); use vars qw($VERSION); $VERSION = '0.05'; =head1 NAME facecrop.pl - create crop from image using the largest face area =head1 SYNTAX facecrop.pl filename.png facecrop.pl filename.png -o thumb_filename.png facecrop.pl scene.png -o faces_%03d.png =head1 OPTIONS =over 4 =item * C<--output-file> - output file name The output file name will be used as a template if more than one face is detected. =item * C<--width> - maximum width of the output image =item * C<--height> - maximum height of the output image =item * C<--scale> - scale factor for the output area around the face Default is 1.5 which seems to usually capture the "whole face" around the detected area. =item * C<--largest> - only output the largest face found =item * C<--draw-box> - draw a box around the detection area =item * C<--verbose> - output more information during progress =back =cut GetOptions( 'output-file|o:s' => \my $out_file, 'width|w:s' => \my $max_width, 'height|h:s' => \my $max_height, 'scale|s:s' => \my $scale, 'largest' => \my $only_largest, 'draw-box' => \my $draw_box, 'verbose' => \my $verbose, ) or pod2usage(); $scale ||= 1.5; # default chosen by wild guess for my $scene (@ARGV) { my @coords = detect_faces( $scene ); if(! @coords) { die "No face found\n"; }; if( $only_largest ) { # Now, find the largest face (area) in this image # We ignore the confidence value my $max = $coords[0]; for (@coords) { if( $_->[2] * $_->[3] > $max->[2] * $max->[3] ) { $max = $_ } }; @coords = ($max); }; if( $verbose ) { print sprintf "%d Gesichter gefunden\n", 0+@coords; }; my $index = 1; for my $face (@coords) { if( $out_file ) { my $out = Imager->new( file => $scene ); my ($x,$y,$width,$height,$confidence) = @$face; if( $draw_box ) { my $color = Imager::Color->new( (1-$confidence/100) *255, $confidence/100 *255, 0 ); # Draw a nice box $out->box( color => $color, xmin => $x, ymin => $y, xmax => $x+$width, ymax => $y+$height, aa => 1, ); }; # Scale the frame a bit up my $w = $face->[2] * $scale; my $h = $face->[3] * $scale; my $l = max( 0, $face->[0] - $face->[2]*(($scale -1) / 2)); my $t = max( 0, $face->[1] - $face->[3]*(($scale -1) / 2) ); $out = $out->crop( left => $l, top => $t, width => $w, height => $h ); if( $max_width || $max_height ) { $max_width ||= $max_height; $max_height ||= $max_width; $out = $out->scale( xpixels => $max_width, ypixels => $max_height, type => 'nonprop' ); }; my $out_name = sprintf $out_file, $index++; $out->write( file => $out_name ) or die $out->errstr; print "$out_name\n"; } else { my ($x,$y,$width,$height,$confidence) = @$face; print "($x,$y): ${width}x$height @ $confidence\n"; } } }
Download this example: http://cpansearch.perl.org/src/CORION/WWW-Mechanize-Firefox-0.05/examples/facecrop.pl
#!perl -w use strict; use Getopt::Long; use Pod::Usage; use Imager; use Imager::Fill; use Image::CCV qw(detect_faces); =head1 NAME facetest.pl - simple face detection =head1 SYNTAX facetest.pl filename.png =cut GetOptions( 'd|draw:s' => \my $draw_file, ) or pod2usage(); for my $scene (@ARGV) { my @coords = detect_faces( $scene ); if( $draw_file ) { my $out = Imager->new( file => $scene ); for (@coords) { my ($x,$y,$width,$height,$confidence) = @$_; my $color = Imager::Color->new( (1-$confidence/100) *255, $confidence/100 *255, 0 ); # Draw a nice box $out->box( color => $color, xmin => $x, ymin => $y, xmax => $x+$width, ymax => $y+$height, aa => 1, ); }; $out->write( file => $draw_file ) or die $out->errstr; } else { for (@coords) { my ($x,$y,$width,$height,$confidence) = @$_; print "($x,$y): ${width}x$height @ $confidence\n"; }; } }
Download this example: http://cpansearch.perl.org/src/CORION/WWW-Mechanize-Firefox-0.05/examples/facetest.pl
paste the two input images side by side $out->rubthrough( #!perl -w use strict; use Imager; use Imager::Fill; use List::Util qw(max); use Image::CCV qw(sift);
use vars qw($VERSION); $VERSION = '0.05'; my $scene = "images/IMG_1229_bw_small.png"; my $object = "images/IMG_1230_bw_sofa.png"; my @coords = sift( $object, $scene, ); print "@$_\n" for @coords; my $scene_image = Imager->new( file => $scene ); my $object_image = Imager->new( file => $object ); my $xsize = $scene_image->getwidth + $object_image->getwidth; my $ysize = max( $scene_image->getheight, $object_image->getheight); my $out = Imager->new( xsize => $xsize, ysize => $ysize, ); # paste the two input images side by side $out->rubthrough( src => $scene_image, tx => 0, ty => 0, src_minx => 0, src_maxx => $scene_image->getwidth-1, src_miny => 0, src_maxy => $scene_image->getheight-1, ); my $obj_ofs_x = $scene_image->getwidth; my $obj_ofs_y = 0; $out->rubthrough( src => $object_image, tx => $obj_ofs_x, ty => $obj_ofs_y, src_minx => 0, src_maxx => $object_image->getwidth-1, src_miny => 0, src_maxy => $object_image->getheight-1, ); my @points = @coords; my $green = Imager::Color->new( 0, 255, 0 ); for (@points) { $out->line( color => $green, x1 => $_->[0]+$obj_ofs_x, y1 => $_->[1]+$obj_ofs_y, x2 => $_->[2], y2 => $_->[3], ); }; $out->write( file => 'out.png' ) or die $out->errstr;
Download this example: http://cpansearch.perl.org/src/CORION/WWW-Mechanize-Firefox-0.05/examples/sifttest.pl
Max Maischein corion@cpan.org
corion@cpan.org
Contributed examples contain the original author's name.
Copyright 2012 by Max Maischein corion@cpan.org.
All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
To install Image::CCV, copy and paste the appropriate command in to your terminal.
cpanm
cpanm Image::CCV
CPAN shell
perl -MCPAN -e shell install Image::CCV
For more information on module installation, please visit the detailed CPAN module installation guide.