polish/test darwin support
[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);
136a3eae 13 $VERSION = '0.009';
967e4c21
TC
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
87cd516f
TC
30 my %opts =
31 (
32 decor => 0,
33 display => 0,
34 left => 0,
35 top => 0,
36 right => 0,
37 bottom => 0,
38 @_);
967e4c21
TC
39
40 my $result;
967e4c21
TC
41 if (defined $opts{hwnd}) {
42 defined &_win32
43 or die "Win32 driver not enabled\n";
87cd516f
TC
44 $result = _win32($opts{hwnd}, $opts{decor}, $opts{left}, $opts{top},
45 $opts{right}, $opts{bottom});
967e4c21
TC
46 }
47 elsif (defined $opts{id}) { # X11 window id
48 defined &_x11
49 or die "X11 driver not enabled\n";
87cd516f
TC
50 $result = _x11($opts{display}, $opts{id}, $opts{left}, $opts{top},
51 $opts{right}, $opts{bottom});
967e4c21 52 }
0cc0b6d7
TC
53 elsif (defined $opts{darwin}) { # as long as it's there
54 defined &_darwin
55 or die "Darwin driver not enabled\n";
56 $result = _darwin($opts{left}, $opts{top}, $opts{right}, $opts{bottom});
57 }
967e4c21
TC
58 elsif ($opts{widget}) {
59 # Perl/Tk widget
60 my $top = $opts{widget}->toplevel;
61 my $sys = $top->windowingsystem;
62 if ($sys eq 'win32') {
63 unless (defined &_win32) {
64 Imager->_set_error("Win32 Tk and Win32 support not built");
65 return;
66 }
87cd516f
TC
67 $result = _win32(hex($opts{widget}->id), $opts{decor},
68 $opts{left}, $opts{top}, $opts{right}, $opts{bottom});
967e4c21
TC
69 }
70 elsif ($sys eq 'x11') {
71 unless (defined &_x11) {
72 Imager->_set_error("X11 Tk and X11 support not built");
73 return;
74 }
75
76 my $id_hex = $opts{widget}->id;
967e4c21
TC
77
78 # is there a way to get the display pointer from Tk?
87cd516f
TC
79 $result = _x11($opts{display}, hex($id_hex), $opts{left}, $opts{top},
80 $opts{right}, $opts{bottom});
967e4c21
TC
81 }
82 else {
83 Imager->_set_error("Unsupported windowing system '$sys'");
84 return;
85 }
86 }
87cd516f
TC
87 else {
88 $result =
89 defined &_win32 ? _win32(0, $opts{decor}, $opts{left}, $opts{top},
90 $opts{right}, $opts{bottom}) :
bc99c241
TC
91 defined &_darwin ? _darwin($opts{left}, $opts{top},
92 $opts{right}, $opts{bottom}) :
93 defined &_x11 ? _x11($opts{display}, 0, $opts{left}, $opts{top},
87cd516f
TC
94 $opts{right}, $opts{bottom}) :
95 die "No drivers enabled\n";
96 }
967e4c21
TC
97
98 unless ($result) {
99 Imager->_set_error(Imager->_error_as_msg());
100 return;
101 }
cd684d4f
TC
102
103 # RT #24992 - the Imager typemap entry is broken pre-0.56, so
104 # wrap it here
105 return bless { IMG => $result }, "Imager";
967e4c21
TC
106}
107
108sub have_win32 {
109 defined &_win32;
110}
111
112sub have_x11 {
113 defined &_x11;
114}
115
0cc0b6d7
TC
116sub have_darwin {
117 defined &_darwin;
118}
119
967e4c21
TC
120sub x11_open {
121 my $display = _x11_open(@_);
122 unless ($display) {
123 Imager->_set_error(Imager->_error_as_msg);
124 return;
125 }
126
127 return $display;
128}
129
130sub x11_close {
131 _x11_close(shift);
132}
133
1341;
135
136__END__
137
138=head1 NAME
139
140Imager::Screenshot - screenshot to an Imager image
141
142=head1 SYNOPSIS
143
144 use Imager::Screenshot 'screenshot';
145
146 # whole screen
147 my $img = screenshot();
148
149 # Win32 window
150 my $img2 = screenshot(hwnd => $hwnd);
151
152 # X11 window
153 my $img3 = screenshot(display => $display, id => $window_id);
154
155 # X11 tools
156 my $display = Imager::Screenshot::x11_open();
157 Imager::Screenshot::x11_close($display);
158
159 # test for win32 support
160 if (Imager::Screenshot->have_win32) { ... }
161
162 # test for x11 support
163 if (Imager::Screenshot->have_x11) { ... }
164
0cc0b6d7
TC
165 # test for Darwin (Mac OS X) support
166 if (Imager::Screenshot->have_darwin) { ... }
167
967e4c21
TC
168
169=head1 DESCRIPTION
170
171Imager::Screenshot captures either a desktop or a specified window and
172returns the result as an Imager image.
173
174Currently the image is always returned as a 24-bit image.
175
176=over
177
178=item screenshot hwnd => I<window handle>
179
180=item screenshot hwnd => I<window handle>, decor => <capture decorations>
181
182Retrieve a screenshot under Win32, if I<window handle> is zero,
183capture the desktop.
184
185By default, window decorations are not captured, if the C<decor>
186parameter is set to true then window decorations are included.
187
188=item screenshot id => I<window id>
189
190=item screenshot id => I<window id>, display => I<display object>
191
192Retrieve a screenshot under X11, if I<id> is zero, capture the root
193window. I<display object> is a integer version of an X11 C< Display *
194>, if this isn't supplied C<screenshot()> will attempt connect to the
195the display specified by $ENV{DISPLAY}.
196
f04a72ea
TC
197Note: taking a screenshot of a remote display is slow.
198
0cc0b6d7
TC
199=item screenshot darwin => 0
200
201Retrieve a screenshot under Mac OS X. The only supported value for
202the C<darwin> parameter is C<0>.
203
204For a screen capture to be taken, the current user using
205Imager:Screenshot must be the currently logged in user on the display.
206
207If you're using fast user switching, the current user must be the
208active user.
209
210Note: this means you can ssh into a Mac OS X box and screenshot from
211the ssh session, if you're the current user on the display.
212
9d2a775a
TC
213=item screenshot widget => I<widget>
214
215=item screenshot widget => I<widget>, display => I<display>
216
217=item screenshot widget => I<widget>, decor => I<capture decorations>
218
219Retrieve a screenshot of a Tk widget, under Win32 or X11, depending on
220how Tk has been built.
221
222If Tk was built for X11 then the display parameter applies.
223
224If Tk was built for Win32 then the decor parameter applies.
225
967e4c21
TC
226=item screenshot
227
9d2a775a 228If no C<id>, C<hwnd> or C<widget> parameter is supplied:
967e4c21
TC
229
230=over
231
232=item *
233
234if Win32 support is compiled, return screenshot(hwnd => 0).
235
236=item *
237
0cc0b6d7
TC
238if Darwin support is compiled, return screenshot(darwin => 0).
239
240=item *
241
967e4c21
TC
242if X11 support is compiled, return screenshot(id => 0).
243
244=item *
245
246otherwise, die.
247
248=back
249
87cd516f
TC
250You can also supply the following parameters to retrieve a subset of
251the window:
252
253=over
254
255=item *
256
257left
258
259=item *
260
261top
262
263=item *
264
265right
266
267=item *
268
269bottom
270
271=back
272
273If left or top is negative, then treat that as from the right/bottom
274edge of the window.
275
276If right ot bottom is zero or negative then treat as from the
277right/bottom edge of the window.
278
279So setting all 4 values to 0 retrieves the whole window.
280
281 # a 10-pixel wide right edge of the window
282 my $right_10 = screenshot(left => -10, ...);
283
284 # the top-left 100x100 portion of the window
285 my $topleft_100 = screenshot(right => 100, bottom => 100, ...);
286
287 # 10x10 pixel at the bottom right corner
288 my $bott_right_10 = screenshot(left => -10, top => -10, ...);
289
06bbf244
TC
290If screenshot() fails, it will return nothing, and the cause of the
291failure can be retrieved via Imager->errstr, so typical use could be:
292
293 my $img = screenshot(...) or die Imager->errstr;
294
967e4c21
TC
295=item have_win32
296
297Returns true if Win32 support is available.
298
299=item have_x11
300
301Returns true if X11 support is available.
302
0cc0b6d7
TC
303=item have_darwin
304
305Returns true if Darwin support is available.
306
967e4c21
TC
307=item Imager::Screenshot::x11_open
308
309=item Imager::Screenshot::x11_open I<display name>
310
311Attempts to open a connection to either the display name in
312$ENV{DISPLAY} or the supplied display name. Returns a value suitable
313for the I<display> parameter of screenshot, or undef.
314
315=item Imager::Screenshot::x11_close I<display>
316
317Closes a display returned by Imager::Screenshot::x11_open().
318
319=back
320
62b84c46
TC
321=head1 TAGS
322
323screenshot() sets a number of tags in the images it returns, these are:
324
325=over
326
327=item *
328
329ss_left - the distance between the left side of the window and the
330left side of the captured area. The same value as the I<left>
331parameter when that is positive.
332
333=item *
334
335ss_top - the distance between the top side of the window the top side
336of the captured area. The same value at the I<top> parameter when
337that is positive.
338
339=item *
340
341ss_window_width - the full width of the window.
342
343=item *
344
345ss_window_height - the full height of the window.
346
347=item *
348
349ss_type - the type of capture done, either "Win32" or "X11".
350
351=back
352
353To cheaply get the window size you can capture a single pixel:
354
355 my $im = screenshot(right => 1, bottom => 1);
356 my $window_width = $im->tags(name => 'ss_window_width');
357 my $window_height = $im->tags(name => 'ss_window_height');
358
87cd516f
TC
359=head1 CAVEATS
360
361It's possible to have more than one grab driver available, for
362example, Win32 and X11, and which is used can have an effect on the
363result.
364
0cc0b6d7
TC
365Under Win32 or OS X, if there's a screesaver running, then you grab
366the results of the screensaver.
367
368On OS X, you can grab the display from an ssh session as long as the
369ssh session is under the same user as the currently active user on the
370display.
87cd516f
TC
371
372Grabbing the root window on a rootless server (eg. Cygwin/X) may not
62b84c46
TC
373grab the background that you see. In fact, when I tested under
374Cygwin/X I got the xterm window contents even when the Windows
375screensaver was running. The root window captured appeared to be that
376generated by my window manager.
87cd516f 377
54f11a66
TC
378Grabbing a window with other windows overlaying it will capture the
379content of those windows where they hide the window you want to
380capture. You may want to raise the window to top. This may be a
381security concern if the overlapping windows contain any sensitive
382information - true for any screen capture.
383
967e4c21
TC
384=head1 LICENSE
385
386Imager::Screenshot is licensed under the same terms as Perl itself.
387
33f803d8
TC
388=head1 TODO
389
390Future plans include:
391
392=over
393
394=item *
395
33f803d8
TC
396window name searches - currently screenshot() requires a window
397identifier of some sort, it would be more usable if we could supply
398some other identifier, either a window title or a window class name.
399
400=back
401
967e4c21
TC
402=head1 AUTHOR
403
404Tony Cook <tonyc@cpan.org>
405
406=cut
407
408