[cairo-commit] cairo-perl Cairo.pm, 1.6, 1.7 Cairo.xs, 1.7,
1.8 ChangeLog, 1.13, 1.14 MakeHelper.pm, 1.3, 1.4 Makefile.PL,
1.10, 1.11 cairo-perl.h, 1.6, 1.7 cairo-perl.typemap, 1.3, 1.4
Torsten Schoenfeld
commit at pdx.freedesktop.org
Sun Jan 8 09:06:32 PST 2006
Committed by: tsch
Update of /cvs/cairo/cairo-perl
In directory gabe:/tmp/cvs-serv25763
Modified Files:
Cairo.pm Cairo.xs ChangeLog MakeHelper.pm Makefile.PL
cairo-perl.h cairo-perl.typemap
Log Message:
* Cairo.pm: Make DynaLoader export all our symbols.
* Cairo.xs, MakeHelper.pm, Makefile.PL, cairo-perl.h: Revamp the
type conversion API. Instead of implementing everything in the
typemap, we now have macros like newSVCairoPattern SvCairoPattern.
These get exported, so other modules can make use of them.
* cairo-perl.h: Remove the DBG macro.
* cairo-perl.typemap: Use T_UV instead of T_IV for cairo_bool_t.
Index: Cairo.pm
===================================================================
RCS file: /cvs/cairo/cairo-perl/Cairo.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- Cairo.pm 31 Aug 2005 22:32:09 -0000 1.6
+++ Cairo.pm 8 Jan 2006 17:06:29 -0000 1.7
@@ -16,6 +16,8 @@
our $VERSION = '0.02';
+sub dl_load_flags { $^O eq 'darwin' ? 0x00 : 0x01 }
+
Cairo->bootstrap ($VERSION);
# --------------------------------------------------------------------------- #
Index: Cairo.xs
===================================================================
RCS file: /cvs/cairo/cairo-perl/Cairo.xs,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- Cairo.xs 10 Aug 2005 17:01:53 -0000 1.7
+++ Cairo.xs 8 Jan 2006 17:06:29 -0000 1.8
@@ -41,6 +41,44 @@
/* ------------------------------------------------------------------------- */
+void *
+cairo_object_from_sv (SV *sv, const char *package)
+{
+ if (!SvOK (sv) || !SvROK (sv) || !sv_derived_from (sv, package))
+ croak("Cannot convert scalar 0x%x to an object of type %s",
+ sv, package);
+ return INT2PTR (void *, SvIV ((SV *) SvRV (sv)));
+}
+
+SV *
+cairo_object_to_sv (void *object, const char *package)
+{
+ SV *sv = newSV (0);
+ sv_setref_pv(sv, package, object);
+ return sv;
+}
+
+/* ------------------------------------------------------------------------- */
+
+void *
+cairo_struct_from_sv (SV *sv, const char *package)
+{
+ if (!SvOK (sv) || !SvROK (sv) || !sv_derived_from (sv, package))
+ croak("Cannot convert scalar 0x%x to a struct of type %s",
+ sv, package);
+ return INT2PTR (void *, SvIV ((SV *) SvRV (sv)));
+}
+
+SV *
+cairo_struct_to_sv (void *object, const char *package)
+{
+ SV *sv = newSV (0);
+ sv_setref_pv(sv, package, object);
+ return sv;
+}
+
+/* ------------------------------------------------------------------------- */
+
SV *
newSVCairoFontExtents (cairo_font_extents_t * extents)
{
Index: ChangeLog
===================================================================
RCS file: /cvs/cairo/cairo-perl/ChangeLog,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- ChangeLog 31 Aug 2005 22:32:09 -0000 1.13
+++ ChangeLog 8 Jan 2006 17:06:29 -0000 1.14
@@ -1,3 +1,16 @@
+2006/01/08 tsch
+
+ * Cairo.pm: Make DynaLoader export all our symbols.
+
+ * Cairo.xs, MakeHelper.pm, Makefile.PL, cairo-perl.h: Revamp the
+ type conversion API. Instead of implementing everything in the
+ typemap, we now have macros like newSVCairoPattern SvCairoPattern.
+ These get exported, so other modules can make use of them.
+
+ * cairo-perl.h: Remove the DBG macro.
+
+ * cairo-perl.typemap: Use T_UV instead of T_IV for cairo_bool_t.
+
2005/09/01 tsch
* Cairo.pm, MANIFEST, Makefile.PL, NEWS, README: Release 0.02.
Index: MakeHelper.pm
===================================================================
RCS file: /cvs/cairo/cairo-perl/MakeHelper.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- MakeHelper.pm 31 Aug 2005 22:00:15 -0000 1.3
+++ MakeHelper.pm 8 Jan 2006 17:06:29 -0000 1.4
@@ -14,6 +14,8 @@
our $autogen_dir = '.';
+# --------------------------------------------------------------------------- #
+
# copied/borrowed from Gtk2-Perl's CodeGen
sub write_boot
{
@@ -62,12 +64,14 @@
close $file;
}
+# --------------------------------------------------------------------------- #
+
sub do_typemaps
{
my %objects = %{shift ()};
my %structs = %{shift ()};
my %enums = %{shift ()};
- my %backend_macros = %{shift()};
+ my %backend_macros = %{shift ()};
my $cairo_perl = File::Spec->catfile ($autogen_dir,
'cairo-perl-auto.typemap');
@@ -98,90 +102,55 @@
foreach (keys %objects, keys %structs, keys %enums)
{
- print TYPEMAP "$_\t".type_id ($_)."\n";
- print TYPEMAP "const $_\t".type_id ($_)."\n";
+ print TYPEMAP "$_\tT_CAIROPERL_GENERIC_WRAPPER\n";
}
- foreach (keys %objects)
+ foreach (keys %objects, keys %structs)
{
my $trunk = $_;
$trunk =~ s/ \*//;
- print TYPEMAP "${trunk}_noinc *\t".type_id ($_)."_NOINC\n";
+ print TYPEMAP "const $_\tT_CAIROPERL_GENERIC_WRAPPER\n";
+ print TYPEMAP "${trunk}_ornull *\tT_CAIROPERL_GENERIC_WRAPPER\n";
+ print TYPEMAP "const ${trunk}_ornull *\tT_CAIROPERL_GENERIC_WRAPPER\n";
}
- print TYPEMAP "\nINPUT\n\n";
-
foreach (keys %objects)
{
- print TYPEMAP type_id ($_).'
- if (sv_derived_from($arg, \"'.$objects{$_}.'\")) {
- IV tmp = SvIV((SV*)SvRV($arg));
- $var = INT2PTR($type,tmp);
- }
- else
- Perl_croak(aTHX_ \"$var is not of type '.$objects{$_}.'\")
-
-';
- }
-
- foreach (keys %structs)
- {
- print TYPEMAP type_id ($_).'
- if (sv_derived_from($arg, \"'.$structs{$_}.'\")) {
- IV tmp = SvIV((SV*)SvRV($arg));
- $var = INT2PTR($type,tmp);
- }
- else
- Perl_croak(aTHX_ \"$var is not of type '.$structs{$_}.'\")
-
-';
- }
-
- foreach (keys %enums)
- {
- print TYPEMAP type_id ($_).'
- $var = cairo_'.func_name ($_).'_from_sv ($arg);
+ my $trunk = $_;
+ $trunk =~ s/ \*//;
-';
+ print TYPEMAP "${trunk}_noinc *\tT_CAIROPERL_GENERIC_WRAPPER\n";
}
- print TYPEMAP "\nOUTPUT\n\n";
-
- my $ref;
- foreach (keys %objects)
- {
- /^(.*)_t \*/;
- $ref = $1.'_reference';
- print TYPEMAP type_id ($_)."
- $ref (".'$var);
- sv_setref_pv($arg, \"'.$objects{$_}.'\", (void*)$var);
-
-';
- print TYPEMAP type_id ($_).'_NOINC
- sv_setref_pv($arg, \"'.$objects{$_}.'\", (void*)$var);
+ my $conversion_code = ';
+ (my $ntype = $type) =~ s/(?:const\s+)?([:\w]+)(?:\s*\*)$/$1/x;
+ my $result = $type;
+ if ($ntype =~ m/(.+)_t(_.+)?/) {
+ my ($name, $options) = ($1, $2);
+ $name =~ s/([^_]+)/ucfirst $1/ge;
+ $name =~ s/_//g;
+ $result = $name . $options;
+ }
+ \$result';
-';
- }
+ print TYPEMAP <<"EOS";
- foreach (keys %structs)
- {
- print TYPEMAP type_id ($_).'
- sv_setref_pv($arg, \"'.$structs{$_}.'\", (void*)$var);
+INPUT
-';
- }
+T_CAIROPERL_GENERIC_WRAPPER
+ \$var = Sv\${$conversion_code} (\$arg);
- foreach (keys %enums)
- {
- print TYPEMAP type_id ($_).'
- $arg = cairo_'.func_name ($_).'_to_sv ($var);
+OUTPUT
-';
- }
+T_CAIROPERL_GENERIC_WRAPPER
+ \$arg = newSV\${$conversion_code} (\$var);
+EOS
close TYPEMAP;
+ # ------------------------------------------------------------------- #
+
my $header = File::Spec->catfile ($autogen_dir,
'cairo-perl-auto.h');
open HEADER, '>', $header
@@ -193,26 +162,105 @@
*/
#include <cairo.h>
-
EOS
+ sub mangle
+ {
+ my $mangled = shift;
+ $mangled =~ s/_t$//;
+ $mangled =~ s/([^_]+)/ucfirst $1/ge;
+ $mangled =~ s/_//g;
+ return $mangled;
+ }
+
+ sub reference
+ {
+ my $ref = shift;
+ $ref =~ s/_t$//;
+ $ref .= '_reference';
+ return $ref;
+ }
+
+ sub name
+ {
+ $_[0] =~ /cairo_(\w+)_t/;
+ return $1;
+ }
+
+ # ------------------------------------------------------------------- #
+
+ print HEADER "\n/* objects */\n\n";
+
foreach (keys %objects)
{
- /^(.*) \*/;
- if (exists $backend_macros{$1}) {
- print HEADER "#ifdef $backend_macros{$1}\n";
+ /^(.+) \*/;
+ my $type = $1;
+ my $mangled = mangle ($type);
+ my $ref = reference ($type);
+
+ if (exists $backend_macros{$type}) {
+ print HEADER "#ifdef $backend_macros{$type}\n";
}
- print HEADER "typedef $1 ${1}_noinc;\n";
- if (exists $backend_macros{$1}) {
- print HEADER "#endif\n";
+
+ print HEADER <<"EOS";
+typedef $type ${type}_noinc;
+typedef $type ${type}_ornull;
+#define Sv$mangled(sv) (($type *) cairo_object_from_sv (sv, "$objects{$_}"))
+#define Sv${mangled}_ornull(sv) (((sv) && SvOK (sv)) ? Sv$mangled(sv) : NULL)
+#define newSV$mangled(object) (cairo_object_to_sv (($type *) $ref (object), "$objects{$_}"))
+#define newSV${mangled}_noinc(object) (cairo_object_to_sv (($type *) object, "$objects{$_}"))
+#define newSV${mangled}_ornull(object) (((object) == NULL) ? &PL_sv_undef : newSV$mangled(object))
+EOS
+
+ if (exists $backend_macros{$type}) {
+ print HEADER "#endif /* $backend_macros{$type} */\n";
}
}
+ # ------------------------------------------------------------------- #
+
+ print HEADER "\n/* structs */\n\n";
+
+ foreach (keys %structs)
+ {
+ /^(.+) \*/;
+ my $type = $1;
+ my $mangled = mangle ($type);
+
+ print HEADER <<"EOS";
+typedef $type ${type}_ornull;
+#define Sv$mangled(sv) (($type *) cairo_struct_from_sv (sv, "$structs{$_}"))
+#define Sv${mangled}_ornull(sv) (((sv) && SvOK (sv)) ? Sv$mangled(sv) : NULL)
+#define newSV$mangled(struct) (cairo_struct_to_sv (($type *) struct, "$structs{$_}"))
+#define newSV${mangled}_ornull(struct) (((struct) == NULL) ? &PL_sv_undef : newSV$mangled(struct))
+EOS
+ }
+
+ # ------------------------------------------------------------------- #
+
+ print HEADER "\n/* enums */\n\n";
+
+ foreach (keys %enums)
+ {
+ my $type = $_;
+ my $mangled = mangle ($type);
+ my $name = name ($type);
+
+ print HEADER <<"EOS";
+int cairo_${name}_from_sv (SV * $name);
+SV * cairo_${name}_to_sv (int val);
+#define Sv$mangled(sv) (cairo_${name}_from_sv (sv))
+#define newSV$mangled(val) (cairo_${name}_to_sv (val))
+EOS
+ }
+
close HEADER;
return ($cairo_perl);
}
+# --------------------------------------------------------------------------- #
+
sub do_enums
{
my %enums = %{shift ()};
@@ -221,12 +269,6 @@
open ENUMS, '>', $cairo_enums
or die "unable to open ($cairo_enums) for output";
- sub name
- {
- $_[0] =~ /cairo_(\w+)_t/;
- $1;
- }
-
print ENUMS "
/*
* This file was automatically generated. Do not edit.
@@ -298,24 +340,10 @@
$str;
}
- open HDR, '>', "$autogen_dir/cairo-perl-enums.h";
- print HDR "/*
- * This file was automatically generated. Do not edit.
- */
-
-#ifndef _CAIRO_PERL_ENUMS_H_
-#define _CAIRO_PERL_ENUMS_H_
-";
-
foreach (keys %enums)
{
my $name = name ($_);
- print HDR "
-int cairo_".$name."_from_sv (SV * $name);
-SV * cairo_".$name."_to_sv (int val);
-";
-
print ENUMS 'int
cairo_'.$name.'_from_sv (SV * '.$name.')
{
@@ -338,10 +366,6 @@
';
}
- print HDR "
-#endif /* _CAIRO_PERL_ENUMS_H_ */\n";
- close HDR;
-
close ENUMS;
}
Index: Makefile.PL
===================================================================
RCS file: /cvs/cairo/cairo-perl/Makefile.PL,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- Makefile.PL 31 Aug 2005 22:32:09 -0000 1.10
+++ Makefile.PL 8 Jan 2006 17:06:29 -0000 1.11
@@ -208,7 +208,6 @@
$dep->install (qw(cairo-perl.h
cairo-perl.typemap
- build/cairo-perl-enums.h
build/cairo-perl-auto.h
build/cairo-perl-auto.typemap));
$dep->save_config ('build/IFiles.pm');
Index: cairo-perl.h
===================================================================
RCS file: /cvs/cairo/cairo-perl/cairo-perl.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- cairo-perl.h 12 Jul 2005 20:29:47 -0000 1.6
+++ cairo-perl.h 8 Jan 2006 17:06:29 -0000 1.7
@@ -28,7 +28,14 @@
# include <cairo-pdf.h>
#endif
-#include <cairo-perl-enums.h>
+/*
+ * standard object and struct handling
+ */
+void *cairo_object_from_sv (SV *sv, const char *package);
+SV *cairo_object_to_sv (void *object, const char *package);
+
+void *cairo_struct_from_sv (SV *sv, const char *package);
+SV *cairo_struct_to_sv (void *object, const char *package);
/*
* custom struct handling
@@ -78,14 +85,14 @@
#include <cairo-perl-auto.h>
-/* XXX: copied/borrowed from gtk2-perl
- *
- * call the boot code of a module by symbol rather than by name.
+/* call the boot code of a module by symbol rather than by name.
*
* in a perl extension which uses several xs files but only one pm, you
* need to bootstrap the other xs files in order to get their functions
* exported to perl. if the file has MODULE = Foo::Bar, the boot symbol
* would be boot_Foo__Bar.
+ *
+ * copied/borrowed from gtk2-perl.
*/
void _cairo_perl_call_XS (pTHX_ void (*subaddr) (pTHX_ CV *), CV * cv, SV ** mark);
#define CAIRO_PERL_CALL_BOOT(name) \
@@ -96,10 +103,4 @@
#define CAIRO_PERL_UNUSED(var) if (0) { (var) = (var); }
-#ifdef CAIRO_DEBUG
-# define DBG(format, args...) fprintf (stderr, format , ## args)
-#else
-# define DBG
-#endif
-
#endif /* _CAIRO_PERL_H_ */
Index: cairo-perl.typemap
===================================================================
RCS file: /cvs/cairo/cairo-perl/cairo-perl.typemap,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- cairo-perl.typemap 29 Jul 2005 17:19:55 -0000 1.3
+++ cairo-perl.typemap 8 Jan 2006 17:06:29 -0000 1.4
@@ -8,7 +8,7 @@
TYPEMAP
-cairo_bool_t T_IV
+cairo_bool_t T_UV
cairo_font_extents_t * T_CAIRO_FONT_EXTENTS
cairo_text_extents_t * T_CAIRO_TEXT_EXTENTS
More information about the cairo-commit
mailing list