various distribution fixes:
[imager-screenshot.git] / Screenshot.pm
CommitLineData
967e4c21
TC
1package Imager::Screenshot;
2use strict;
3use vars qw(@ISA $VERSION @EXPORT_OK);
4use Imager;
5require Exporter;
6
7push @ISA, 'Exporter';
8@EXPORT_OK = 'screenshot';
9
10BEGIN {
11 require Exporter;
12 @ISA = qw(Exporter);
13 $VERSION = '0.001';
14 eval {
15 # try XSLoader first, DynaLoader has annoying baggage
16 require XSLoader;
17 XSLoader::load('Imager::Screenshot' => $VERSION);
18 1;
19 } or do {
20 require DynaLoader;
21 push @ISA, 'DynaLoader';
22 bootstrap Imager::Screenshot $VERSION;
23 }
24}
25
26sub screenshot {
27 # lose the class if called as a method
28 @_ % 2 == 1 and shift;
29
30 my %opts = (decor => 0, display => 0, @_);
31
32 my $result;
33 if (!@_) {
34 my $result =
35 defined &_win32 ? _win32(0) :
36 defined &_x11 ? _x11($opts{display}, 0) :
37 die "No drivers enabled\n";
38 }
39 if (defined $opts{hwnd}) {
40 defined &_win32
41 or die "Win32 driver not enabled\n";
42 $result = _win32($opts{hwnd}, $opts{decor});
43 }
44 elsif (defined $opts{id}) { # X11 window id
45 defined &_x11
46 or die "X11 driver not enabled\n";
47 $result = _x11($opts{display}, $opts{id});
48 }
49 elsif ($opts{widget}) {
50 # Perl/Tk widget
51 my $top = $opts{widget}->toplevel;
52 my $sys = $top->windowingsystem;
53 if ($sys eq 'win32') {
54 unless (defined &_win32) {
55 Imager->_set_error("Win32 Tk and Win32 support not built");
56 return;
57 }
58 $result = _win32(hex($opts{widget}->id));
59 }
60 elsif ($sys eq 'x11') {
61 unless (defined &_x11) {
62 Imager->_set_error("X11 Tk and X11 support not built");
63 return;
64 }
65
66 my $id_hex = $opts{widget}->id;
67 $opts{widget}->can('frame')
68 and $id_hex = $opts{widget}->frame;
69
70 # is there a way to get the display pointer from Tk?
71 $result = _x11(0, hex($id_hex));
72 }
73 else {
74 Imager->_set_error("Unsupported windowing system '$sys'");
75 return;
76 }
77 }
78
79 unless ($result) {
80 Imager->_set_error(Imager->_error_as_msg());
81 return;
82 }
83
84 return $result;
85}
86
87sub have_win32 {
88 defined &_win32;
89}
90
91sub have_x11 {
92 defined &_x11;
93}
94
95sub x11_open {
96 my $display = _x11_open(@_);
97 unless ($display) {
98 Imager->_set_error(Imager->_error_as_msg);
99 return;
100 }
101
102 return $display;
103}
104
105sub x11_close {
106 _x11_close(shift);
107}
108
1091;
110
111__END__
112
113=head1 NAME
114
115Imager::Screenshot - screenshot to an Imager image
116
117=head1 SYNOPSIS
118
119 use Imager::Screenshot 'screenshot';
120
121 # whole screen
122 my $img = screenshot();
123
124 # Win32 window
125 my $img2 = screenshot(hwnd => $hwnd);
126
127 # X11 window
128 my $img3 = screenshot(display => $display, id => $window_id);
129
130 # X11 tools
131 my $display = Imager::Screenshot::x11_open();
132 Imager::Screenshot::x11_close($display);
133
134 # test for win32 support
135 if (Imager::Screenshot->have_win32) { ... }
136
137 # test for x11 support
138 if (Imager::Screenshot->have_x11) { ... }
139
140
141=head1 DESCRIPTION
142
143Imager::Screenshot captures either a desktop or a specified window and
144returns the result as an Imager image.
145
146Currently the image is always returned as a 24-bit image.
147
148=over
149
150=item screenshot hwnd => I<window handle>
151
152=item screenshot hwnd => I<window handle>, decor => <capture decorations>
153
154Retrieve a screenshot under Win32, if I<window handle> is zero,
155capture the desktop.
156
157By default, window decorations are not captured, if the C<decor>
158parameter is set to true then window decorations are included.
159
160=item screenshot id => I<window id>
161
162=item screenshot id => I<window id>, display => I<display object>
163
164Retrieve a screenshot under X11, if I<id> is zero, capture the root
165window. I<display object> is a integer version of an X11 C< Display *
166>, if this isn't supplied C<screenshot()> will attempt connect to the
167the display specified by $ENV{DISPLAY}.
168
f04a72ea
TC
169Note: taking a screenshot of a remote display is slow.
170
967e4c21
TC
171=item screenshot
172
173If no parameters are supplied:
174
175=over
176
177=item *
178
179if Win32 support is compiled, return screenshot(hwnd => 0).
180
181=item *
182
183if X11 support is compiled, return screenshot(id => 0).
184
185=item *
186
187otherwise, die.
188
189=back
190
191=item have_win32
192
193Returns true if Win32 support is available.
194
195=item have_x11
196
197Returns true if X11 support is available.
198
199=item Imager::Screenshot::x11_open
200
201=item Imager::Screenshot::x11_open I<display name>
202
203Attempts to open a connection to either the display name in
204$ENV{DISPLAY} or the supplied display name. Returns a value suitable
205for the I<display> parameter of screenshot, or undef.
206
207=item Imager::Screenshot::x11_close I<display>
208
209Closes a display returned by Imager::Screenshot::x11_open().
210
211=back
212
213=head1 LICENSE
214
215Imager::Screenshot is licensed under the same terms as Perl itself.
216
217=head1 AUTHOR
218
219Tony Cook <tonyc@cpan.org>
220
221=cut
222
223