source: branches/properties/PERL2ARB/ARB.pm

package ARB;

my $already_dying  = 0;
my $in_global_eval = 1;

use strict;
use vars qw($VERSION @ISA @EXPORT);

require Exporter;
require DynaLoader;

@ISA = qw(Exporter DynaLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
              set_inGlobalEvalState
           );
$VERSION = '0.01';

# uncomment next line to debug dyna-loading ARB.so:
# $DynaLoader::dl_debug = 1;

bootstrap ARB $VERSION;
# bootstrapping succeeded (would die otherwise)
$in_global_eval = 0; # now allow to call prepare_to_die()

# globally catch die, redirect to arb_message, then confess
package CORE::GLOBAL;
use subs 'die';

sub ARB::set_inGlobalEvalState($) {
  # hack to make eval-based perl-scripts work with die-catcher (below in 'sub die').
  #
  # if your script uses eval, protect the top-level eval as follows:
  #
  # eval {
  #     set_inGlobalEvalState(1);
  #     do_something_that_may_die();
  # };
  # set_inGlobalEvalState(0);
  # if ($@) { die $@; } # this call of die will trigger prepare_to_die() below.
  #
  my ($state) = @_;
  $in_global_eval = $state;
}

sub ARB::notify_and_wait($) {
  # helper for macros (see ticket #856 for whole story):
  #
  # - opens popup displaying 'notification' and a continue button.
  #
  # - until pressing the button:
  #   - the macro pauses execution.
  #   - arb GUI may be accessed by user to change settings and/or
  #     select species etc.
  #
  # - after pressing the continue button:
  #   - macro execution continues.
  #
  my ($notification) = @_;
  system("arb_wetc -notify \"".$notification."\" -button \"Click when done to continue with macro\"");
}

sub show_arb_message($) {
  my ($msg) = @_;
  $msg =~ s/\n/\\n/g;
  $msg =~ s/'/"/g;
  system("arb_message '$msg'");
}

sub die {
  if ($already_dying==0 and $in_global_eval==0) {
    $already_dying++; # do not recurse

    ARB::prepare_to_die(); # abort all transactions and close all databases (too avoid deadlock; see #603)

    my ($msg) = @_;
    $msg =~ s/\n+$//g; # remove trailing LFs
    my $errname = 'arb macro/perl execution error';
    if ($msg eq '') { $msg = 'unknown '.$errname; }
    else { $msg = "$errname: '$msg'"; }
    show_arb_message($msg."\n(see console for details)");

    use Carp;
    Carp::confess("$msg"); # recurses into this sub
  }
  else {
    CORE::die @_;
  }
}

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__
# Below is the stub of documentation for your module. You better edit it!

=head1 NAME

ARB - Perl extension for ARB

=head1 SYNOPSIS

  use ARB;

=head1 DESCRIPTION

The ARB perl module provides access to a ARB databases.  You may
connect to a remote database (e.g. a running instance of ARB_NTREE) or
open your own database.

=head1 AUTHOR

ARB development, devel@arb-home.de

=head1 SEE ALSO

perl(1).

=cut