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.014';
  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