rescale needles too
[os-autoinst:os-autoinst.git] / needle.pm
1 package needle;
2
3 use strict;
4 use warnings;
5 use File::Find;
6 use File::Spec;
7 use Data::Dump;
8 use JSON;
9 use File::Basename;
10
11 our %needles;
12 our %tags;
13
14 sub new($) {
15     my $classname=shift;
16     my $jsonfile=shift;
17     local $/;
18     open( my $fh, '<', $jsonfile ) || return undef;
19     my $json = decode_json( <$fh> ) || die "broken json $jsonfile";
20     close($fh);
21     my $self = {
22         tags => ($json->{'tags'} || [])
23     };
24
25     my $gotmatch;
26     for my $area (@{$json->{'area'}}) {
27         my $a = {};
28         for my $tag (qw/xpos ypos width height/) {
29             $a->{$tag} = $area->{$tag} || 0;
30         }
31         for my $tag (qw/processing_flags max_offset/) {
32             $a->{$tag} = $area->{$tag} if $area->{$tag};
33         }
34         $a->{'match'} = $area->{'match'} if $area->{'match'};
35         $a->{'type'} = $area->{'type'} || 'match';
36
37         $gotmatch = 1 if $a->{'type'} eq 'match';
38
39         $self->{'area'} ||= [];
40         push @{$self->{'area'}}, $a;
41     }
42
43     # one match is mandatory
44     unless ($gotmatch) {
45         warn "$jsonfile missing match area\n";
46         return undef;
47     }
48
49     $self->{file} = $jsonfile;
50     $self->{name} = basename($jsonfile, '.json');
51     my $png = $self->{png} || $self->{name} . ".png";
52     $self->{png} = File::Spec->catpath('', dirname($jsonfile), $png);
53     if (! -s $self->{png}) {
54       die "Can't find $self->{png}";
55     }
56
57     $self = bless $self, $classname;
58     $self->register();
59     return $self;
60 }
61
62 sub save($;$)
63 {
64     my $self = shift;
65     my $fn = shift || $self->{'file'};
66     my @area;
67     for my $a (@{$self->{'area'}}) {
68         my $aa = {};
69         for my $tag (qw/xpos ypos width height max_offset processing_flags match type/) {
70             $aa->{$tag} = $a->{$tag} if defined $a->{$tag};
71         }
72         push @area, $aa;
73     }
74     my $json = to_json({ tags => $self->{'tags'},
75         area => \@area,
76     }, {utf8 => 1, pretty => 1});
77     open(my $fh, '>', $fn) || die "can't open $fn for writing: $!\n";
78     print $fh $json;
79     close $fh;
80 }
81
82 sub unregister($)
83 {
84     my $self = shift;
85     print "unregister $self->{name}\n";
86     for my $g (@{$self->{tags}}) {
87         @{$tags{$g}} = grep { $_ != $self } @{$tags{$g}};
88     }
89 }
90
91 sub register($)
92 {
93     my $self = shift;
94     for my $g (@{$self->{tags}}) {
95       $tags{$g} ||= [];
96       push(@{$tags{$g}}, $self);
97     }
98 }
99
100 sub get_image($$) {
101     my $self=shift;
102     my $area = shift;
103
104     if (!$self->{'img'}) {
105         $self->{'img'} = tinycv::read($self->{'png'});
106         if ($self->{'img'}->xres() != 1024) {
107           $self->{'img'} = $self->{'img'}->scale(1024, 768);
108         }
109
110         for my $a (@{$self->{'area'}}) {
111             next unless $a->{'type'} eq 'exclude';
112             $self->{'img'}->replacerect(
113                 $a->{'xpos'}, $a->{'ypos'},
114                 $a->{'width'}, $a->{'height'});
115         }
116     }
117
118     return $self->{'img'} unless $area;
119
120     if (!$area->{'img'}) {
121         $area->{'img'} = $self->{'img'}->copyrect(
122             $area->{'xpos'},
123             $area->{'ypos'},
124             $area->{'width'},
125             $area->{'height'}
126         );
127     }
128     return $area->{'img'};
129 }
130
131 sub has_tag($$) {
132         my $self = shift;
133         my $tag = shift;
134         for my $t (@{$self->{tags}}) {
135                 return 1 if ($t eq $tag);
136         }
137         return 0;
138 }
139
140 sub wanted_($) {
141     return unless (m/.json$/);
142     my $needle = needle->new($File::Find::name);
143     if ($needle) {
144         $needles{$needle->{name}} = $needle;
145     }
146 }
147
148 sub init($) {
149         my $dirname=shift;
150         find( { no_chdir => 1, wanted => \&wanted_ }, $dirname );
151         #for my $k (keys %tags) {
152         #       print "$k\n";
153         #       for my $p (@{$tags{$k}}) {
154         #               print "  ", $p->{'name'}, "\n";
155         #       }
156         #}
157 }
158
159 sub tags($) {
160     my @tags = split(/ /, shift);
161     my $first_tag = shift @tags;
162     my $goods = $tags{$first_tag};
163     # go out early if there is nothing to do
164     return $goods if (!$goods || !@tags);
165     my @results;
166     # now check that it contains all the other tags too
167     NEEDLE: for my $n (@$goods) {
168             for my $t (@tags) {
169                     last NEEDLE if (!$n->has_tag($t));
170             }
171             print "adding ", $n->{name}, "\n";
172             push(@results, $n);
173     }
174     return \@results;
175 }
176
177 sub all() {
178         return values %needles;
179 }
180
181 1;