source: branches/stable/PERL2ARB/ARB.pm

Last change on this file was 18904, checked in by westram, 2 years ago
  • errors from DynaLoader were suppressed. fixed
    • force exception handler to not use 'prepare_to_die', until module ARB has been loaded.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.4 KB
Line 
1package ARB;
2
3my $already_dying  = 0;
4my $in_global_eval = 1;
5
6use strict;
7use vars qw($VERSION @ISA @EXPORT);
8
9require Exporter;
10require DynaLoader;
11
12@ISA = qw(Exporter DynaLoader);
13# Items to export into callers namespace by default. Note: do not export
14# names by default without a very good reason. Use EXPORT_OK instead.
15# Do not simply export all your public functions/methods/constants.
16@EXPORT = qw(
17              set_inGlobalEvalState
18           );
19$VERSION = '0.01';
20
21# uncomment next line to debug dyna-loading ARB.so:
22# $DynaLoader::dl_debug = 1;
23
24bootstrap ARB $VERSION;
25# bootstrapping succeeded (would die otherwise)
26$in_global_eval = 0; # now allow to call prepare_to_die()
27
28# globally catch die, redirect to arb_message, then confess
29package CORE::GLOBAL;
30use subs 'die';
31
32sub ARB::set_inGlobalEvalState($) {
33  # hack to make eval-based perl-scripts work with die-catcher (below in 'sub die').
34  #
35  # if your script uses eval, protect the top-level eval as follows:
36  #
37  # eval {
38  #     set_inGlobalEvalState(1);
39  #     do_something_that_may_die();
40  # };
41  # set_inGlobalEvalState(0);
42  # if ($@) { die $@; } # this call of die will trigger prepare_to_die() below.
43  #
44  my ($state) = @_;
45  $in_global_eval = $state;
46}
47
48sub show_arb_message($) {
49  my ($msg) = @_;
50  $msg =~ s/\n/\\n/g;
51  $msg =~ s/'/"/g;
52  system("arb_message '$msg'");
53}
54
55sub die {
56  if ($already_dying==0 and $in_global_eval==0) {
57    $already_dying++; # do not recurse
58
59    ARB::prepare_to_die(); # abort all transactions and close all databases (too avoid deadlock; see #603)
60
61    my ($msg) = @_;
62    $msg =~ s/\n+$//g; # remove trailing LFs
63    my $errname = 'arb macro/perl execution error';
64    if ($msg eq '') { $msg = 'unknown '.$errname; }
65    else { $msg = "$errname: '$msg'"; }
66    show_arb_message($msg."\n(see console for details)");
67
68    use Carp;
69    Carp::confess("$msg"); # recurses into this sub
70  }
71  else {
72    CORE::die @_;
73  }
74}
75
76# Preloaded methods go here.
77
78# Autoload methods go after =cut, and are processed by the autosplit program.
79
801;
81__END__
82# Below is the stub of documentation for your module. You better edit it!
83
84=head1 NAME
85
86ARB - Perl extension for ARB
87
88=head1 SYNOPSIS
89
90  use ARB;
91
92=head1 DESCRIPTION
93
94The ARB perl module provides access to a ARB databases.  You may
95connect to a remote database (e.g. a running instance of ARB_NTREE) or
96open your own database.
97
98=head1 AUTHOR
99
100ARB development, devel@arb-home.de
101
102=head1 SEE ALSO
103
104perl(1).
105
106=cut
Note: See TracBrowser for help on using the repository browser.