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