xapian-bindings/perl/generate-perl-exceptions

   1 # generate-perl-exceptions: generate error handling code for Perl bindings
   2 my $copyright = <<'END';
   3  Copyright (C) 2003,2004,2006,2007,2008,2011,2012,2013 Olly Betts
   4  Copyright (C) 2007 Lemur Consulting Ltd
   5  Copyright (C) 2007 Richard Boulton
   6
   7  This program is free software; you can redistribute it and/or
   8  modify it under the terms of the GNU General Public License as
   9  published by the Free Software Foundation; either version 2 of the
  10  License, or (at your option) any later version.
  11
  12  This program is distributed in the hope that it will be useful,
  13  but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  GNU General Public License for more details.
  16
  17  You should have received a copy of the GNU General Public License
  18  along with this program; if not, write to the Free Software
  19  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
  20 END
  21
  22 use strict;
  23 use exception_data;
  24
  25 my @allclasses = (@baseclasses, @classes);
  26
  27 open FD, ">except.i" or die $!;
  28
  29 $copyright =~ s/^/ */mg;
  30
  31 print FD <<"EOF";
  32 /** \@file perl/except.i
  33  * \@brief Custom Perl exception handling.
  34  */
  35 /* Warning: This file is generated by $0
  36  * - do not modify directly!
  37  *
  38 $copyright */
  39
  40 EOF
  41
  42 print FD <<'EOF';
  43 namespace Xapian {
  44
  45 %exceptionclass Error;
  46 EOF
  47
  48 for (@allclasses) {
  49     my ($class, $parent, $comment) = split /\t/, $_, 3;
  50     print FD "%exceptionclass $class;\n";
  51 }
  52
  53 print FD <<'EOF';
  54 }
  55 %include "xapian/error.h"
  56
  57 %{
  58 namespace Xapian {
  59 void handle_exception() {
  60     try {
  61         throw;
  62 EOF
  63
  64 for (reverse @allclasses) {
  65     my ($class, $parent, $comment) = split /\t/, $_, 3;
  66     print FD <<"EOF";
  67     } catch (const Xapian::$class &e) {
  68         void * p = (void *) new Xapian::$class(e);
  69 #ifdef croak_sv
  70         SV * sv = sv_newmortal();
  71         sv_setref_pv(sv, "Xapian::$class", p);
  72         croak_sv(sv);
  73 #elif defined ERRSV
  74         sv_setref_pv(ERRSV, "Xapian::$class", p);
  75         croak(Nullch);
  76 #else
  77         sv_setref_pv(get_sv("@", TRUE), "Xapian::$class", p);
  78         croak(Nullch);
  79 #endif
  80 EOF
  81 }
  82
  83 print FD <<'EOF';
  84     } catch (const std::exception& e) {
  85         croak("std::exception: %s", e.what());
  86     } catch (...) {
  87         croak("something terrible happened");
  88     }
  89 }
  90 }
  91 %}
  92
  93 /* Functions and methods which are marked as "nothrow": */
  94 EOF
  95
  96 chdir($INC[0]);
  97 exception_data::for_each_nothrow(sub { print FD "%exception $_[0];\n" });
  98
  99 print FD <<'EOF';
 100
 101 %exception {
 102     try {
 103         $action
 104     } catch (...) {
 105         Xapian::handle_exception();
 106         SWIG_fail;
 107     }
 108 }
 109 EOF
 110
 111 close FD or die $!;