polish/test darwin support
[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';
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});
46   }
47   elsif (defined $opts{id}) { # X11 window id
48     defined &_x11
49       or die "X11 driver not enabled\n";
50     $result = _x11($opts{display}, $opts{id}, $opts{left}, $opts{top},
51                    $opts{right}, $opts{bottom});
52   }
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   }
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       }
67       $result = _win32(hex($opts{widget}->id), $opts{decor}, 
68                        $opts{left}, $opts{top}, $opts{right}, $opts{bottom});
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;
77       
78       # is there a way to get the display pointer from Tk?
79       $result = _x11($opts{display}, hex($id_hex), $opts{left}, $opts{top},
80                      $opts{right}, $opts{bottom});
81     }
82     else {
83       Imager->_set_error("Unsupported windowing system '$sys'");
84       return;
85     }
86   }
87   else {
88     $result =
89       defined &_win32 ? _win32(0, $opts{decor}, $opts{left}, $opts{top},
90                                $opts{right}, $opts{bottom}) :
91       defined &_darwin ? _darwin($opts{left}, $opts{top},
92                                  $opts{right}, $opts{bottom}) :
93       defined &_x11 ? _x11($opts{display}, 0, $opts{left}, $opts{top},
94                              $opts{right}, $opts{bottom}) :
95            die "No drivers enabled\n";
96   }
97
98   unless ($result) {
99     Imager->_set_error(Imager->_error_as_msg());
100     return;
101   }
102
103   # RT #24992 - the Imager typemap entry is broken pre-0.56, so
104   # wrap it here
105   return bless { IMG => $result }, "Imager";
106 }
107
108 sub have_win32 {
109   defined &_win32;
110 }
111
112 sub have_x11 {
113   defined &_x11;
114 }
115
116 sub have_darwin {
117   defined &_darwin;
118 }
119
120 sub 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
130 sub x11_close {
131   _x11_close(shift);
132 }
133
134 1;
135
136 __END__
137
138 =head1 NAME
139
140 Imager::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   
165   # test for Darwin (Mac OS X) support
166   if (Imager::Screenshot->have_darwin) { ... }
167   
168
169 =head1 DESCRIPTION
170
171 Imager::Screenshot captures either a desktop or a specified window and
172 returns the result as an Imager image.
173
174 Currently 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
182 Retrieve a screenshot under Win32, if I<window handle> is zero,
183 capture the desktop.
184
185 By default, window decorations are not captured, if the C<decor>
186 parameter 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
192 Retrieve a screenshot under X11, if I<id> is zero, capture the root
193 window.  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
195 the display specified by $ENV{DISPLAY}.
196
197 Note: taking a screenshot of a remote display is slow.
198
199 =item screenshot darwin => 0
200
201 Retrieve a screenshot under Mac OS X.  The only supported value for
202 the C<darwin> parameter is C<0>.
203
204 For a screen capture to be taken, the current user using
205 Imager:Screenshot must be the currently logged in user on the display.
206
207 If you're using fast user switching, the current user must be the
208 active user.
209
210 Note: this means you can ssh into a Mac OS X box and screenshot from
211 the ssh session, if you're the current user on the display.
212
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
219 Retrieve a screenshot of a Tk widget, under Win32 or X11, depending on
220 how Tk has been built.
221
222 If Tk was built for X11 then the display parameter applies.
223
224 If Tk was built for Win32 then the decor parameter applies.
225
226 =item screenshot
227
228 If no C<id>, C<hwnd> or C<widget> parameter is supplied:
229
230 =over
231
232 =item *
233
234 if Win32 support is compiled, return screenshot(hwnd => 0).
235
236 =item *
237
238 if Darwin support is compiled, return screenshot(darwin => 0).
239
240 =item *
241
242 if X11 support is compiled, return screenshot(id => 0).
243
244 =item *
245
246 otherwise, die.
247
248 =back
249
250 You can also supply the following parameters to retrieve a subset of
251 the window:
252
253 =over
254
255 =item *
256
257 left
258
259 =item *
260
261 top
262
263 =item *
264
265 right
266
267 =item *
268
269 bottom
270
271 =back
272
273 If left or top is negative, then treat that as from the right/bottom
274 edge of the window.
275
276 If right ot bottom is zero or negative then treat as from the
277 right/bottom edge of the window.
278
279 So 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
290 If screenshot() fails, it will return nothing, and the cause of the
291 failure can be retrieved via Imager->errstr, so typical use could be:
292
293   my $img = screenshot(...) or die Imager->errstr;
294
295 =item have_win32
296
297 Returns true if Win32 support is available.
298
299 =item have_x11
300
301 Returns true if X11 support is available.
302
303 =item have_darwin
304
305 Returns true if Darwin support is available.
306
307 =item Imager::Screenshot::x11_open
308
309 =item Imager::Screenshot::x11_open I<display name>
310
311 Attempts to open a connection to either the display name in
312 $ENV{DISPLAY} or the supplied display name.  Returns a value suitable
313 for the I<display> parameter of screenshot, or undef.
314
315 =item Imager::Screenshot::x11_close I<display>
316
317 Closes a display returned by Imager::Screenshot::x11_open().
318
319 =back
320
321 =head1 TAGS
322
323 screenshot() sets a number of tags in the images it returns, these are:
324
325 =over
326
327 =item *
328
329 ss_left - the distance between the left side of the window and the
330 left side of the captured area.  The same value as the I<left>
331 parameter when that is positive.
332
333 =item *
334
335 ss_top - the distance between the top side of the window the top side
336 of the captured area.  The same value at the I<top> parameter when
337 that is positive.
338
339 =item *
340
341 ss_window_width - the full width of the window.
342
343 =item *
344
345 ss_window_height - the full height of the window.
346
347 =item *
348
349 ss_type - the type of capture done, either "Win32" or "X11".
350
351 =back
352
353 To 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
359 =head1 CAVEATS
360
361 It's possible to have more than one grab driver available, for
362 example, Win32 and X11, and which is used can have an effect on the
363 result.
364
365 Under Win32 or OS X, if there's a screesaver running, then you grab
366 the results of the screensaver.
367
368 On OS X, you can grab the display from an ssh session as long as the
369 ssh session is under the same user as the currently active user on the
370 display.
371
372 Grabbing the root window on a rootless server (eg. Cygwin/X) may not
373 grab the background that you see.  In fact, when I tested under
374 Cygwin/X I got the xterm window contents even when the Windows
375 screensaver was running.  The root window captured appeared to be that
376 generated by my window manager.
377
378 Grabbing a window with other windows overlaying it will capture the
379 content of those windows where they hide the window you want to
380 capture.  You may want to raise the window to top.  This may be a
381 security concern if the overlapping windows contain any sensitive
382 information - true for any screen capture.
383
384 =head1 LICENSE
385
386 Imager::Screenshot is licensed under the same terms as Perl itself.
387
388 =head1 TODO
389
390 Future plans include:
391
392 =over
393
394 =item *
395
396 window name searches - currently screenshot() requires a window
397 identifier of some sort, it would be more usable if we could supply
398 some other identifier, either a window title or a window class name.
399
400 =back
401
402 =head1 AUTHOR
403
404 Tony Cook <tonyc@cpan.org>
405
406 =cut
407
408