itermediate working result
[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 Retrieve a screenshot under Win32, if I<window handle> is zero,
184 capture the desktop.
185
186 By default, window decorations are not captured, if the C<decor>
187 parameter is set to true then window decorations are included.
188
189 =item screenshot id => I<window id>
190
191 =item screenshot id => I<window id>, display => I<display object>
192
193 Retrieve a screenshot under X11, if I<id> is zero, capture the root
194 window.  I<display object> is a integer version of an X11 C< Display *
195 >, if this isn't supplied C<screenshot()> will attempt connect to the
196 the display specified by $ENV{DISPLAY}.
197
198 Note: taking a screenshot of a remote display is slow.
199
200 =item screenshot darwin => 0
201
202 Retrieve a screenshot under Mac OS X.  The only supported value for
203 the C<darwin> parameter is C<0>.
204
205 For a screen capture to be taken, the current user using
206 Imager:Screenshot must be the currently logged in user on the display.
207
208 If you're using fast user switching, the current user must be the
209 active user.
210
211 Note: this means you can ssh into a Mac OS X box and screenshot from
212 the ssh session, if you're the current user on the display.
213
214 =item screenshot widget => I<widget>
215
216 =item screenshot widget => I<widget>, display => I<display>
217
218 =item screenshot widget => I<widget>, decor => I<capture decorations>
219
220 Retrieve a screenshot of a Tk widget, under Win32 or X11, depending on
221 how Tk has been built.
222
223 If Tk was built for X11 then the display parameter applies.
224
225 If Tk was built for Win32 then the decor parameter applies.
226
227 =item screenshot
228
229 If no C<id>, C<hwnd> or C<widget> parameter is supplied:
230
231 =over
232
233 =item *
234
235 if Win32 support is compiled, return screenshot(hwnd => 0).
236
237 =item *
238
239 if Darwin support is compiled, return screenshot(darwin => 0).
240
241 =item *
242
243 if X11 support is compiled, return screenshot(id => 0).
244
245 =item *
246
247 otherwise, die.
248
249 =back
250
251 You can also supply the following parameters to retrieve a subset of
252 the window:
253
254 =over
255
256 =item *
257
258 left
259
260 =item *
261
262 top
263
264 =item *
265
266 right
267
268 =item *
269
270 bottom
271
272 =back
273
274 If left or top is negative, then treat that as from the right/bottom
275 edge of the window.
276
277 If right ot bottom is zero or negative then treat as from the
278 right/bottom edge of the window.
279
280 So setting all 4 values to 0 retrieves the whole window.
281
282   # a 10-pixel wide right edge of the window
283   my $right_10 = screenshot(left => -10, ...);
284
285   # the top-left 100x100 portion of the window
286   my $topleft_100 = screenshot(right => 100, bottom => 100, ...);
287
288   # 10x10 pixel at the bottom right corner
289   my $bott_right_10 = screenshot(left => -10, top => -10, ...);
290
291 If screenshot() fails, it will return nothing, and the cause of the
292 failure can be retrieved via Imager->errstr, so typical use could be:
293
294   my $img = screenshot(...) or die Imager->errstr;
295
296 =item have_win32
297
298 Returns true if Win32 support is available.
299
300 =item have_x11
301
302 Returns true if X11 support is available.
303
304 =item have_darwin
305
306 Returns true if Darwin support is available.
307
308 =item Imager::Screenshot::x11_open
309
310 =item Imager::Screenshot::x11_open I<display name>
311
312 Attempts to open a connection to either the display name in
313 $ENV{DISPLAY} or the supplied display name.  Returns a value suitable
314 for the I<display> parameter of screenshot, or undef.
315
316 =item Imager::Screenshot::x11_close I<display>
317
318 Closes a display returned by Imager::Screenshot::x11_open().
319
320 =back
321
322 =head1 TAGS
323
324 screenshot() sets a number of tags in the images it returns, these are:
325
326 =over
327
328 =item *
329
330 ss_left - the distance between the left side of the window and the
331 left side of the captured area.  The same value as the I<left>
332 parameter when that is positive.
333
334 =item *
335
336 ss_top - the distance between the top side of the window the top side
337 of the captured area.  The same value at the I<top> parameter when
338 that is positive.
339
340 =item *
341
342 ss_window_width - the full width of the window.
343
344 =item *
345
346 ss_window_height - the full height of the window.
347
348 =item *
349
350 ss_type - the type of capture done, either "Win32" or "X11".
351
352 =back
353
354 To cheaply get the window size you can capture a single pixel:
355
356   my $im = screenshot(right => 1, bottom => 1);
357   my $window_width  = $im->tags(name => 'ss_window_width');
358   my $window_height = $im->tags(name => 'ss_window_height');
359
360 =head1 CAVEATS
361
362 It's possible to have more than one grab driver available, for
363 example, Win32 and X11, and which is used can have an effect on the
364 result.
365
366 Under Win32 or OS X, if there's a screesaver running, then you grab
367 the results of the screensaver.
368
369 On OS X, you can grab the display from an ssh session as long as the
370 ssh session is under the same user as the currently active user on the
371 display.
372
373 Grabbing the root window on a rootless server (eg. Cygwin/X) may not
374 grab the background that you see.  In fact, when I tested under
375 Cygwin/X I got the xterm window contents even when the Windows
376 screensaver was running.  The root window captured appeared to be that
377 generated by my window manager.
378
379 Grabbing a window with other windows overlaying it will capture the
380 content of those windows where they hide the window you want to
381 capture.  You may want to raise the window to top.  This may be a
382 security concern if the overlapping windows contain any sensitive
383 information - true for any screen capture.
384
385 =head1 LICENSE
386
387 Imager::Screenshot is licensed under the same terms as Perl itself.
388
389 =head1 TODO
390
391 Future plans include:
392
393 =over
394
395 =item *
396
397 window name searches - currently screenshot() requires a window
398 identifier of some sort, it would be more usable if we could supply
399 some other identifier, either a window title or a window class name.
400
401 =back
402
403 =head1 AUTHOR
404
405 Tony Cook <tonyc@cpan.org>
406
407 =cut
408
409