fix a memory leak when failing to write a 2 color icon image
[imager.git] / ICO / ICO.pm
1 package Imager::File::ICO;
2 use strict;
3 use Imager;
4 use vars qw($VERSION @ISA);
5
6 BEGIN {
7   $VERSION = "0.05";
8   
9   require XSLoader;
10   XSLoader::load('Imager::File::ICO', $VERSION);
11 }
12
13 Imager->register_reader
14   (
15    type=>'ico',
16    single => 
17    sub { 
18      my ($im, $io, %hsh) = @_;
19      my $masked = 
20        exists $hsh{ico_masked} ? $hsh{ico_masked} : 1;
21      my $alpha_masked =
22        exists $hsh{ico_alpha_masked} ? $hsh{ico_alpha_masked} : 0;
23
24      $im->{IMG} = i_readico_single($io, $hsh{page} || 0, $masked,
25                                    $alpha_masked);
26
27      unless ($im->{IMG}) {
28        $im->_set_error(Imager->_error_as_msg);
29        return;
30      }
31      return $im;
32    },
33    multiple =>
34    sub {
35      my ($io, %hsh) = @_;
36      
37      my $masked = 
38        exists $hsh{ico_masked} ? $hsh{ico_masked} : 1;
39      my @imgs = i_readico_multi($io, $masked);
40      unless (@imgs) {
41        Imager->_set_error(Imager->_error_as_msg);
42        return;
43      }
44      return map { 
45        bless { IMG => $_, DEBUG => $Imager::DEBUG, ERRSTR => undef }, 'Imager'
46      } @imgs;
47    },
48   );
49
50 # the readers can read CUR files too
51 Imager->register_reader
52   (
53    type=>'cur',
54    single => 
55    sub { 
56      my ($im, $io, %hsh) = @_;
57      my $masked = 
58        exists $hsh{ico_masked} ? $hsh{ico_masked} : 1;
59      my $alpha_masked =
60        exists $hsh{ico_alpha_masked} ? $hsh{ico_alpha_masked} : 0;
61      $im->{IMG} = i_readico_single($io, $hsh{page} || 0, $masked,
62                                    $alpha_masked);
63
64      unless ($im->{IMG}) {
65        $im->_set_error(Imager->_error_as_msg);
66        return;
67      }
68      return $im;
69    },
70    multiple =>
71    sub {
72      my ($io, %hsh) = @_;
73      
74      my $masked = 
75        exists $hsh{ico_masked} ? $hsh{ico_masked} : 1;
76      my @imgs = i_readico_multi($io, $masked);
77      unless (@imgs) {
78        Imager->_set_error(Imager->_error_as_msg);
79        return;
80      }
81      return map { 
82        bless { IMG => $_, DEBUG => $Imager::DEBUG, ERRSTR => undef }, 'Imager'
83      } @imgs;
84    },
85   );
86
87 Imager->register_writer
88   (
89    type=>'ico',
90    single => 
91    sub { 
92      my ($im, $io, %hsh) = @_;
93
94      unless (i_writeico_wiol($io, $im->{IMG})) {
95        $im->_set_error(Imager->_error_as_msg);
96        return;
97      }
98      return $im;
99    },
100    multiple =>
101    sub {
102      my ($class, $io, $opts, @images) = @_;
103
104      if (!i_writeico_multi_wiol($io, map $_->{IMG}, @images)) {
105        Imager->_set_error(Imager->_error_as_msg);
106        return;
107      }
108
109      return 1;
110    },
111   );
112
113 Imager->register_writer
114   (
115    type=>'cur',
116    single => 
117    sub { 
118      my ($im, $io, %hsh) = @_;
119
120      unless (i_writecur_wiol($io, $im->{IMG})) {
121        $im->_set_error(Imager->_error_as_msg);
122        return;
123      }
124      return $im;
125    },
126    multiple =>
127    sub {
128      my ($class, $io, $opts, @images) = @_;
129
130      if (!i_writecur_multi_wiol($io, map $_->{IMG}, @images)) {
131        Imager->_set_error(Imager->_error_as_msg);
132        return;
133      }
134
135      return 1;
136    },
137   );
138
139 1;
140
141 __END__
142
143 =head1 NAME
144
145 Imager::File::ICO - read MS Icon files
146
147 =head1 SYNOPSIS
148
149   use Imager;
150
151   my $img = Imager->new;
152   $img->read(file=>"foo.ico")
153     or die $img->errstr;
154
155   my @imgs = Imager->read_multi(file => "foo.ico")
156     or die Imager->errstr;
157
158   $img->write(file => "foo.ico")
159     or die $img->errstr;
160
161   Imager->write_multi({ file => "foo.ico" }, @imgs)
162     or die Imager->errstr;
163
164 =head1 DESCRIPTION
165
166 Imager's MS Icon support is documented in L<Imager::Files>.
167
168 =head1 AUTHOR
169
170 Tony Cook <tonyc@cpan.org>
171
172 =head1 SEE ALSO
173
174 Imager, Imager::Files.
175
176 =cut