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