? GError.xs ? error.pl ? gperl-gtypes.c ? gperl-gtypes.h Index: ChangeLog =================================================================== RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/ChangeLog,v retrieving revision 1.230 diff -u -r1.230 ChangeLog --- ChangeLog 18 Feb 2004 06:27:28 -0000 1.230 +++ ChangeLog 18 Feb 2004 06:34:39 -0000 @@ -1,3 +1,25 @@ +2004/02/18 01:35 (-0500) muppetman + + A GError.xs + A gperl-gtypes.h + A gperl-gtypes.c + M MANIFEST + M Makefile.PL + M Glib.exports + M Glib.xs + M Glib.pm + M gperl.h + change gperl_croak_gerror() to turn GErrors into exception objects. + the objects overload the stringify operator to be indistinguishable + from normal exceptions, resulting in no API change for old code. + gperl_croak_gerror()'s prefix argument is now useless, and has + been renamed to ignore, but not removed (to retain ABI and source + API compatibility). add gperl_register_error_domain(), and use it + for built-ins. doing this properly requires GEnum GTypes for the + error code enums, which are not provided by GLib, so we provide + just the relevant ones in private files which can be recreated + in the future as needed. + 2004/02/18 01:31 (-0500) muppetman * ParseXSDoc.pm: quell some doc messages unless NOISYDOC is set in Index: Glib.exports =================================================================== RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/Glib.exports,v retrieving revision 1.9 diff -u -r1.9 Glib.exports --- Glib.exports 19 Nov 2003 20:15:41 -0000 1.9 +++ Glib.exports 18 Feb 2004 06:34:39 -0000 @@ -20,7 +20,9 @@ @exports = qw( _gperl_call_XS +gperl_sv_from_gerror gperl_croak_gerror +gperl_register_error_domain gperl_alloc_temp gperl_str_eq gperl_str_hash Index: Glib.pm =================================================================== RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/Glib.pm,v retrieving revision 1.56 diff -u -r1.56 Glib.pm --- Glib.pm 17 Feb 2004 20:26:31 -0000 1.56 +++ Glib.pm 18 Feb 2004 06:34:39 -0000 @@ -80,7 +80,19 @@ '@{}' => \&as_arrayref, '""' => sub { "[ @{$_[0]} ]" }, fallback => 1; - + +package Glib::Error; + +use overload + '""' => sub { $_[0]->message.$_[0]->location }, + fallback => 1; + +sub location { $_[0]->{location} } +sub message { $_[0]->{message} } +sub domain { $_[0]->{domain} } +sub value { $_[0]->{value} } +sub code { $_[0]->{code} } + package Glib::Object::Property; use Carp; Index: Glib.xs =================================================================== RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/Glib.xs,v retrieving revision 1.26 diff -u -r1.26 Glib.xs --- Glib.xs 17 Feb 2004 20:26:31 -0000 1.26 +++ Glib.xs 18 Feb 2004 06:34:39 -0000 @@ -64,59 +64,6 @@ } - -=item void gperl_croak_gerror (const char * prefix, GError * err) - -Croak with the message in I. I may be NULL, but I may not. - -Use this when wrapping a function that uses #GError for reporting runtime -errors. The bindings map the concept of #GError to runtime exceptions; -thus, where a C programmer would wrap a function call with code that -checks for a #GError and bails out when one is found, the perl developer -simply wraps a block of code in an eval(), and the bindings croak() when -a #GError is found. - -Since croak() does not return, this function handles the magic behind -not leaking the memory associated with the #GError. To use this you'd -do something like - - PREINIT: - GError * error = NULL; - CODE: - if (!funtion_that_can_fail (something, &error)) - gperl_croak_gerror (NULL, error); - -it's just that simple! - -=cut -void -gperl_croak_gerror (const char * prefix, GError * err) -{ - /* croak does not return, which doesn't give us the opportunity - * to free the GError. thus, we create a copy of the croak message - * in an SV, which will be garbage-collected, and free the GError - * before croaking. */ - SV * svmsg; - - /* this really could only happen if there's a problem with XS bindings - * so we'll use a assertion to catch it, rather than handle null */ - g_return_if_fail (err != NULL); - - if (prefix && strlen (prefix)) { - svmsg = newSV(0); - sv_catpvf (svmsg, "%s: %s", prefix, err->message); - } else { - svmsg = newSVpv (err->message, 0); - } - /* don't need this */ - g_error_free (err); - /* mark it as ready to be collected */ - sv_2mortal (svmsg); - croak (SvPV_nolen (svmsg)); -} - - - =item gpointer gperl_alloc_temp (int nbytes) Allocate and return a pointer to an I-long temporary buffer that will @@ -163,7 +110,7 @@ * will be the length of the output when this call finishes. */ lname = g_filename_from_utf8 (filename, len, 0, &len, &error); if (!lname) - gperl_croak_gerror (filename, error); + gperl_croak_gerror (NULL, error); filename = gperl_alloc_temp (len + 1); memcpy (filename, lname, len); @@ -186,7 +133,7 @@ gchar *str = g_filename_to_utf8 (filename, -1, NULL, &len, &error); if (!filename) - gperl_croak_gerror (str, error); + gperl_croak_gerror (NULL, error); sv = newSVpv (str, len); g_free (str); @@ -342,6 +289,7 @@ /* boot all in one go. other modules may not want to do it this * way, if they prefer instead to perform demand loading. */ GPERL_CALL_BOOT (boot_Glib__Utils); + GPERL_CALL_BOOT (boot_Glib__Error); GPERL_CALL_BOOT (boot_Glib__Log); GPERL_CALL_BOOT (boot_Glib__Type); GPERL_CALL_BOOT (boot_Glib__Boxed); Index: MANIFEST =================================================================== RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/MANIFEST,v retrieving revision 1.25 diff -u -r1.25 MANIFEST --- MANIFEST 10 Feb 2004 06:38:16 -0000 1.25 +++ MANIFEST 18 Feb 2004 06:34:39 -0000 @@ -6,6 +6,7 @@ GBoxed.xs GClosure.xs GenPod.pm +GError.xs GIOChannel.xs Glib.exports Glib.pm @@ -15,6 +16,8 @@ GObject.xs GParamSpec.xs gperl.h +gperl-gtypes.c +gperl-gtypes.h gperl_marshal.h GSignal.xs GType.xs Index: Makefile.PL =================================================================== RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/Makefile.PL,v retrieving revision 1.41 diff -u -r1.41 Makefile.PL --- Makefile.PL 17 Feb 2004 20:26:31 -0000 1.41 +++ Makefile.PL 18 Feb 2004 06:34:39 -0000 @@ -42,6 +42,7 @@ # appear in Glib::xsapi our @xs_files = qw( Glib.xs + GError.xs GUtils.xs GLog.xs GType.xs @@ -61,7 +62,6 @@ 'GenPod.pm' => '$(INST_LIBDIR)/Glib/GenPod.pm', 'MakeHelper.pm' => '$(INST_LIBDIR)/Glib/MakeHelper.pm', 'devel.pod' => '$(INST_LIBDIR)/Glib/devel.pod', -# 'build/xsapi.pod' => '$(INST_LIBDIR)/Glib/xsapi.pod', ); our %pod_files = ( 'Glib.pm' => '$(INST_MAN3DIR)/Glib.$(MAN3EXT)', @@ -73,7 +73,6 @@ Glib::MakeHelper->do_pod_files (@xs_files), ); - my %glibcfg = ExtUtils::PkgConfig->find ('gobject-2.0 >= '.$build_reqs{Glib}); # optional thread-safety @@ -105,10 +104,11 @@ $glib->set_libs ($glibcfg{libs} . $gthreadcfg{libs}); my $cwd = cwd(); $glib->add_typemaps (map {File::Spec->catfile($cwd,$_)} 'typemap'); -$glib->install (qw(gperl.h gperl_marshal.h doctypes)); -$glib->save_config ('build/IFiles.pm'); $glib->add_pm (%pm_files); $glib->add_xs (@xs_files); +$glib->add_c (qw(gperl-gtypes.c)); +$glib->install (qw(gperl.h gperl_marshal.h doctypes)); +$glib->save_config ('build/IFiles.pm'); # exports list needed for win32, unused on others our @exports; Index: gperl.h =================================================================== RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/gperl.h,v retrieving revision 1.32 diff -u -r1.32 gperl.h --- gperl.h 17 Feb 2004 20:26:31 -0000 1.32 +++ gperl.h 18 Feb 2004 06:34:39 -0000 @@ -57,8 +57,14 @@ _gperl_call_XS (aTHX_ name, cv, mark); \ } +/* it is rare that you should ever want or need this function. */ +SV * gperl_sv_from_gerror (GError * error); -void gperl_croak_gerror (const char * prefix, GError * err); +void gperl_croak_gerror (const char * ignored, GError * err); + +void gperl_register_error_domain (GQuark domain, + GType error_enum, + const char * package); gpointer gperl_alloc_temp (int nbytes); gchar *gperl_filename_from_sv (SV *sv);