File Coverage

blib/lib/Image/XWD.pm
Criterion Covered Total %
statement 22 186 11.8
branch 0 38 0.0
condition 0 36 0.0
subroutine 8 15 53.3
pod 6 7 85.7
total 36 282 12.7


line stmt bran cond sub pod time code
1             package Image::XWD;
2              
3             #
4             # Based on /usr/include/X11/XWDFile.h
5             #
6              
7 1     1   22331 use 5.008008;
  1         4  
  1         34  
8 1     1   6 use strict;
  1         1  
  1         30  
9 1     1   4 use warnings;
  1         6  
  1         87  
10              
11             require Exporter;
12              
13             our @ISA = qw(Exporter);
14             our @EXPORT_OK = ();
15             our @EXPORT = ();
16              
17             our $VERSION = '0.01';
18              
19 1     1   5 use constant XWD_FILE_VERSION => 7;
  1         2  
  1         86  
20 1     1   4 use constant SIZEOF_XWD_HEADER => 25*4;
  1         2  
  1         37  
21              
22 1     1   4 use constant XWD_PIXMAP_FORMAT_XYPIXMAP => 1;
  1         2  
  1         36  
23 1     1   4 use constant XWD_PIXMAP_FORMAT_ZPIXMAP => 2;
  1         2  
  1         2162  
24              
25             sub new {
26 0     0 1   my $class = shift;
27 0           my $self = bless {}, $class;
28              
29 0           return $self->init(@_);
30             }
31              
32             sub init {
33 0     0 0   my $self = shift;
34 0           my %args = @_;
35              
36 0           return $self;
37             }
38              
39             sub read_file($$) {
40 0     0 1   my $self = shift;
41 0           my ($fname) = @_;
42              
43 0           my ($raw_data);
44              
45             my ($header_size);
46 0           my ($file_version);
47 0           my ($pixmap_format);
48 0           my ($pixmap_depth);
49 0           my ($pixmap_width);
50 0           my ($pixmap_heigth);
51 0           my ($xoffset);
52 0           my ($byte_order);
53 0           my ($bitmap_unit);
54 0           my ($bitmap_bit_order);
55 0           my ($bitmap_pad);
56 0           my ($bits_per_pixel);
57 0           my ($bytes_per_line);
58 0           my ($visual_class);
59 0           my ($red_mask);
60 0           my ($green_mask);
61 0           my ($blue_mask);
62 0           my ($bits_per_rgb);
63 0           my ($colormap_entries);
64 0           my ($ncolors);
65 0           my ($window_width);
66 0           my ($window_heigth);
67 0           my ($window_x);
68 0           my ($window_y);
69 0           my ($window_bdrwidth);
70 0           my ($window_name);
71              
72 0 0         open(F, "<$fname") or return undef;
73              
74 0           my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
75             $atime,$mtime,$ctime,$blksize,$blocks)
76             = stat(F);
77              
78 0           print("file size is: $size bytes\n");
79              
80             # read the first element of the XWDHeader
81 0           read(F, $header_size, 4);
82 0           $header_size = unpack('N', $header_size);
83 0           print("XWDFileHeader.header_size=$header_size\n");
84              
85 0 0         if ($header_size < SIZEOF_XWD_HEADER) {
86            
87             }
88              
89             # read the rest of the XWDHeader
90 0           read(F, $raw_data, SIZEOF_XWD_HEADER-4);
91            
92 0           ($file_version,
93             $pixmap_format,
94             $pixmap_depth,
95             $pixmap_width,
96             $pixmap_heigth,
97             $xoffset,
98             $byte_order,
99             $bitmap_unit,
100             $bitmap_bit_order,
101             $bitmap_pad,
102             $bits_per_pixel,
103             $bytes_per_line,
104             $visual_class,
105             $red_mask,
106             $green_mask,
107             $blue_mask,
108             $bits_per_rgb,
109             $colormap_entries,
110             $ncolors,
111             $window_width,
112             $window_heigth,
113             $window_x,
114             $window_y,
115             $window_bdrwidth) = unpack('N'.SIZEOF_XWD_HEADER, $raw_data);
116              
117 0 0         if ($file_version != XWD_FILE_VERSION) {
118 0           printf(STDERR __PACKAGE__.": Unknown file_version: 0x%8.8X\n", $file_version);
119 0           close(F);
120 0           return undef;
121             }
122 0 0         if ($pixmap_format == XWD_PIXMAP_FORMAT_XYPIXMAP) {
    0          
123 0           printf(STDERR __PACKAGE__.": pixmap_format=XYPixmap is not supported, yet. Sorry.\n");
124 0           close(F);
125 0           return undef;
126              
127             } elsif ($pixmap_format == XWD_PIXMAP_FORMAT_ZPIXMAP) {
128 0 0         if ($pixmap_depth != 24) {
129 0           printf(STDERR __PACKAGE__.": Only pixmap_depth=24 is supported, sorry. (pixmap_depth=$pixmap_depth)\n");
130 0           close(F);
131 0           return undef;
132             }
133 0 0 0       if ($byte_order != 0 && $byte_order != 1) {
134 0           printf(STDERR __PACKAGE__.": Only byte_order=0 is supported, sorry. (byte_order=$byte_order)\n");
135 0           close(F);
136 0           return undef;
137             }
138 0 0         if ($bitmap_unit != 32) {
139 0           printf(STDERR __PACKAGE__.": Only bitmap_unit=32 is supported, sorry. (bitmap_unit=$bitmap_unit)\n");
140 0           close(F);
141 0           return undef;
142             }
143 0 0 0       if ($bitmap_bit_order != 0 && $bitmap_bit_order != 1) {
144 0           printf(STDERR __PACKAGE__.": Only bitmap_bit_order={0,1} is supported, sorry. (bitmap_bit_order=$bitmap_bit_order)\n");
145 0           close(F);
146 0           return undef;
147             }
148 0 0         if ($bitmap_pad != 32) {
149 0           printf(STDERR __PACKAGE__.": Only bitmap_pad=32 is supported, sorry. (bitmap_pad=$bitmap_pad)\n");
150 0           close(F);
151 0           return undef;
152             }
153 0 0 0       if ($bits_per_pixel != 24 && $bits_per_pixel != 32) {
154 0           printf(STDERR __PACKAGE__.": Only bits_per_pixel={24,32} is supported, sorry. (bits_per_pixel=$bits_per_pixel)\n");
155 0           close(F);
156 0           return undef;
157             }
158 0 0 0       if ($visual_class != 4 && $visual_class != 5) {
159 0           printf(STDERR __PACKAGE__.": Only visual_class={4,5} is supported, sorry. (visual_class=$visual_class)\n");
160 0           close(F);
161 0           return undef;
162             }
163 0 0         if ($red_mask != 0x00FF0000) {
164 0           printf(STDERR __PACKAGE__.": Only red_mask=0x00FF0000 is supported, sorry. (red_mask=%8.8X)\n", $red_mask);
165 0           close(F);
166 0           return undef;
167             }
168 0 0         if ($green_mask != 0x0000FF00) {
169 0           printf(STDERR __PACKAGE__.": Only green_mask=0x0000FF00 is supported, sorry. (green_mask=%8.8X)\n", $green_mask);
170 0           close(F);
171 0           return undef;
172             }
173 0 0         if ($blue_mask != 0x000000FF) {
174 0           printf(STDERR __PACKAGE__.": Only blue_mask=0x000000FF is supported, sorry. (blue_mask=%8.8X)\n", $blue_mask);
175 0           close(F);
176 0           return undef;
177             }
178 0 0         if ($bits_per_rgb != 8) {
179 0           printf(STDERR __PACKAGE__.": Only bits_per_rgb=8 is supported, sorry. (bits_per_rgb=$bits_per_rgb)\n");
180 0           close(F);
181 0           return undef;
182             }
183              
184             } else {
185 0           printf(STDERR __PACKAGE__.": Unknown pixmap_format: 0x%8.8X\n", $pixmap_format);
186 0           close(F);
187 0           return undef;
188             }
189              
190 0           $self->{'file_version'} = $file_version;
191 0           $self->{'pixmap_format'} = $pixmap_format;
192 0           $self->{'pixmap_depth'} = $pixmap_depth;
193 0           $self->{'pixmap_width'} = $pixmap_width;
194 0           $self->{'pixmap_heigth'} = $pixmap_heigth;
195 0           $self->{'xoffset'} = $xoffset;
196 0           $self->{'byte_order'} = $byte_order;
197 0           $self->{'bitmap_unit'} = $bitmap_unit;
198 0           $self->{'bitmap_bit_order'} = $bitmap_bit_order;
199 0           $self->{'bitmap_pad'} = $bitmap_pad;
200 0           $self->{'bits_per_pixel'} = $bits_per_pixel;
201 0           $self->{'bytes_per_line'} = $bytes_per_line;
202 0           $self->{'visual_class'} = $visual_class;
203 0           $self->{'red_mask'} = $red_mask;
204 0           $self->{'green_mask'} = $green_mask;
205 0           $self->{'blue_mask'} = $blue_mask;
206 0           $self->{'bits_per_rgb'} = $bits_per_rgb;
207 0           $self->{'colormap_entries'} = $colormap_entries;
208 0           $self->{'ncolors'} = $ncolors;
209 0           $self->{'window_width'} = $window_width;
210 0           $self->{'window_heigth'} = $window_heigth;
211 0           $self->{'window_x'} = $window_x;
212 0           $self->{'window_y'} = $window_y;
213 0           $self->{'window_bdrwidth'} = $window_bdrwidth;
214              
215 0 0         if (0 < $header_size - SIZEOF_XWD_HEADER) {
216             # read window_name
217 0           read(F, $raw_data, $header_size - SIZEOF_XWD_HEADER);
218 0           $window_name = unpack('Z*', $raw_data);
219             } else {
220             # No window_name
221 0           $window_name = undef;
222             }
223              
224 0           $self->{'window_name'} = $window_name;
225              
226 0           my (@colors);
227             my ($pixel);
228 0           my ($red);
229 0           my ($green);
230 0           my ($blue);
231 0           my ($flags);
232 0           my ($pad);
233 0           my ($i);
234              
235 0           for ($i=0; $i<$ncolors; $i++) {
236             # read one XWDColor structure
237 0           read(F, $raw_data, 12);
238 0           ($pixel,
239             $red,
240             $green,
241             $blue,
242             $flags,
243             $pad) = unpack("NnnnCC", $raw_data);
244              
245 0           $self->{"colors[$i]"} = { 'pixel' => $pixel,
246             'red' => $red,
247             'green' => $green,
248             'blue' => $blue,
249             'flags' => $flags,
250             'pad' => $pad
251             };
252            
253             }
254              
255 0           my (@row);
256 0           my ($x, $y);
257 0           my ($r, $g, $b);
258 0           my (%pixel_code);
259 0           for ($y=0; $y<$pixmap_heigth; $y++) {
260             # read one complete line at once
261 0           read(F, $raw_data, $bytes_per_line);
262              
263             # store the raw data to save memory
264 0           push(@{$self->{"pixel"}}, $raw_data);
  0            
265             }
266              
267 0           close(F);
268              
269 0           return 1;
270             }
271              
272             sub get_width($) {
273 0     0 1   my ($self) = shift;
274              
275 0           return $self->{'pixmap_width'};
276             }
277              
278             sub get_heigth($) {
279 0     0 1   my ($self) = shift;
280            
281 0           return $self->{'pixmap_heigth'};
282             }
283              
284             sub get_window_name($) {
285 0     0 1   my ($self) = shift;
286              
287 0           return $self->{'window_name'};
288             }
289              
290             sub xy_rgb($$$) {
291 0     0 1   my ($self) = shift;
292 0           my ($x, $y) = @_;
293 0           my ($pixel);
294 0           my ($r, $g, $b);
295              
296 0 0 0       if ($self->{'bitmap_bit_order'} == 1 &&
    0 0        
      0        
      0        
      0        
      0        
      0        
      0        
297             $self->{'bits_per_pixel'} == 24 &&
298             $self->{'red_mask'} == 0x00FF0000 &&
299             $self->{'green_mask'} == 0x0000FF00 &&
300             $self->{'blue_mask'} == 0x000000FF
301             ) {
302 0           ($r, $g, $b) = unpack('C*',
303             substr($self->{"pixel"}->[$y], $x * ($self->{'bits_per_pixel'}/8),
304             $self->{'bits_per_pixel'}/8))
305              
306             } elsif ($self->{'bitmap_bit_order'} == 0 &&
307             $self->{'bits_per_pixel'} == 32 &&
308             $self->{'red_mask'} == 0x00FF0000 &&
309             $self->{'green_mask'} == 0x0000FF00 &&
310             $self->{'blue_mask'} == 0x000000FF) {
311              
312 0           my ($dummy);
313              
314 0           ($r, $g, $b, $dummy) = unpack('C*',
315             substr($self->{"pixel"}->[$y], $x * ($self->{'bits_per_pixel'}/8),
316             $self->{'bits_per_pixel'}/8))
317              
318             } else {
319 0           print(STDERR __PACKAGE__.": Image format not supported, sorry.\n");
320             }
321              
322 0           return ($r, $g, $b);
323             }
324              
325 1     1   7 END {
326             # Cleanup code
327             }
328              
329             1;
330             __END__