[imager-screenshot.git] / Screenshot.pm

package Imager::Screenshot;
use strict;
use vars qw(@ISA $VERSION @EXPORT_OK);
use Imager;
require Exporter;

push @ISA, 'Exporter';
@EXPORT_OK = 'screenshot';

BEGIN {
  require Exporter;
  @ISA = qw(Exporter);
  $VERSION = '0.009';
  eval {
    # try XSLoader first, DynaLoader has annoying baggage
    require XSLoader;
    XSLoader::load('Imager::Screenshot' => $VERSION);
    1;
  } or do {
    require DynaLoader;
    push @ISA, 'DynaLoader';
    bootstrap Imager::Screenshot $VERSION;
  }
}

sub screenshot {
  # lose the class if called as a method
  @_ % 2 == 1 and shift;

  my %opts = 
    (
     decor => 0, 
     display => 0, 
     left => 0, 
     top => 0,
     right => 0,
     bottom => 0,
     @_);

  my $result;
  if (defined $opts{hwnd}) {
    defined &_win32
      or die "Win32 driver not enabled\n";
    $result = _win32($opts{hwnd}, $opts{decor}, $opts{left}, $opts{top},
		     $opts{right}, $opts{bottom});
  }
  elsif (defined $opts{id}) { # X11 window id
    defined &_x11
      or die "X11 driver not enabled\n";
    $result = _x11($opts{display}, $opts{id}, $opts{left}, $opts{top},
		   $opts{right}, $opts{bottom});
  }
  elsif ($opts{widget}) {
    # Perl/Tk widget
    my $top = $opts{widget}->toplevel;
    my $sys = $top->windowingsystem;
    if ($sys eq 'win32') {
      unless (defined &_win32) {
        Imager->_set_error("Win32 Tk and Win32 support not built");
        return;
      }
      $result = _win32(hex($opts{widget}->id), $opts{decor}, 
		       $opts{left}, $opts{top}, $opts{right}, $opts{bottom});
    }
    elsif ($sys eq 'x11') {
      unless (defined &_x11) {
        Imager->_set_error("X11 Tk and X11 support not built");
        return;
      }

      my $id_hex = $opts{widget}->id;
      
      # is there a way to get the display pointer from Tk?
      $result = _x11($opts{display}, hex($id_hex), $opts{left}, $opts{top},
		     $opts{right}, $opts{bottom});
    }
    else {
      Imager->_set_error("Unsupported windowing system '$sys'");
      return;
    }
  }
  else {
    $result =
      defined &_win32 ? _win32(0, $opts{decor}, $opts{left}, $opts{top},
			       $opts{right}, $opts{bottom}) :
	defined &_x11 ? _x11($opts{display}, 0, $opts{left}, $opts{top},
			     $opts{right}, $opts{bottom}) :
	   die "No drivers enabled\n";
  }

  unless ($result) {
    Imager->_set_error(Imager->_error_as_msg());
    return;
  }

  # RT #24992 - the Imager typemap entry is broken pre-0.56, so
  # wrap it here
  return bless { IMG => $result }, "Imager";
}

sub have_win32 {
  defined &_win32;
}

sub have_x11 {
  defined &_x11;
}

sub x11_open {
  my $display = _x11_open(@_);
  unless ($display) {
    Imager->_set_error(Imager->_error_as_msg);
    return;
  }

  return $display;
}

sub x11_close {
  _x11_close(shift);
}

1;

__END__

=head1 NAME

Imager::Screenshot - screenshot to an Imager image

=head1 SYNOPSIS

  use Imager::Screenshot 'screenshot';

  # whole screen
  my $img = screenshot();

  # Win32 window
  my $img2 = screenshot(hwnd => $hwnd);

  # X11 window
  my $img3 = screenshot(display => $display, id => $window_id);

  # X11 tools
  my $display = Imager::Screenshot::x11_open();
  Imager::Screenshot::x11_close($display);

  # test for win32 support
  if (Imager::Screenshot->have_win32) { ... }

  # test for x11 support
  if (Imager::Screenshot->have_x11) { ... }
  

=head1 DESCRIPTION

Imager::Screenshot captures either a desktop or a specified window and
returns the result as an Imager image.

Currently the image is always returned as a 24-bit image.

=over

=item screenshot hwnd => I<window handle>

=item screenshot hwnd => I<window handle>, decor => <capture decorations>

Retrieve a screenshot under Win32, if I<window handle> is zero,
capture the desktop.

By default, window decorations are not captured, if the C<decor>
parameter is set to true then window decorations are included.

=item screenshot id => I<window id>

=item screenshot id => I<window id>, display => I<display object>

Retrieve a screenshot under X11, if I<id> is zero, capture the root
window.  I<display object> is a integer version of an X11 C< Display *
>, if this isn't supplied C<screenshot()> will attempt connect to the
the display specified by $ENV{DISPLAY}.

Note: taking a screenshot of a remote display is slow.

=item screenshot widget => I<widget>

=item screenshot widget => I<widget>, display => I<display>

=item screenshot widget => I<widget>, decor => I<capture decorations>

Retrieve a screenshot of a Tk widget, under Win32 or X11, depending on
how Tk has been built.

If Tk was built for X11 then the display parameter applies.

If Tk was built for Win32 then the decor parameter applies.

=item screenshot

If no C<id>, C<hwnd> or C<widget> parameter is supplied:

=over

=item *

if Win32 support is compiled, return screenshot(hwnd => 0).

=item *

if X11 support is compiled, return screenshot(id => 0).

=item *

otherwise, die.

=back

You can also supply the following parameters to retrieve a subset of
the window:

=over

=item *

left

=item *

top

=item *

right

=item *

bottom

=back

If left or top is negative, then treat that as from the right/bottom
edge of the window.

If right ot bottom is zero or negative then treat as from the
right/bottom edge of the window.

So setting all 4 values to 0 retrieves the whole window.

  # a 10-pixel wide right edge of the window
  my $right_10 = screenshot(left => -10, ...);

  # the top-left 100x100 portion of the window
  my $topleft_100 = screenshot(right => 100, bottom => 100, ...);

  # 10x10 pixel at the bottom right corner
  my $bott_right_10 = screenshot(left => -10, top => -10, ...);

If screenshot() fails, it will return nothing, and the cause of the
failure can be retrieved via Imager->errstr, so typical use could be:

  my $img = screenshot(...) or die Imager->errstr;

=item have_win32

Returns true if Win32 support is available.

=item have_x11

Returns true if X11 support is available.

=item Imager::Screenshot::x11_open

=item Imager::Screenshot::x11_open I<display name>

Attempts to open a connection to either the display name in
$ENV{DISPLAY} or the supplied display name.  Returns a value suitable
for the I<display> parameter of screenshot, or undef.

=item Imager::Screenshot::x11_close I<display>

Closes a display returned by Imager::Screenshot::x11_open().

=back

=head1 TAGS

screenshot() sets a number of tags in the images it returns, these are:

=over

=item *

ss_left - the distance between the left side of the window and the
left side of the captured area.  The same value as the I<left>
parameter when that is positive.

=item *

ss_top - the distance between the top side of the window the top side
of the captured area.  The same value at the I<top> parameter when
that is positive.

=item *

ss_window_width - the full width of the window.

=item *

ss_window_height - the full height of the window.

=item *

ss_type - the type of capture done, either "Win32" or "X11".

=back

To cheaply get the window size you can capture a single pixel:

  my $im = screenshot(right => 1, bottom => 1);
  my $window_width  = $im->tags(name => 'ss_window_width');
  my $window_height = $im->tags(name => 'ss_window_height');

=head1 CAVEATS

It's possible to have more than one grab driver available, for
example, Win32 and X11, and which is used can have an effect on the
result.

Under Win32, if there's a screesaver running, then you grab the
results of the screensaver.

Grabbing the root window on a rootless server (eg. Cygwin/X) may not
grab the background that you see.  In fact, when I tested under
Cygwin/X I got the xterm window contents even when the Windows
screensaver was running.  The root window captured appeared to be that
generated by my window manager.

Grabbing a window with other windows overlaying it will capture the
content of those windows where they hide the window you want to
capture.  You may want to raise the window to top.  This may be a
security concern if the overlapping windows contain any sensitive
information - true for any screen capture.

=head1 LICENSE

Imager::Screenshot is licensed under the same terms as Perl itself.

=head1 TODO

Future plans include:

=over

=item *

OS X support - I need to find out which APIs to use to do this.  I
found some information on the APIs used for this, but don't have a Mac
I can test on.

=item *

window name searches - currently screenshot() requires a window
identifier of some sort, it would be more usable if we could supply
some other identifier, either a window title or a window class name.

=back

=head1 AUTHOR

Tony Cook <tonyc@cpan.org>

=cut
Commit	Line	Data
967e4c21 TC	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);
136a3eae	13	$VERSION = '0.009';
967e4c21 TC	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
87cd516f TC	30	my %opts =
	31	(
	32	decor => 0,
	33	display => 0,
	34	left => 0,
	35	top => 0,
	36	right => 0,
	37	bottom => 0,
	38	@_);
967e4c21 TC	39
967e4c21 TC	40	my $result;
967e4c21 TC	41	if (defined $opts{hwnd}) {
	42	defined &_win32
	43	or die "Win32 driver not enabled\n";
87cd516f TC	44	$result = _win32($opts{hwnd}, $opts{decor}, $opts{left}, $opts{top},
87cd516f TC	45	$opts{right}, $opts{bottom});
967e4c21 TC	46	}
	47	elsif (defined $opts{id}) { # X11 window id
	48	defined &_x11
	49	or die "X11 driver not enabled\n";
87cd516f TC	50	$result = _x11($opts{display}, $opts{id}, $opts{left}, $opts{top},
87cd516f TC	51	$opts{right}, $opts{bottom});
967e4c21 TC	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	}
87cd516f TC	62	$result = _win32(hex($opts{widget}->id), $opts{decor},
87cd516f TC	63	$opts{left}, $opts{top}, $opts{right}, $opts{bottom});
967e4c21 TC	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;
967e4c21 TC	72
967e4c21 TC	73	# is there a way to get the display pointer from Tk?
87cd516f TC	74	$result = _x11($opts{display}, hex($id_hex), $opts{left}, $opts{top},
87cd516f TC	75	$opts{right}, $opts{bottom});
967e4c21 TC	76	}
	77	else {
	78	Imager->_set_error("Unsupported windowing system '$sys'");
	79	return;
	80	}
	81	}
87cd516f TC	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	}
967e4c21 TC	90
	91	unless ($result) {
	92	Imager->_set_error(Imager->_error_as_msg());
	93	return;
	94	}
cd684d4f TC	95
	96	# RT #24992 - the Imager typemap entry is broken pre-0.56, so
	97	# wrap it here
	98	return bless { IMG => $result }, "Imager";
967e4c21 TC	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
f04a72ea TC	183	Note: taking a screenshot of a remote display is slow.
f04a72ea TC	184
9d2a775a TC	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
967e4c21 TC	198	=item screenshot
967e4c21 TC	199
9d2a775a	200	If no C<id>, C<hwnd> or C<widget> parameter is supplied:
967e4c21 TC	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
87cd516f TC	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
06bbf244 TC	258	If screenshot() fails, it will return nothing, and the cause of the
	259	failure can be retrieved via Imager->errstr, so typical use could be:
	260
	261	my $img = screenshot(...) or die Imager->errstr;
	262
967e4c21 TC	263	=item have_win32
	264
	265	Returns true if Win32 support is available.
	266
	267	=item have_x11
	268
	269	Returns true if X11 support is available.
	270
	271	=item Imager::Screenshot::x11_open
	272
	273	=item Imager::Screenshot::x11_open I<display name>
	274
	275	Attempts to open a connection to either the display name in
	276	$ENV{DISPLAY} or the supplied display name. Returns a value suitable
	277	for the I<display> parameter of screenshot, or undef.
	278
	279	=item Imager::Screenshot::x11_close I<display>
	280
	281	Closes a display returned by Imager::Screenshot::x11_open().
	282
	283	=back
	284
62b84c46 TC	285	=head1 TAGS
	286
	287	screenshot() sets a number of tags in the images it returns, these are:
	288
	289	=over
	290
	291	=item *
	292
	293	ss_left - the distance between the left side of the window and the
	294	left side of the captured area. The same value as the I<left>
	295	parameter when that is positive.
	296
	297	=item *
	298
	299	ss_top - the distance between the top side of the window the top side
	300	of the captured area. The same value at the I<top> parameter when
	301	that is positive.
	302
	303	=item *
	304
	305	ss_window_width - the full width of the window.
	306
	307	=item *
	308
	309	ss_window_height - the full height of the window.
	310
	311	=item *
	312
	313	ss_type - the type of capture done, either "Win32" or "X11".
	314
	315	=back
	316
	317	To cheaply get the window size you can capture a single pixel:
	318
	319	my $im = screenshot(right => 1, bottom => 1);
	320	my $window_width = $im->tags(name => 'ss_window_width');
	321	my $window_height = $im->tags(name => 'ss_window_height');
	322
87cd516f TC	323	=head1 CAVEATS
	324
	325	It's possible to have more than one grab driver available, for
	326	example, Win32 and X11, and which is used can have an effect on the
	327	result.
	328
	329	Under Win32, if there's a screesaver running, then you grab the
	330	results of the screensaver.
	331
	332	Grabbing the root window on a rootless server (eg. Cygwin/X) may not
62b84c46 TC	333	grab the background that you see. In fact, when I tested under
	334	Cygwin/X I got the xterm window contents even when the Windows
	335	screensaver was running. The root window captured appeared to be that
	336	generated by my window manager.
87cd516f	337
54f11a66 TC	338	Grabbing a window with other windows overlaying it will capture the
	339	content of those windows where they hide the window you want to
	340	capture. You may want to raise the window to top. This may be a
	341	security concern if the overlapping windows contain any sensitive
	342	information - true for any screen capture.
	343
967e4c21 TC	344	=head1 LICENSE
	345
	346	Imager::Screenshot is licensed under the same terms as Perl itself.
	347
33f803d8 TC	348	=head1 TODO
	349
	350	Future plans include:
	351
	352	=over
	353
	354	=item *
	355
54f11a66 TC	356	OS X support - I need to find out which APIs to use to do this. I
	357	found some information on the APIs used for this, but don't have a Mac
	358	I can test on.
33f803d8 TC	359
	360	=item *
	361
	362	window name searches - currently screenshot() requires a window
	363	identifier of some sort, it would be more usable if we could supply
	364	some other identifier, either a window title or a window class name.
	365
	366	=back
	367
967e4c21 TC	368	=head1 AUTHOR
	369
	370	Tony Cook <tonyc@cpan.org>
	371
	372	=cut
	373
	374