--- OpenCL/gengetinfo	2011/11/22 10:29:18	1.5
+++ OpenCL/gengetinfo	2012/05/04 14:29:35	1.13
@@ -14,6 +14,7 @@
    profiling         Event
    mem               Memory
    image             Image
+   gl_texture	     Image
    sampler           Sampler
    program           Program
    program_build     Program
@@ -78,7 +79,7 @@
    rename "$file~", $file;
 }
 
-for my $CLASS (qw(platform device context command_queue mem image sampler program program_build kernel kernel_work_group event profiling)) {
+for my $CLASS (qw(platform device context command_queue mem image sampler program program_build kernel kernel_work_group event profiling gl_texture)) {
    open my $fh, "<getinfo.txt"
       or die "getinfo.txt: $!";
 
@@ -88,7 +89,7 @@
 
    while (<$fh>) {
       chomp;
-      my ($class, $name, $ctype) = split /,\s*/, $_, 3;
+      my ($class, $name, $ctype) = split /\s*,\s*/, $_, 3;
       next unless $class eq "cl_$CLASS\_info";
       next if $name eq "CL_IMAGE_FORMAT"; # struct
       next if $name eq "CL_PROGRAM_BINARIES"; # needs multiple calls
@@ -98,6 +99,7 @@
 
       my $cbase = $class;
       $cbase =~ s/_(.)/\U$1/g;
+      $cbase =~ s/Gl(?=[A-Z])/GL/g;
       $cbase =~ s/^cl//;
       $cbase =~ s/Info$//;
       $cbase = "MemObject"      if $cbase eq "Mem";
@@ -154,7 +156,9 @@
          $perltype = "\$$perltype";
       }
 
-      $POD .= "=item $perltype = \$$real_class->$perl_name$extra_perl_args\n\nCalls C<clGet${cbase}Info> with C<$name> and returns the result.\n\n";
+      (my $perlenum = $name) =~ s/^CL_/OpenCL::/ or die;
+
+      $POD .= "=item $perltype = \$$real_class->$perl_name$extra_perl_args\n\nCalls C<clGet${cbase}Info> with C<$perlenum> and returns the result.\n\n";
 
       # XS1 contains the function before ALIAS, XS2 the function afterwards (the body)
       # after we generate the bdoy we look for an identical body generated earlier
@@ -162,17 +166,17 @@
       my ($XS1, $XS2);
 
       $XS1 = "void\n"
-           . "XXXNAMEXXX (OpenCL::$classmap{$real_class} this$extra_xs_args)\n";
+           . "XXXNAMEXXX (OpenCL::$classmap{$real_class} self$extra_xs_args)\n";
       $XS2 = " PPCODE:\n";
 
       if ($dynamic) {
         $XS2 .= " size_t size;\n"
-              . " NEED_SUCCESS (Get${cbase}Info, (this$extra_args, ix,    0,     0, &size));\n"
+              . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix,    0,     0, &size));\n"
               . " $type->[0] *value = tmpbuf (size);\n"
-             . " NEED_SUCCESS (Get${cbase}Info, (this$extra_args, ix, size, value,     0));\n";
+             . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, size, value,     0));\n";
       } else {
         $XS2 .= " $type->[0] value [1];\n"
-              . " NEED_SUCCESS (Get${cbase}Info, (this$extra_args, ix, sizeof (value), value, 0));\n";
+              . " NEED_SUCCESS (Get${cbase}Info, (self$extra_args, ix, sizeof (value), value, 0));\n";
       }
       
       if ($array && $nelem ne "1") {
@@ -189,9 +193,13 @@
          $oclass = "MemObject"    if $oclass eq "Memory";
          $oclass = "CommandQueue" if $oclass eq "Queue";
 
+         my $stash = lc $type->[1];
+         $stash =~ s/opencl:://;
+         $stash =~ s/::/_/g;
+
          $XS2 .= " {\n";
-         $XS2 .= "   NEED_SUCCESS (Retain$oclass, (value [i]));\n" unless $1 eq "Platform" || $1 eq "Device";
-         $XS2 .= "   PUSHs (NEW_MORTAL_OBJ (\"$type->[1]\", value [i]));\n";
+         $XS2 .= "   NEED_SUCCESS (Retain$oclass, (value [i]));\n" unless $oclass eq "Platform" || $oclass eq "Device";
+         $XS2 .= "   PUSH_CLOBJ (stash_$stash, value [i]);\n";
          $XS2 .= " }\n";
       } else {
          $XS2 .= " PUSHs (sv_2mortal ($type->[1]));\n";
@@ -222,6 +230,8 @@
       $XS .= join "", @$_;
    }
 
+   warn "patching class $CLASS\n";
+
    patch "OpenCL.xs", "#BEGIN:$CLASS"               , "#END:$CLASS"               , $XS;
    patch "OpenCL.pm", "=for gengetinfo begin $CLASS", "=for gengetinfo end $CLASS", $POD;
 }