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.007';
  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 ($opts{widget}) {
  54     # Perl/Tk widget
  55     my $top = $opts{widget}->toplevel;
  56     my $sys = $top->windowingsystem;
  57     if ($sys eq 'win32') {
  58       unless (defined &_win32) {
  59         Imager->_set_error("Win32 Tk and Win32 support not built");
  60         return;
  61       }
  62       $result = _win32(hex($opts{widget}->id), $opts{decor},
  63                        $opts{left}, $opts{top}, $opts{right}, $opts{bottom});
  64     }
  65     elsif ($sys eq 'x11') {
  66       unless (defined &_x11) {
  67         Imager->_set_error("X11 Tk and X11 support not built");
  68         return;
  69       }
  70
  71       my $id_hex = $opts{widget}->id;
  72
  73       # is there a way to get the display pointer from Tk?
  74       $result = _x11($opts{display}, hex($id_hex), $opts{left}, $opts{top},
  75                      $opts{right}, $opts{bottom});
  76     }
  77     else {
  78       Imager->_set_error("Unsupported windowing system '$sys'");
  79       return;
  80     }
  81   }
  82   else {
  83     $result =
  84       defined &_win32 ? _win32(0, $opts{decor}, $opts{left}, $opts{top},
  85                                $opts{right}, $opts{bottom}) :
  86         defined &_x11 ? _x11($opts{display}, 0, $opts{left}, $opts{top},
  87                              $opts{right}, $opts{bottom}) :
  88            die "No drivers enabled\n";
  89   }
  90
  91   unless ($result) {
  92     Imager->_set_error(Imager->_error_as_msg());
  93     return;
  94   }
  95
  96   # RT #24992 - the Imager typemap entry is broken pre-0.56, so
  97   # wrap it here
  98   return bless { IMG => $result }, "Imager";
  99 }
 100
 101 sub have_win32 {
 102   defined &_win32;
 103 }
 104
 105 sub have_x11 {
 106   defined &_x11;
 107 }
 108
 109 sub x11_open {
 110   my $display = _x11_open(@_);
 111   unless ($display) {
 112     Imager->_set_error(Imager->_error_as_msg);
 113     return;
 114   }
 115
 116   return $display;
 117 }
 118
 119 sub x11_close {
 120   _x11_close(shift);
 121 }
 122
 123 1;
 124
 125 __END__
 126
 127 =head1 NAME
 128
 129 Imager::Screenshot - screenshot to an Imager image
 130
 131 =head1 SYNOPSIS
 132
 133   use Imager::Screenshot 'screenshot';
 134
 135   # whole screen
 136   my $img = screenshot();
 137
 138   # Win32 window
 139   my $img2 = screenshot(hwnd => $hwnd);
 140
 141   # X11 window
 142   my $img3 = screenshot(display => $display, id => $window_id);
 143
 144   # X11 tools
 145   my $display = Imager::Screenshot::x11_open();
 146   Imager::Screenshot::x11_close($display);
 147
 148   # test for win32 support
 149   if (Imager::Screenshot->have_win32) { ... }
 150
 151   # test for x11 support
 152   if (Imager::Screenshot->have_x11) { ... }
 153
 154
 155 =head1 DESCRIPTION
 156
 157 Imager::Screenshot captures either a desktop or a specified window and
 158 returns the result as an Imager image.
 159
 160 Currently the image is always returned as a 24-bit image.
 161
 162 =over
 163
 164 =item screenshot hwnd => I<window handle>
 165
 166 =item screenshot hwnd => I<window handle>, decor => <capture decorations>
 167
 168 Retrieve a screenshot under Win32, if I<window handle> is zero,
 169 capture the desktop.
 170
 171 By default, window decorations are not captured, if the C<decor>
 172 parameter is set to true then window decorations are included.
 173
 174 =item screenshot id => I<window id>
 175
 176 =item screenshot id => I<window id>, display => I<display object>
 177
 178 Retrieve a screenshot under X11, if I<id> is zero, capture the root
 179 window.  I<display object> is a integer version of an X11 C< Display *
 180 >, if this isn't supplied C<screenshot()> will attempt connect to the
 181 the display specified by $ENV{DISPLAY}.
 182
 183 Note: taking a screenshot of a remote display is slow.
 184
 185 =item screenshot widget => I<widget>
 186
 187 =item screenshot widget => I<widget>, display => I<display>
 188
 189 =item screenshot widget => I<widget>, decor => I<capture decorations>
 190
 191 Retrieve a screenshot of a Tk widget, under Win32 or X11, depending on
 192 how Tk has been built.
 193
 194 If Tk was built for X11 then the display parameter applies.
 195
 196 If Tk was built for Win32 then the decor parameter applies.
 197
 198 =item screenshot
 199
 200 If no C<id>, C<hwnd> or C<widget> parameter is supplied:
 201
 202 =over
 203
 204 =item *
 205
 206 if Win32 support is compiled, return screenshot(hwnd => 0).
 207
 208 =item *
 209
 210 if X11 support is compiled, return screenshot(id => 0).
 211
 212 =item *
 213
 214 otherwise, die.
 215
 216 =back
 217
 218 You can also supply the following parameters to retrieve a subset of
 219 the window:
 220
 221 =over
 222
 223 =item *
 224
 225 left
 226
 227 =item *
 228
 229 top
 230
 231 =item *
 232
 233 right
 234
 235 =item *
 236
 237 bottom
 238
 239 =back
 240
 241 If left or top is negative, then treat that as from the right/bottom
 242 edge of the window.
 243
 244 If right ot bottom is zero or negative then treat as from the
 245 right/bottom edge of the window.
 246
 247 So setting all 4 values to 0 retrieves the whole window.
 248
 249   # a 10-pixel wide right edge of the window
 250   my $right_10 = screenshot(left => -10, ...);
 251
 252   # the top-left 100x100 portion of the window
 253   my $topleft_100 = screenshot(right => 100, bottom => 100, ...);
 254
 255   # 10x10 pixel at the bottom right corner
 256   my $bott_right_10 = screenshot(left => -10, top => -10, ...);
 257
 258 =item have_win32
 259
 260 Returns true if Win32 support is available.
 261
 262 =item have_x11
 263
 264 Returns true if X11 support is available.
 265
 266 =item Imager::Screenshot::x11_open
 267
 268 =item Imager::Screenshot::x11_open I<display name>
 269
 270 Attempts to open a connection to either the display name in
 271 $ENV{DISPLAY} or the supplied display name.  Returns a value suitable
 272 for the I<display> parameter of screenshot, or undef.
 273
 274 =item Imager::Screenshot::x11_close I<display>
 275
 276 Closes a display returned by Imager::Screenshot::x11_open().
 277
 278 =back
 279
 280 =head1 TAGS
 281
 282 screenshot() sets a number of tags in the images it returns, these are:
 283
 284 =over
 285
 286 =item *
 287
 288 ss_left - the distance between the left side of the window and the
 289 left side of the captured area.  The same value as the I<left>
 290 parameter when that is positive.
 291
 292 =item *
 293
 294 ss_top - the distance between the top side of the window the top side
 295 of the captured area.  The same value at the I<top> parameter when
 296 that is positive.
 297
 298 =item *
 299
 300 ss_window_width - the full width of the window.
 301
 302 =item *
 303
 304 ss_window_height - the full height of the window.
 305
 306 =item *
 307
 308 ss_type - the type of capture done, either "Win32" or "X11".
 309
 310 =back
 311
 312 To cheaply get the window size you can capture a single pixel:
 313
 314   my $im = screenshot(right => 1, bottom => 1);
 315   my $window_width  = $im->tags(name => 'ss_window_width');
 316   my $window_height = $im->tags(name => 'ss_window_height');
 317
 318 =head1 CAVEATS
 319
 320 It's possible to have more than one grab driver available, for
 321 example, Win32 and X11, and which is used can have an effect on the
 322 result.
 323
 324 Under Win32, if there's a screesaver running, then you grab the
 325 results of the screensaver.
 326
 327 Grabbing the root window on a rootless server (eg. Cygwin/X) may not
 328 grab the background that you see.  In fact, when I tested under
 329 Cygwin/X I got the xterm window contents even when the Windows
 330 screensaver was running.  The root window captured appeared to be that
 331 generated by my window manager.
 332
 333 Grabbing a window with other windows overlaying it will capture the
 334 content of those windows where they hide the window you want to
 335 capture.  You may want to raise the window to top.  This may be a
 336 security concern if the overlapping windows contain any sensitive
 337 information - true for any screen capture.
 338
 339 =head1 LICENSE
 340
 341 Imager::Screenshot is licensed under the same terms as Perl itself.
 342
 343 =head1 TODO
 344
 345 Future plans include:
 346
 347 =over
 348
 349 =item *
 350
 351 OS X support - I need to find out which APIs to use to do this.  I
 352 found some information on the APIs used for this, but don't have a Mac
 353 I can test on.
 354
 355 =item *
 356
 357 window name searches - currently screenshot() requires a window
 358 identifier of some sort, it would be more usable if we could supply
 359 some other identifier, either a window title or a window class name.
 360
 361 =back
 362
 363 =head1 AUTHOR
 364
 365 Tony Cook <tonyc@cpan.org>
 366
 367 =cut
 368
 369