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