[perl-Gtk3] Provide GdkPixbuf bindings under Gtk3::Gdk::Pixbuf

[Torsten SchÃnfeld <tsch src gnome org>]

commit 401b78e975e7f9b9c1438fd45645f3174d28f0df
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Sat Feb 18 22:28:19 2012 +0100

    Provide GdkPixbuf bindings under Gtk3::Gdk::Pixbuf

 NEWS          |    5 +-
 lib/Gtk3.pm   |  149 ++++++++++++++++++++++++++++++++++++++++++++++++++-------
 t/overrides.t |   53 ++++++++++++++++++++-
 3 files changed, 187 insertions(+), 20 deletions(-)
---
diff --git a/NEWS b/NEWS
index 2a2f085..8fc89de 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,6 @@
 {{$NEXT}}
 
+* Provide GdkPixbuf bindings under Gtk3::Gdk::Pixbuf.
 * Make Gtk3::[HV]Box::new provide default arg values.
 * Make Gtk3::Gdk::Window::new construct the mask automatically if none is
   given.
@@ -16,8 +17,8 @@ Overview of changes in Gtk3 0.003 [2012-01-14]
 Overview of changes in Gtk3 0.002 [2011-12-09]
 ==============================================
 
-* Add more overrides for the tree objects
-* Fix a test failure (RT #72773)
+* Add more overrides for the tree objects.
+* Fix a test failure.  (RT #72773)
 
 Overview of changes in Gtk3 0.001 [2011-10-14]
 ==============================================
diff --git a/lib/Gtk3.pm b/lib/Gtk3.pm
index ec41813..43b13b6 100644
--- a/lib/Gtk3.pm
+++ b/lib/Gtk3.pm
@@ -38,10 +38,18 @@ my @_GTK_HANDLE_SENTINEL_BOOLEAN_FOR = qw/
   Gtk3::TreeSelection::get_selected
 /;
 
+my @_GDK_PIXBUF_FLATTEN_ARRAY_REF_RETURN_FOR = qw/
+  Gtk3::Gdk::Pixbuf::get_formats
+/;
+
 my $_GDK_BASENAME = 'Gdk';
 my $_GDK_VERSION = '3.0';
 my $_GDK_PACKAGE = 'Gtk3::Gdk';
 
+my $_GDK_PIXBUF_BASENAME = 'GdkPixbuf';
+my $_GDK_PIXBUF_VERSION = '2.0';
+my $_GDK_PIXBUF_PACKAGE = 'Gtk3::Gdk';
+
 my $_PANGO_BASENAME = 'Pango';
 my $_PANGO_VERSION = '1.0';
 my $_PANGO_PACKAGE = 'Pango';
@@ -63,6 +71,12 @@ sub import {
     package => $_GDK_PACKAGE);
 
   Glib::Object::Introspection->setup (
+    basename => $_GDK_PIXBUF_BASENAME,
+    version => $_GDK_PIXBUF_VERSION,
+    package => $_GDK_PIXBUF_PACKAGE,
+    flatten_array_ref_return_for => \ _GDK_PIXBUF_FLATTEN_ARRAY_REF_RETURN_FOR);
+
+  Glib::Object::Introspection->setup (
     basename => $_PANGO_BASENAME,
     version => $_PANGO_VERSION,
     package => $_PANGO_PACKAGE);
@@ -289,6 +303,98 @@ sub Gtk3::Gdk::Window::new {
     $class, $parent, $attr, $attr_mask);
 }
 
+# GdkPixbuf
+
+sub Gtk3::Gdk::Pixbuf::get_pixels {
+  my $pixel_aref = Glib::Object::Introspection->invoke (
+    $_GDK_PIXBUF_BASENAME, 'Pixbuf', 'get_pixels', @_);
+  return pack 'C*', @{$pixel_aref};
+}
+
+sub Gtk3::Gdk::Pixbuf::new_from_data {
+  my ($class, $data, $colorspace, $has_alpha, $bits_per_sample, $width, $height, $rowstride) = @_;
+  # FIXME: do we need to keep $real_data alive and then release it in a destroy
+  # notify callback?
+  my $real_data;
+  {
+    local $@;
+    $real_data = (eval { @{$data} })
+               ? $data
+               : [unpack 'C*', $data];
+  }
+  return Glib::Object::Introspection->invoke (
+    $_GDK_PIXBUF_BASENAME, 'Pixbuf', 'new_from_data',
+    $class, $real_data, $colorspace, $has_alpha, $bits_per_sample, $width, $height, $rowstride,
+    undef, undef);
+}
+
+sub Gtk3::Gdk::Pixbuf::new_from_inline {
+  my ($class, $data, $copy_pixels) = @_;
+  $copy_pixels = Glib::TRUE unless defined $copy_pixels;
+  my $real_data;
+  {
+    local $@;
+    $real_data = (eval { @{$data} })
+               ? $data
+               : [unpack 'C*', $data];
+  }
+  return Glib::Object::Introspection->invoke (
+    $_GDK_PIXBUF_BASENAME, 'Pixbuf', 'new_from_inline',
+    $class, $real_data, $copy_pixels);
+}
+
+sub Gtk3::Gdk::Pixbuf::new_from_xpm_data {
+  my ($class, @data) = @_;
+  my $real_data;
+  {
+    local $@;
+    $real_data = (@data == 1 && eval { @{$data[0]} })
+               ? $data[0]
+               : \ data;
+  }
+  return Glib::Object::Introspection->invoke (
+    $_GDK_PIXBUF_BASENAME, 'Pixbuf', 'new_from_xpm_data',
+    $class, $real_data);
+}
+
+sub Gtk3::Gdk::Pixbuf::save {
+  my ($pixbuf, $filename, $type, @rest) = @_;
+  my ($keys, $values) = _unpack_columns_and_values (\ rest);
+  if (not defined $keys) {
+    croak ('Usage: $pixbuf->save ($filename, $type, \ keys, \ values)',
+           ' -or-: $pixbuf->save ($filename, $type, $key1 => $value1, ...)');
+  }
+  Glib::Object::Introspection->invoke (
+    $_GDK_PIXBUF_BASENAME, 'Pixbuf', 'save',
+    $pixbuf, $filename, $type, $keys, $values);
+}
+
+sub Gtk3::Gdk::Pixbuf::save_to_buffer {
+  my ($pixbuf, $type, @rest) = @_;
+  my ($keys, $values) = _unpack_columns_and_values (\ rest);
+  if (not defined $keys) {
+    croak ('Usage: $pixbuf->save_to_buffer ($type, \ keys, \ values)',
+           ' -or-: $pixbuf->save_to_buffer ($type, $key1 => $value1, ...)');
+  }
+  my (undef, $buffer) =
+    Glib::Object::Introspection->invoke (
+      $_GDK_PIXBUF_BASENAME, 'Pixbuf', 'save_to_buffer',
+      $pixbuf, $type, $keys, $values);
+  return $buffer;
+}
+
+sub Gtk3::Gdk::Pixbuf::save_to_callback {
+  my ($pixbuf, $save_func, $user_data, $type, @rest) = @_;
+  my ($keys, $values) = _unpack_columns_and_values (\ rest);
+  if (not defined $keys) {
+    croak ('Usage: $pixbuf->save_to_callback ($save_func, $user_data, $type, \ keys, \ values)',
+           ' -or-: $pixbuf->save_to_callback ($save_func, $user_data, $type, $key1 => $value1, ...)');
+  }
+  Glib::Object::Introspection->invoke (
+    $_GDK_PIXBUF_BASENAME, 'Pixbuf', 'save_to_callback',
+    $pixbuf, $save_func, $user_data, $type, $keys, $values);
+}
+
 # - Helpers ----------------------------------------------------------------- #
 
 sub _common_tree_model_new {
@@ -307,34 +413,43 @@ sub _common_tree_model_new {
 
 sub _common_tree_model_set {
   my ($package, $model, $iter, @columns_and_values) = @_;
+  my ($columns, $values) = _unpack_columns_and_values (\ columns_and_values);
+  if (not defined $columns) {
+    croak ('Usage: Gtk3::${package}::set ($store, \ columns, \ values)',
+           ' -or-: Gtk3::${package}::set ($store, $column1 => $value1, ...)');
+  }
+  my @wrapped_values = ();
+  foreach my $i (0..$#{$columns}) {
+    my $column_type = $model->get_column_type ($columns->[$i]);
+    push @wrapped_values,
+         Glib::Object::Introspection::GValueWrapper->new (
+           $column_type, $values->[$i]);
+  }
+  Glib::Object::Introspection->invoke (
+    $_GTK_BASENAME, $package, 'set',
+    $model, $iter, $columns, \ wrapped_values);
+}
+
+sub _unpack_columns_and_values {
+  my ($columns_and_values) = @_;
   my (@columns, @values);
   my $have_array_refs;
   {
     local $@;
     $have_array_refs =
-      @columns_and_values == 2 && eval { @{$columns_and_values[0]} };
+      @$columns_and_values == 2 && eval { @{$columns_and_values->[0]} };
   }
   if ($have_array_refs) {
-    @columns = @{$columns_and_values[0]};
-    @values = @{$columns_and_values[1]};
-  } elsif (@columns_and_values % 2 == 0) {
-    my %cols_to_vals = @columns_and_values;
+    @columns = @{$columns_and_values->[0]};
+    @values = @{$columns_and_values->[1]};
+  } elsif (@$columns_and_values % 2 == 0) {
+    my %cols_to_vals = @$columns_and_values;
     @columns = keys %cols_to_vals;
     @values = values %cols_to_vals;
   } else {
-    croak ('Usage: Gtk3::${package}::set ($store, \ columns, \ values)',
-           ' -or-: Gtk3::${package}::set ($store, $column1 => $value1, ...)');
+    return ();
   }
-  my @wrapped_values = ();
-  foreach my $i (0..$#columns) {
-    my $column_type = $model->get_column_type ($columns[$i]);
-    push @wrapped_values,
-         Glib::Object::Introspection::GValueWrapper->new (
-           $column_type, $values[$i]);
-  }
-  Glib::Object::Introspection->invoke (
-    $_GTK_BASENAME, $package, 'set',
-    $model, $iter, \ columns, \ wrapped_values);
+  return (\ columns, \ values);
 }
 
 1;
diff --git a/t/overrides.t b/t/overrides.t
index b922256..18e73e0 100644
--- a/t/overrides.t
+++ b/t/overrides.t
@@ -5,7 +5,7 @@ BEGIN { require './t/inc/setup.pl' };
 use strict;
 use warnings;
 
-plan tests => 51;
+plan tests => 59;
 
 # Gtk3::CHECK_VERSION and check_version
 {
@@ -205,3 +205,54 @@ SKIP: {
   });
   isa_ok ($window, 'Gtk3::Gdk::Window');
 }
+
+# Gtk3::Gdk::Pixbuf::get_formats
+{
+  my @formats = Gtk3::Gdk::Pixbuf->get_formats;
+  isa_ok (ref $formats[0], 'Gtk3::Gdk::PixbufFormat');
+}
+
+# Gtk3::Gdk::Pixbuf::save, save_to_buffer, save_to_callback
+SKIP: {
+  # FIXME: https://bugzilla.gnome.org/show_bug.cgi?id=670372
+  skip 'save & save_to_buffer annotations missing', 7;
+
+  my ($width, $height) = (45, 89);
+  my $data = pack "C*", map { int rand 255 } 0..(3*$width*$height);
+  my $pixbuf = Gtk3::Gdk::Pixbuf->new_from_data
+    ($data, 'rgb', Glib::FALSE, 8, $width, $height, $width*3);
+
+  my $filename = 'testsave.png';
+  eval {
+    $pixbuf->save ($filename, 'png',
+                   'key_arg_without_value_arg');
+  };
+  like ($@, qr/Usage/);
+  my $mtime = scalar localtime;
+  my $desc = 'Something really cool';
+  $pixbuf->save ($filename, 'png',
+                 'tEXt::Thumb::MTime' => $mtime,
+                 'tEXt::Description' => $desc);
+  my $new_pixbuf = Gtk3::Gdk::Pixbuf->new_from_file ($filename);
+  isa_ok ($new_pixbuf, 'Gtk3::Gdk::Pixbuf', 'new_from_file');
+  is ($new_pixbuf->get_option ('tEXt::Description'), $desc);
+  is ($new_pixbuf->get_option ('tEXt::Thumb::MTime'), $mtime);
+  unlink $filename;
+
+  my $buffer = eval {
+    $pixbuf->save_to_buffer ('jpeg', [qw/quality/], [0.75]);
+    $pixbuf->save_to_buffer ('jpeg', quality => 0.75);
+  } || eval {
+    $pixbuf->save_to_buffer ('png'); # fallback if jpeg not supported
+  };
+  ok (defined $buffer, 'save_to_buffer');
+  my $loader = Gtk3::Gdk::PixbufLoader->new;
+  $loader->write ($buffer);
+  $loader->close;
+  $new_pixbuf = $loader->get_pixbuf;
+  is ($new_pixbuf->get_width, $width);
+  is ($new_pixbuf->get_height, $height);
+
+  # FIXME: callbacks with automatic args not supported yet.
+  # $pixbuf->save_to_callback (sub { warn @_; return Glib::TRUE; }, 'data', 'png');
+}