[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 &_darwin ? _darwin($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}) :
bc99c241 TC	86	defined &_darwin ? _darwin($opts{left}, $opts{top},
	87	$opts{right}, $opts{bottom}) :
	88	defined &_x11 ? _x11($opts{display}, 0, $opts{left}, $opts{top},
87cd516f TC	89	$opts{right}, $opts{bottom}) :
	90	die "No drivers enabled\n";
	91	}
967e4c21 TC	92
	93	unless ($result) {
	94	Imager->_set_error(Imager->_error_as_msg());
	95	return;
	96	}
cd684d4f TC	97
	98	# RT #24992 - the Imager typemap entry is broken pre-0.56, so
	99	# wrap it here
	100	return bless { IMG => $result }, "Imager";
967e4c21 TC	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
f04a72ea TC	185	Note: taking a screenshot of a remote display is slow.
f04a72ea TC	186
9d2a775a TC	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
967e4c21 TC	200	=item screenshot
967e4c21 TC	201
9d2a775a	202	If no C<id>, C<hwnd> or C<widget> parameter is supplied:
967e4c21 TC	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
87cd516f TC	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
06bbf244 TC	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
967e4c21 TC	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
62b84c46 TC	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
87cd516f TC	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
62b84c46 TC	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.
87cd516f	339
54f11a66 TC	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
967e4c21 TC	346	=head1 LICENSE
	347
	348	Imager::Screenshot is licensed under the same terms as Perl itself.
	349
33f803d8 TC	350	=head1 TODO
	351
	352	Future plans include:
	353
	354	=over
	355
	356	=item *
	357
54f11a66 TC	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.
33f803d8 TC	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
967e4c21 TC	370	=head1 AUTHOR
	371
	372	Tony Cook <tonyc@cpan.org>
	373
	374	=cut
	375
	376