polish/test darwin support

diff --git a/Changes b/Changes
index 3a1fa7f433a68b602457c2bcb90c6618d247ee5e..09a7f941447dd8e5dea5af37ee50b489aabc48a1 100755 (executable)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+0.009_001
+
+- add Darwin (Apple Mac OS X) support
+
+- test release to see how broken it is
+
 0.009 15 Jun 2010
 
 - check for Win32 support with Devel::CheckLib if we don't find them

diff --git a/MANIFEST b/MANIFEST
index 6b7b8f1c94a97ba31ca399b235b1362775cbdc1c..e4b7769a26f4d65d9196c19a6f648e562e7abf38 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -10,6 +10,7 @@ ppport.h                      Support older perls
 README
 Screenshot.pm                  Main perl implementation
 Screenshot.xs                  Interface to C code
+scdarwin.c                     Darwin implementation
 scwin32.c                      Win32 implementation
 scx11.c                                X11 implementation
 t/00load.t                     Test - can we load the modules
@@ -17,6 +18,7 @@ t/10win32.t                   Test - win32 implementation
 t/20x11.t                      Test - X11 implementation
 t/30tkx11.t                    Test - X11 implementation via Tk
 t/40tkwin32.t                  Test - Win32 implementation via Tk
+t/50darwin.t                   Test - Darwin implementation
 t/90pod.t                      Test - check POD is valid
 t/91podcover.t                 Test - check all functions are covered by POD
 t/92manifest.t                 Test - check we match the MANIFEST

diff --git a/Makefile.PL b/Makefile.PL
index 81388802bc94f83ce996e432e89335d230314b5f..b1f9a8bea24d4578ad1d1678b3fa9bf2ec4ac04b 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -43,6 +43,7 @@ if (find_header('windows.h', "Win32 header")
 }
 
 if ($^O eq "darwin") {
+  # this test is overly simple
   push @objs, "scdarwin.o";
   push @cflags, "-DSS_DARWIN";
   push @lddlflags, qw/-framework OpenGL -framework Cocoa/;
@@ -68,7 +69,7 @@ my %opts =
    VERSION_FROM => 'Screenshot.pm',
    OBJECT => "@objs",
    PREREQ_PM => {
-                'Imager'    => 0.54,
+                'Imager'    => 0.69,
                },
    INC => Imager::ExtUtils->includes,
    TYPEMAPS => [ Imager::ExtUtils->typemap ],
@@ -81,7 +82,7 @@ if (@lddlflags) {
   $opts{LDDLFLAGS} = $Config{lddlflags} . " @lddlflags";
 }
 
-# avoid "... isn't numberic in numeric gt ..." warnings for dev versions
+# avoid "... isn't numeric in numeric gt ..." warnings for dev versions
 my $eu_mm_version = eval $ExtUtils::MakeMaker::VERSION;
 if ($eu_mm_version > 6.06) {
   $opts{AUTHOR} = 'Tony Cook <tonyc@cpan.org>';
@@ -100,11 +101,11 @@ if ($eu_mm_version >= 6.46) {
     {
      configure_requires => 
      {
-      Imager => "0.54"
+      Imager => "0.69"
      },
      build_requires => 
      {
-      Imager => "0.54",
+      Imager => "0.69",
       "Test::More" => "0.47",
      }
     };

diff --git a/README b/README
index eef6fe8c69a4d8e0675d804852b77a2b7bde5f7b..d0ccb6f72efc81857bcca3d8e7ccfac72107e60b 100755 (executable)
--- a/README
+++ b/README
@@ -7,6 +7,8 @@ Requires:
     SDK header files and libraries for Win32 support
   and/or
     X11 header files and libraries for X11 support.
+  and/or
+    OS X header files and libraries (supplied with Xcode)
   A C compiler compatible with that used to build perl itself.
 
 Optional:
@@ -26,6 +28,7 @@ Tested under:
  - Win32 (mingw)
  - Win32/X11 (cygwin as of Jan 1 2007)
  - X11 (Debian Linux)
+ - Mac OS X 10.6.4.
 
 License:
 

diff --git a/Screenshot.pm b/Screenshot.pm
index 768c6a97d07361c152ef6ec226c9f95761570061..6508fd63fdb456c775da76a223184729cd2667e6 100644 (file)
--- a/Screenshot.pm
+++ b/Screenshot.pm
@@ -50,6 +50,11 @@ sub screenshot {
     $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;
@@ -108,6 +113,10 @@ sub have_x11 {
   defined &_x11;
 }
 
+sub have_darwin {
+  defined &_darwin;
+}
+
 sub x11_open {
   my $display = _x11_open(@_);
   unless ($display) {
@@ -153,6 +162,9 @@ Imager::Screenshot - screenshot to an Imager image
   # test for x11 support
   if (Imager::Screenshot->have_x11) { ... }
   
+  # test for Darwin (Mac OS X) support
+  if (Imager::Screenshot->have_darwin) { ... }
+  
 
 =head1 DESCRIPTION
 
@@ -184,6 +196,20 @@ 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>
@@ -209,6 +235,10 @@ 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 *
@@ -270,6 +300,10 @@ Returns true if Win32 support is available.
 
 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>
@@ -328,8 +362,12 @@ 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.
+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
@@ -355,12 +393,6 @@ Future plans include:
 
 =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.

diff --git a/scdarwin.c b/scdarwin.c
index 30512d06d76f8826ae4f042b225d1d8cc11f393b..5eca0f172eec38e654af072200b2841abe2ea800 100644 (file)
--- a/scdarwin.c
+++ b/scdarwin.c
@@ -32,6 +32,10 @@ imss_darwin(i_img_dim left, i_img_dim top, i_img_dim right, i_img_dim bottom) {
   i_clear_error();
 
   disp = CGMainDisplayID();
+  if (!disp) {
+    i_push_error(0, "No main display");
+    return NULL;
+  }
   
   /* for now, only interested in the first display */
   rect = CGDisplayBounds(disp);
@@ -75,7 +79,7 @@ imss_darwin(i_img_dim left, i_img_dim top, i_img_dim right, i_img_dim bottom) {
     return NULL;
   }
   if (!npix) {
-    i_push_error(0, "No pixel format found");
+    i_push_error(0, "No pixel format found - hidden display?");
     return NULL;
   }
 
@@ -112,7 +116,7 @@ imss_darwin(i_img_dim left, i_img_dim top, i_img_dim right, i_img_dim bottom) {
 
     glReadBuffer(GL_FRONT);
     glReadPixels(left, screen_height - top - height, width, height,
-                GL_BGRA, GL_UNSIGNED_INT_8_8_8_8_REV, buf);
+                GL_RGBA, GL_UNSIGNED_BYTE, buf);
 
     /* transfer */
     while (y >= 0) {
@@ -122,6 +126,12 @@ imss_darwin(i_img_dim left, i_img_dim top, i_img_dim right, i_img_dim bottom) {
     }
     
     free(buf);
+
+    i_tags_setn(&im->tags, "ss_window_width", width);
+    i_tags_setn(&im->tags, "ss_window_height", height);
+    i_tags_set(&im->tags, "ss_type", "Darwin", 6);
+    i_tags_setn(&im->tags, "ss_left", left);
+    i_tags_setn(&im->tags, "ss_top", top);
   }
 
   /* clean up */

diff --git a/t/50darwin.t b/t/50darwin.t
new file mode 100644 (file)
index 0000000..0a2d46b
--- /dev/null
+++ b/t/50darwin.t
@@ -0,0 +1,35 @@
+#!perl -w
+use strict;
+use Test::More;
+
+use Imager::Screenshot 'screenshot';
+
+++$|;
+
+Imager::Screenshot->have_darwin
+  or plan skip_all => "No darwin support";
+
+my $im = screenshot(darwin => 0, right => 1, bottom => 1);
+unless ($im) {
+  my $err = Imager->errstr;
+  $err =~ /No pixel format found/
+    or plan skip_all => "Probably an inactive user";
+  $err =~ /No main display/
+    or plan skip_all => "User doen't have a display";
+}
+
+plan tests => 7;
+
+{
+  my $im = screenshot(darwin => 0);
+  ok($im, "got an image");
+  is($im->getchannels, 3, "we have some color");
+
+  is($im->tags(name => "ss_window_width"), $im->getwidth,
+     "check ss_window_width tag");
+  is($im->tags(name => 'ss_window_height'), $im->getheight,
+     "check ss_window_height tag");
+  is($im->tags(name => 'ss_left'), 0, "check ss_left tag");
+  is($im->tags(name => 'ss_top'), 0, "check ss_top tag");
+  is($im->tags(name => 'ss_type'), 'Darwin', "check ss_type tag");
+}