| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Image::libsiftfast; | 
| 2 | 1 |  |  | 1 |  | 5 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 40 |  | 
| 3 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 305 |  | 
| 4 | 1 |  |  | 1 |  | 590 | use Data::Dumper; | 
|  | 1 |  |  |  |  | 8276 |  | 
|  | 1 |  |  |  |  | 81 |  | 
| 5 | 1 |  |  | 1 |  | 1022 | use Imager; | 
|  | 1 |  |  |  |  | 43577 |  | 
|  | 1 |  |  |  |  | 8 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | our $VERSION = '0.01_01'; | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | sub new { | 
| 10 | 0 |  |  | 0 | 0 |  | my $class = shift; | 
| 11 | 0 |  |  |  |  |  | my $self = bless {@_}, $class; | 
| 12 | 0 |  | 0 |  |  |  | $self->{siftfast_path} ||= 'siftfast'; | 
| 13 | 0 |  |  |  |  |  | $self->{imager} = Imager->new; | 
| 14 | 0 |  |  |  |  |  | return $self; | 
| 15 |  |  |  |  |  |  | } | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | sub convert_to_pnm { | 
| 18 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 19 | 0 |  |  |  |  |  | my $file = shift; | 
| 20 |  |  |  |  |  |  |  | 
| 21 | 0 |  |  |  |  |  | my $imager = $self->{imager}; | 
| 22 | 0 | 0 |  |  |  |  | $imager->read( file => $file ) or die $imager->errstr; | 
| 23 | 0 |  |  |  |  |  | my $new = $imager->convert( preset => 'grey' ); | 
| 24 | 0 |  |  |  |  |  | $file =~ s/jpg/pnm/; | 
| 25 | 0 | 0 |  |  |  |  | $new->write( file => $file, type => "pnm", pnm_write_wide_data => 1 ) | 
| 26 |  |  |  |  |  |  | or die($!); | 
| 27 | 0 |  |  |  |  |  | return $file; | 
| 28 |  |  |  |  |  |  | } | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | sub extract_features { | 
| 31 | 0 |  |  | 0 | 0 |  | my $self     = shift; | 
| 32 | 0 |  |  |  |  |  | my $pnm_file = shift; | 
| 33 |  |  |  |  |  |  |  | 
| 34 | 0 |  |  |  |  |  | my $siftfast_path = $self->{siftfast_path}; | 
| 35 | 0 |  |  |  |  |  | my @stdout = `$siftfast_path < $pnm_file 2>&1`; | 
| 36 |  |  |  |  |  |  |  | 
| 37 | 0 |  |  |  |  |  | my $stderr_message = shift @stdout; | 
| 38 | 0 |  |  |  |  |  | $stderr_message .= shift @stdout; | 
| 39 |  |  |  |  |  |  |  | 
| 40 | 0 |  |  |  |  |  | my @array = map { chomp $_; $_ } @stdout; | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 41 | 0 |  |  |  |  |  | shift @array;    # remove first line; | 
| 42 | 0 |  |  |  |  |  | my $return_string = join( "\n", @array ); | 
| 43 |  |  |  |  |  |  |  | 
| 44 | 0 |  |  |  |  |  | my @feature_vectors; | 
| 45 | 0 |  |  |  |  |  | for ( split "\n\n", $return_string ) { | 
| 46 | 0 |  |  |  |  |  | my @rec = split "\n", $_; | 
| 47 | 0 |  |  |  |  |  | my @array; | 
| 48 | 0 |  |  |  |  |  | for (@rec) { | 
| 49 | 0 |  |  |  |  |  | my @f = split " ", $_; | 
| 50 | 0 |  |  |  |  |  | push @array, @f; | 
| 51 |  |  |  |  |  |  | } | 
| 52 | 0 |  |  |  |  |  | my $X           = shift @array; | 
| 53 | 0 |  |  |  |  |  | my $Y           = shift @array; | 
| 54 | 0 |  |  |  |  |  | my $scale       = shift @array; | 
| 55 | 0 |  |  |  |  |  | my $orientation = shift @array; | 
| 56 | 0 |  |  |  |  |  | my $vector      = \@array; | 
| 57 |  |  |  |  |  |  |  | 
| 58 | 0 |  |  |  |  |  | push @feature_vectors, | 
| 59 |  |  |  |  |  |  | { | 
| 60 |  |  |  |  |  |  | frames => { | 
| 61 |  |  |  |  |  |  | X           => $X, | 
| 62 |  |  |  |  |  |  | Y           => $Y, | 
| 63 |  |  |  |  |  |  | scale       => $scale, | 
| 64 |  |  |  |  |  |  | orientation => $orientation, | 
| 65 |  |  |  |  |  |  | }, | 
| 66 |  |  |  |  |  |  | vector => $vector, | 
| 67 |  |  |  |  |  |  | }; | 
| 68 |  |  |  |  |  |  | } | 
| 69 | 0 |  |  |  |  |  | return \@feature_vectors; | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | } | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | 1; | 
| 74 |  |  |  |  |  |  | __END__ |