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