File: IconFile.pm

package info (click to toggle)
libwin32-exe-perl 0.17-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 472 kB
  • sloc: perl: 3,679; xml: 38; makefile: 11
file content (59 lines) | stat: -rw-r--r-- 1,272 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
# Copyright 2004 by Audrey Tang <cpan@audreyt.org>

package Win32::Exe::IconFile;

use strict;
use base 'Win32::Exe::Base';
use constant FORMAT => (
    Magic		=> 'a2',
    Type		=> 'v',
    Count		=> 'v',
    'Resource::Icon'	=> [ 'a16', '{$Count}', 1 ],
    Data		=> 'a*',
);
use constant DEFAULT_ARGS => (
    Magic   => "\0\0",
    Type    => 1,
    Count   => 0,
    Data    => '',
);
use constant DISPATCH_FIELD => 'Magic';
use constant DISPATCH_TABLE => (
    "\0\0"  => '',
    "MZ"    => '__BASE__',
    '*'	    => sub { die "Invalid icon file header: $_[1]" },
);

sub icons {
    my $self = shift;
    $self->members(@_);
}

sub set_icons {
    my ($self, $icons) = @_;
    $self->SetCount(scalar @$icons);
    $self->set_members('Resource::Icon' => $icons);
    $self->refresh;

    foreach my $idx (0 .. $#{$icons}) {
	$self->icons->[$idx]->SetImageOffset(length($self->dump));
	$self->SetData( $self->Data . $icons->[$idx]->Data );
    }

    $self->refresh;
}

sub dump_iconfile {
    my $self = shift;
    my @icons = $self->icons;
    my $obj = $self->require_class('IconFile')->new;
    $obj->set_icons(\@icons);
    return $obj->dump;
}

sub write_iconfile {
    my ($self, $filename) = @_;
    $self->write_file($filename, $self->dump_iconfile);
}

1;