File Coverage

blib/lib/Win32/Exe/IconFile.pm
Criterion Covered Total %
statement 34 37 91.8
branch n/a
condition n/a
subroutine 9 10 90.0
pod 0 4 0.0
total 43 51 84.3


line stmt bran cond sub pod time code
1             # Copyright 2004 by Audrey Tang
2              
3             package Win32::Exe::IconFile;
4              
5 4     4   1260 use strict;
  4         7  
  4         185  
6 4     4   21 use base 'Win32::Exe::Base';
  4         8  
  4         1181  
7 4         291 use constant FORMAT => (
8             Magic => 'a2',
9             Type => 'v',
10             Count => 'v',
11             'Resource::Icon' => [ 'a16', '{$Count}', 1 ],
12             Data => 'a*',
13 4     4   23 );
  4         5  
14 4         236 use constant DEFAULT_ARGS => (
15             Magic => "\0\0",
16             Type => 1,
17             Count => 0,
18             Data => '',
19 4     4   21 );
  4         6  
20 4     4   20 use constant DISPATCH_FIELD => 'Magic';
  4         7  
  4         434  
21             use constant DISPATCH_TABLE => (
22             "\0\0" => '',
23             "MZ" => '__BASE__',
24 0         0 '*' => sub { die "Invalid icon file header: $_[1]" },
25 4     4   20 );
  4         7  
  4         1231  
26              
27             sub icons {
28 4     4 0 1457 my $self = shift;
29 4         24 $self->members(@_);
30             }
31              
32             sub set_icons {
33 1     1 0 3 my ($self, $icons) = @_;
34 1         6 $self->SetCount(scalar @$icons);
35 1         11 $self->set_members('Resource::Icon' => $icons);
36 1         98 $self->refresh;
37              
38 1         80 foreach my $idx (0 .. $#{$icons}) {
  1         4  
39 2         53 $self->icons->[$idx]->SetImageOffset(length($self->dump));
40 2         13 $self->SetData( $self->Data . $icons->[$idx]->Data );
41             }
42              
43 1         34 $self->refresh;
44             }
45              
46             sub dump_iconfile {
47 1     1 0 10289 my $self = shift;
48 1         7 my @icons = $self->icons;
49 1         38 my $obj = $self->require_class('IconFile')->new;
50 1         165 $obj->set_icons(\@icons);
51 1         188 return $obj->dump;
52             }
53              
54             sub write_iconfile {
55 0     0 0   my ($self, $filename) = @_;
56 0           $self->write_file($filename, $self->dump_iconfile);
57             }
58              
59             1;