File Coverage

lib/Panotools/Script/Line/Mask.pm
Criterion Covered Total %
statement 27 27 100.0
branch 2 4 50.0
condition n/a
subroutine 8 8 100.0
pod 0 2 0.0
total 37 41 90.2


line stmt bran cond sub pod time code
1             package Panotools::Script::Line::Mask;
2              
3 10     10   66 use strict;
  10         20  
  10         427  
4 10     10   64 use warnings;
  10         18  
  10         281  
5 10     10   59 use Panotools::Script::Line;
  10         17  
  10         232  
6              
7 10     10   70 use vars qw /@ISA/;
  10         20  
  10         3359  
8             @ISA = qw /Panotools::Script::Line/;
9              
10             =head1 NAME
11              
12             Panotools::Script::Line::Mask - Image Mask
13              
14             =head1 SYNOPSIS
15              
16             Optional image masks are described by a 'k' line
17              
18             =head1 DESCRIPTION
19              
20             i2 Set image number this mask applies to
21              
22             t0 Type for mask:
23             0 - negative (exclude region)
24             1 - positive (include region)
25             2 - exclude region from all images in the same stack
26             3 - include region from all images in the same stack
27             4 - exclude region from all images with the same lens
28              
29             p"1262 2159 1402 2065 1468 2003" List of node coordinates
30             Coordinates are in pairs, at least three pairs are required
31            
32             =cut
33              
34             sub _defaults
35             {
36 4     4   12 my $self = shift;
37             }
38              
39 9     9   26 sub _valid { return '^([itp])(.*)' }
40              
41             sub Identifier
42             {
43 1     1 0 2 my $self = shift;
44 1         6 return "k";
45             }
46              
47             sub Report
48             {
49 1     1 0 2 my $self = shift;
50 1         3 my @report;
51 1 50       5 return [] unless defined $self->{t};
52 1         2 my $type = 'Negative';
53 1 50       12 $type = 'Positive' if $self->{t} == 1;
54 1         3 my $nodes = $self->{p};
55 1         6 $nodes =~ s/(^"|"$)//;
56 1         5 my @nodes = split ' ', $nodes;
57              
58 1         4 push @report, ['Mask type', $type];
59 1         4 push @report, ['Nodes', scalar @nodes / 2];
60 1         6 [@report];
61             }
62              
63             1;