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