[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>

=item screenshot hwnd => "active"

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.

As of 0.010 hwnd can also be C<"active"> to capture the active (or
"foreground") window.

=item screenshot hwnd => 0

Retrieve a screeshot of the default desktop under Win32.

=item screenshot hwnd => 0, display => -1

Retrieve a screenshot of all attached monitors under Win32.

Note: this returns an image with an alpha channel, since there can be
regions in the bounding rectangle of all monitors that no particular
monitor covers.

=item screenshot hwnd => 0, display => I<index>

Retrieve a screenshot from a particular monitor under Win32.  A
I<display> of zero is always treated as the primary monitor.

=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
6f00ec2f TC	183	=item screenshot hwnd => "active"
6f00ec2f TC	184
967e4c21 TC	185	Retrieve a screenshot under Win32, if I<window handle> is zero,
	186	capture the desktop.
	187
	188	By default, window decorations are not captured, if the C<decor>
	189	parameter is set to true then window decorations are included.
	190
6f00ec2f TC	191	As of 0.010 hwnd can also be C<"active"> to capture the active (or
	192	"foreground") window.
	193
	194	=item screenshot hwnd => 0
	195
	196	Retrieve a screeshot of the default desktop under Win32.
	197
	198	=item screenshot hwnd => 0, display => -1
	199
	200	Retrieve a screenshot of all attached monitors under Win32.
	201
	202	Note: this returns an image with an alpha channel, since there can be
	203	regions in the bounding rectangle of all monitors that no particular
	204	monitor covers.
	205
	206	=item screenshot hwnd => 0, display => I<index>
	207
	208	Retrieve a screenshot from a particular monitor under Win32. A
	209	I<display> of zero is always treated as the primary monitor.
	210
967e4c21 TC	211	=item screenshot id => I<window id>
	212
	213	=item screenshot id => I<window id>, display => I<display object>
	214
	215	Retrieve a screenshot under X11, if I<id> is zero, capture the root
	216	window. I<display object> is a integer version of an X11 C< Display *
	217	>, if this isn't supplied C<screenshot()> will attempt connect to the
	218	the display specified by $ENV{DISPLAY}.
	219
f04a72ea TC	220	Note: taking a screenshot of a remote display is slow.
f04a72ea TC	221
0cc0b6d7 TC	222	=item screenshot darwin => 0
	223
	224	Retrieve a screenshot under Mac OS X. The only supported value for
	225	the C<darwin> parameter is C<0>.
	226
	227	For a screen capture to be taken, the current user using
	228	Imager:Screenshot must be the currently logged in user on the display.
	229
	230	If you're using fast user switching, the current user must be the
	231	active user.
	232
	233	Note: this means you can ssh into a Mac OS X box and screenshot from
	234	the ssh session, if you're the current user on the display.
	235
9d2a775a TC	236	=item screenshot widget => I<widget>
	237
	238	=item screenshot widget => I<widget>, display => I<display>
	239
	240	=item screenshot widget => I<widget>, decor => I<capture decorations>
	241
	242	Retrieve a screenshot of a Tk widget, under Win32 or X11, depending on
	243	how Tk has been built.
	244
	245	If Tk was built for X11 then the display parameter applies.
	246
	247	If Tk was built for Win32 then the decor parameter applies.
	248
967e4c21 TC	249	=item screenshot
967e4c21 TC	250
9d2a775a	251	If no C<id>, C<hwnd> or C<widget> parameter is supplied:
967e4c21 TC	252
	253	=over
	254
	255	=item *
	256
	257	if Win32 support is compiled, return screenshot(hwnd => 0).
	258
	259	=item *
	260
0cc0b6d7 TC	261	if Darwin support is compiled, return screenshot(darwin => 0).
	262
	263	=item *
	264
967e4c21 TC	265	if X11 support is compiled, return screenshot(id => 0).
	266
	267	=item *
	268
	269	otherwise, die.
	270
	271	=back
	272
87cd516f TC	273	You can also supply the following parameters to retrieve a subset of
	274	the window:
	275
	276	=over
	277
	278	=item *
	279
	280	left
	281
	282	=item *
	283
	284	top
	285
	286	=item *
	287
	288	right
	289
	290	=item *
	291
	292	bottom
	293
	294	=back
	295
	296	If left or top is negative, then treat that as from the right/bottom
	297	edge of the window.
	298
	299	If right ot bottom is zero or negative then treat as from the
	300	right/bottom edge of the window.
	301
	302	So setting all 4 values to 0 retrieves the whole window.
	303
	304	# a 10-pixel wide right edge of the window
	305	my $right_10 = screenshot(left => -10, ...);
	306
	307	# the top-left 100x100 portion of the window
	308	my $topleft_100 = screenshot(right => 100, bottom => 100, ...);
	309
	310	# 10x10 pixel at the bottom right corner
	311	my $bott_right_10 = screenshot(left => -10, top => -10, ...);
	312
06bbf244 TC	313	If screenshot() fails, it will return nothing, and the cause of the
	314	failure can be retrieved via Imager->errstr, so typical use could be:
	315
	316	my $img = screenshot(...) or die Imager->errstr;
	317
967e4c21 TC	318	=item have_win32
	319
	320	Returns true if Win32 support is available.
	321
	322	=item have_x11
	323
	324	Returns true if X11 support is available.
	325
0cc0b6d7 TC	326	=item have_darwin
	327
	328	Returns true if Darwin support is available.
	329
967e4c21 TC	330	=item Imager::Screenshot::x11_open
	331
	332	=item Imager::Screenshot::x11_open I<display name>
	333
	334	Attempts to open a connection to either the display name in
	335	$ENV{DISPLAY} or the supplied display name. Returns a value suitable
	336	for the I<display> parameter of screenshot, or undef.
	337
	338	=item Imager::Screenshot::x11_close I<display>
	339
	340	Closes a display returned by Imager::Screenshot::x11_open().
	341
	342	=back
	343
62b84c46 TC	344	=head1 TAGS
	345
	346	screenshot() sets a number of tags in the images it returns, these are:
	347
	348	=over
	349
	350	=item *
	351
	352	ss_left - the distance between the left side of the window and the
	353	left side of the captured area. The same value as the I<left>
	354	parameter when that is positive.
	355
	356	=item *
	357
	358	ss_top - the distance between the top side of the window the top side
	359	of the captured area. The same value at the I<top> parameter when
	360	that is positive.
	361
	362	=item *
	363
	364	ss_window_width - the full width of the window.
	365
	366	=item *
	367
	368	ss_window_height - the full height of the window.
	369
	370	=item *
	371
	372	ss_type - the type of capture done, either "Win32" or "X11".
	373
	374	=back
	375
	376	To cheaply get the window size you can capture a single pixel:
	377
	378	my $im = screenshot(right => 1, bottom => 1);
	379	my $window_width = $im->tags(name => 'ss_window_width');
	380	my $window_height = $im->tags(name => 'ss_window_height');
	381
87cd516f TC	382	=head1 CAVEATS
	383
	384	It's possible to have more than one grab driver available, for
	385	example, Win32 and X11, and which is used can have an effect on the
	386	result.
	387
0cc0b6d7 TC	388	Under Win32 or OS X, if there's a screesaver running, then you grab
	389	the results of the screensaver.
	390
	391	On OS X, you can grab the display from an ssh session as long as the
	392	ssh session is under the same user as the currently active user on the
	393	display.
87cd516f TC	394
87cd516f TC	395	Grabbing the root window on a rootless server (eg. Cygwin/X) may not
62b84c46 TC	396	grab the background that you see. In fact, when I tested under
	397	Cygwin/X I got the xterm window contents even when the Windows
	398	screensaver was running. The root window captured appeared to be that
	399	generated by my window manager.
87cd516f	400
54f11a66 TC	401	Grabbing a window with other windows overlaying it will capture the
	402	content of those windows where they hide the window you want to
	403	capture. You may want to raise the window to top. This may be a
	404	security concern if the overlapping windows contain any sensitive
	405	information - true for any screen capture.
	406
967e4c21 TC	407	=head1 LICENSE
	408
	409	Imager::Screenshot is licensed under the same terms as Perl itself.
	410
33f803d8 TC	411	=head1 TODO
	412
	413	Future plans include:
	414
	415	=over
	416
	417	=item *
	418
33f803d8 TC	419	window name searches - currently screenshot() requires a window
	420	identifier of some sort, it would be more usable if we could supply
	421	some other identifier, either a window title or a window class name.
	422
	423	=back
	424
967e4c21 TC	425	=head1 AUTHOR
	426
	427	Tony Cook <tonyc@cpan.org>
	428
	429	=cut
	430
	431