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