[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_001';
  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}, $opts{display});
  }
  elsif (defined $opts{id}) { # X11 window id
    exists $opts{display} or $opts{display} = 0;
    defined &_x11
      or die "X11 driver not enabled\n";
    $result = _x11($opts{display}, $opts{id}, $opts{left}, $opts{top},
		   $opts{right}, $opts{bottom});
  }
  elsif (defined $opts{darwin}) { # as long as it's there
    defined &_darwin
      or die "Darwin driver not enabled\n";
    $result = _darwin($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}, $opts{display}) :
      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 have_darwin {
  defined &_darwin;
}

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) { ... }
  
  # test for Darwin (Mac OS X) support
  if (Imager::Screenshot->have_darwin) { ... }
  

=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 darwin => 0

Retrieve a screenshot under Mac OS X.  The only supported value for
the C<darwin> parameter is C<0>.

For a screen capture to be taken, the current user using
Imager:Screenshot must be the currently logged in user on the display.

If you're using fast user switching, the current user must be the
active user.

Note: this means you can ssh into a Mac OS X box and screenshot from
the ssh session, if you're the current user on the display.

=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 Darwin support is compiled, return screenshot(darwin => 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 have_darwin

Returns true if Darwin 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 or OS X, if there's a screesaver running, then you grab
the results of the screensaver.

On OS X, you can grab the display from an ssh session as long as the
ssh session is under the same user as the currently active user on the
display.

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 *

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);
61502fc5	13	$VERSION = '0.009_001';
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	44	$result = _win32($opts{hwnd}, $opts{decor}, $opts{left}, $opts{top},
4e6ce56a	45	$opts{right}, $opts{bottom}, $opts{display});
967e4c21 TC	46	}
967e4c21 TC	47	elsif (defined $opts{id}) { # X11 window id
4e6ce56a	48	exists $opts{display} or $opts{display} = 0;
967e4c21 TC	49	defined &_x11
967e4c21 TC	50	or die "X11 driver not enabled\n";
87cd516f TC	51	$result = _x11($opts{display}, $opts{id}, $opts{left}, $opts{top},
87cd516f TC	52	$opts{right}, $opts{bottom});
967e4c21	53	}
0cc0b6d7 TC	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	}
967e4c21 TC	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	}
87cd516f TC	68	$result = _win32(hex($opts{widget}->id), $opts{decor},
87cd516f TC	69	$opts{left}, $opts{top}, $opts{right}, $opts{bottom});
967e4c21 TC	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;
967e4c21 TC	78
967e4c21 TC	79	# is there a way to get the display pointer from Tk?
87cd516f TC	80	$result = _x11($opts{display}, hex($id_hex), $opts{left}, $opts{top},
87cd516f TC	81	$opts{right}, $opts{bottom});
967e4c21 TC	82	}
	83	else {
	84	Imager->_set_error("Unsupported windowing system '$sys'");
	85	return;
	86	}
	87	}
87cd516f TC	88	else {
	89	$result =
	90	defined &_win32 ? _win32(0, $opts{decor}, $opts{left}, $opts{top},
4e6ce56a	91	$opts{right}, $opts{bottom}, $opts{display}) :
bc99c241 TC	92	defined &_darwin ? _darwin($opts{left}, $opts{top},
	93	$opts{right}, $opts{bottom}) :
	94	defined &_x11 ? _x11($opts{display}, 0, $opts{left}, $opts{top},
87cd516f TC	95	$opts{right}, $opts{bottom}) :
	96	die "No drivers enabled\n";
	97	}
967e4c21 TC	98
	99	unless ($result) {
	100	Imager->_set_error(Imager->_error_as_msg());
	101	return;
	102	}
cd684d4f TC	103
	104	# RT #24992 - the Imager typemap entry is broken pre-0.56, so
	105	# wrap it here
	106	return bless { IMG => $result }, "Imager";
967e4c21 TC	107	}
	108
	109	sub have_win32 {
	110	defined &_win32;
	111	}
	112
	113	sub have_x11 {
	114	defined &_x11;
	115	}
	116
0cc0b6d7 TC	117	sub have_darwin {
	118	defined &_darwin;
	119	}
	120
967e4c21 TC	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
0cc0b6d7 TC	166	# test for Darwin (Mac OS X) support
	167	if (Imager::Screenshot->have_darwin) { ... }
	168
967e4c21 TC	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
f04a72ea TC	198	Note: taking a screenshot of a remote display is slow.
f04a72ea TC	199
0cc0b6d7 TC	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
9d2a775a TC	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
967e4c21 TC	227	=item screenshot
967e4c21 TC	228
9d2a775a	229	If no C<id>, C<hwnd> or C<widget> parameter is supplied:
967e4c21 TC	230
	231	=over
	232
	233	=item *
	234
	235	if Win32 support is compiled, return screenshot(hwnd => 0).
	236
	237	=item *
	238
0cc0b6d7 TC	239	if Darwin support is compiled, return screenshot(darwin => 0).
	240
	241	=item *
	242
967e4c21 TC	243	if X11 support is compiled, return screenshot(id => 0).
	244
	245	=item *
	246
	247	otherwise, die.
	248
	249	=back
	250
87cd516f TC	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
06bbf244 TC	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
967e4c21 TC	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
0cc0b6d7 TC	304	=item have_darwin
	305
	306	Returns true if Darwin support is available.
	307
967e4c21 TC	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
62b84c46 TC	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
87cd516f TC	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
0cc0b6d7 TC	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.
87cd516f TC	372
87cd516f TC	373	Grabbing the root window on a rootless server (eg. Cygwin/X) may not
62b84c46 TC	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.
87cd516f	378
54f11a66 TC	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
967e4c21 TC	385	=head1 LICENSE
	386
	387	Imager::Screenshot is licensed under the same terms as Perl itself.
	388
33f803d8 TC	389	=head1 TODO
	390
	391	Future plans include:
	392
	393	=over
	394
	395	=item *
	396
33f803d8 TC	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
967e4c21 TC	403	=head1 AUTHOR
	404
	405	Tony Cook <tonyc@cpan.org>
	406
	407	=cut
	408
	409