File Coverage

blib/lib/Image/libsiftfast.pm
Criterion Covered Total %
statement 12 50 24.0
branch 0 4 0.0
condition 0 2 0.0
subroutine 4 7 57.1
pod 0 3 0.0
total 16 66 24.2


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__