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