File Coverage

blib/lib/ICC/Profile/sig_.pm
Criterion Covered Total %
statement 33 44 75.0
branch 3 14 21.4
condition 0 3 0.0
subroutine 9 11 81.8
pod 1 6 16.6
total 46 78 58.9


line stmt bran cond sub pod time code
1             package ICC::Profile::sig_;
2              
3 2     2   103960 use strict;
  2         13  
  2         47  
4 2     2   8 use Carp;
  2         4  
  2         122  
5              
6             our $VERSION = 0.12;
7              
8             # revised 2018-08-07
9             #
10             # Copyright © 2004-2020 by William B. Birkett
11              
12             # inherit from Shared
13 2     2   12 use parent qw(ICC::Shared);
  2         3  
  2         9  
14              
15             # create new sig_ tag object
16             # parameters: ([text_string])
17             # returns: (ref_to_object)
18             sub new {
19              
20             # get object class
21 1     1 0 670 my $class = shift();
22            
23             # create empty sig_ object
24 1         4 my $self = [
25             {}, # object header
26             ' ' # text string
27             ];
28              
29             # if parameter supplied
30 1 50       4 if (@_) {
31            
32             # save as 4-byte string
33 0         0 $self->[1] = pack('a4', shift());
34            
35             }
36              
37             # bless object
38 1         2 bless($self, $class);
39            
40             # return object reference
41 1         2 return($self);
42              
43             }
44              
45             # create sig_ tag object from ICC profile
46             # parameters: (ref_to_parent_object, file_handle, ref_to_tag_table_entry)
47             # returns: (ref_to_object)
48             sub new_fh {
49              
50             # get object class
51 1     1 0 536 my $class = shift();
52              
53             # create empty sig_ object
54 1         4 my $self = [
55             {}, # object header
56             '' # text string
57             ];
58              
59             # verify 3 parameters
60 1 50       5 (@_ == 3) or croak('wrong number of parameters');
61              
62             # read sig_ data from profile
63 1         4 _readICCsig_($self, @_);
64              
65             # bless object
66 1         2 bless($self, $class);
67              
68             # return object reference
69 1         9 return($self);
70              
71             }
72              
73             # writes sig_ tag object to ICC profile
74             # parameters: (ref_to_parent_object, file_handle, ref_to_tag_table_entry)
75             sub write_fh {
76              
77             # verify 4 parameters
78 1 50   1 0 919 (@_ == 4) or croak('wrong number of parameters');
79              
80             # write sig_ data to profile
81 1         5 goto &_writeICCsig_;
82              
83             }
84              
85             # get tag size (for writing to profile)
86             # returns: (tag_size)
87             sub size {
88            
89             # get parameters
90 3     3 0 421 my ($self) = @_;
91            
92             # return size
93 3         19 return(12);
94            
95             }
96              
97             # get/set text string
98             # parameters: ([text_string])
99             # returns: (text_string)
100             sub text {
101              
102             # get object reference
103 0     0 0 0 my $self = shift();
104            
105             # if parameter supplied
106 0 0       0 if (@_) {
107            
108             # save it
109 0         0 $self->[1] = pack('a4', shift());
110            
111             }
112            
113             # return text string
114 0         0 return($self->[1]);
115              
116             }
117              
118             # print object contents to string
119             # format is an array structure
120             # parameter: ([format])
121             # returns: (string)
122             sub sdump {
123              
124             # get parameters
125 0     0 1 0 my ($self, $p) = @_;
126              
127             # local variables
128 0         0 my ($s, $fmt);
129              
130             # resolve parameter to an array reference
131 0 0       0 $p = defined($p) ? ref($p) eq 'ARRAY' ? $p : [$p] : [];
    0          
132              
133             # get format string
134 0 0 0     0 $fmt = defined($p->[0]) && ! ref($p->[0]) ? $p->[0] : 'undef';
135              
136             # set string to object ID
137 0         0 $s = sprintf("'%s' object, (0x%x)\n", ref($self), $self);
138              
139             # return
140 0         0 return($s);
141              
142             }
143              
144             # read sig_ tag from ICC profile
145             # parameters: (ref_to_object, ref_to_parent_object, file_handle, ref_to_tag_table_entry)
146             sub _readICCsig_ {
147            
148             # get parameters
149 1     1   3 my ($self, $parent, $fh, $tag) = @_;
150            
151             # local variables
152 1         2 my ($buf);
153            
154             # save tag signature
155 1         2 $self->[0]{'signature'} = $tag->[0];
156            
157             # seek start of tag
158 1         11 seek($fh, $tag->[1], 0);
159            
160             # read tag
161 1         9 read($fh, $buf, 12);
162            
163             # unpack text string
164 1         5 $self->[1] = unpack('x8 a4', $buf);
165            
166             }
167              
168             # write sig_ tag to ICC profile
169             # parameters: (ref_to_object, ref_to_parent_object, file_handle, ref_to_tag_table_entry)
170             sub _writeICCsig_ {
171              
172             # get parameters
173 1     1   3 my ($self, $parent, $fh, $tag) = @_;
174              
175             # seek start of tag
176 1         8 seek($fh, $tag->[1], 0);
177              
178             # write tag
179 1         23 print $fh pack('a4 x4 a4', 'sig ', $self->[1]);
180              
181             }
182              
183             1;