The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

package SVN::Friendly::Exceptions;

#------------------------------------------------------------------
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK=qw(makeErrorHandler);

#------------------------------------------------------------------

use Exception::Lite qw(declareExceptionClass);

#------------------------------------------------------------------

sub ERR_BAD_ARG { 'SVN::Friendly::Exception::BadArg' };
declareExceptionClass(ERR_BAD_ARG
  , ['Illegal argument <%s>: %s', qw(arg reason)]);

sub ERR_UNDEF_ARG { 'SVN::Friendly::Exception::UndefArg' };
declareExceptionClass(ERR_UNDEF_ARG
  , ['Illegal argument: missing/undefined value for the %s parameter'
     . ' are not allowd', qw(param)]);

sub ERR_NO_LOG_MSG { 'SVN::Friendly::Exception::NoLogMsg' };
declareExceptionClass(ERR_NO_LOG_MSG
  , ['The current operation tried to change the repository but '
     . 'No log message was provided via the method call']);

sub ERR_SWIG {'SVN::Friendly::Exception::SWIG' };
declareExceptionClass(ERR_SWIG);
# std parameters:
#   errno = SWIG error id

##--------------------------------------------------------------------

#{
#  package SVN::Friendly::ErrString;

#  my $IDX_ID = 0;
#  my $IDX_MSG = 1;

#  sub new() {
#    my $sClass = shift @_;
#    return bless([ @_ ], $sClass);
#  }

#  sub getErrId() { return shift->[$IDX_ID]; }
#  sub getErrMsg() { return shift->[$IDX_MSG]; }
#}

#==================================================================
# FUNCTIONS
#==================================================================

sub makeErrorHandler {
  my ($crCustom) = @_;

  my $crGlobal = $SVN::Error::handler;

  return sub {
    #before Perl 5.0, $[ could be set globally
    #since the original file did not enforce a version limit and
    #we want backwards compatibility with Alien::SVN and friends
    #but we don't want to use the evil $[, we localize it to 0.
    #(as suggested by MidLifeXis (PerlMonk) and confirmed OK in
    #Perl 4 by tye
    #print STDERR "in croak_on_error: verifying\n";

    #Note: don't want to use shift or copy because then we would
    #need to free it to avoid a memory leak.
    local $[ = 0;
    return @_ unless SVN::Error::is_error($_[0]);

    my $oSwigErr = shift;
    my $bDone = 0;
    if ($crCustom) {
      my $bDiscard = 0;

      eval {
        #discard error or pass through
        $bDiscard = &$crCustom($oSwigErr);
        return 1;
      } or do {
        #in case error is thrown
        my $oErr=$@;
        $oSwigErr->clear();
        die $oErr;
      };

      if ($bDiscard) {
        $oSwigErr->clear();
        return;
      }
    }

    &$crGlobal($oSwigErr) if $crGlobal;
  };
}

#code based on SVN::Core::croak_on_error
#with three modifications:
# 1) $[ localized so 0 can be used as base
# 2) A ref to a pure perl error object rather than a string is thrown
# 3) Stack tracing of Exception::Lite is used rather than carp

sub croak_on_error {
  #before Perl 5.0, $[ could be set globally
  #since the original file did not enforce a version limit and
  #we want backwards compatibility with Alien::SVN and friends
  #but we don't want to use the evil $[, we localize it to 0.
  #(as suggested by MidLifeXis (PerlMonk) and confirmed OK in
  #Perl 4 by tye
  #print STDERR "in croak_on_error: verifying\n";


  #Note: don't want to use shift or copy because then we would
  #need to free it to avoid a memory leak.
  local $[ = 0;
  return @_ unless SVN::Error::is_error($_[0]);

  #print STDERR "in croak_on_error: processing\n";

  my $oSwigErr = shift;
  my $oPerlErr = ERR_SWIG->new($oSwigErr->expanded_message()
                               , errno => $oSwigErr->apr_err());
  #my $oPerlErr = SVN::Friendly::ErrString->new
  #  ($oSwigErr->apr_err(), $oSwigErr->expanded_message());


  #gotta free the memory - to prevent a leak
  $oSwigErr->clear();

  #croak($oPerlErr);
  die $oPerlErr;
}

sub confess_on_error {
  #before Perl 5.0, $[ could be set globally
  #since the original file did not enforce a version limit and
  #we want backwards compatibility with Alien::SVN and friends
  #but we don't want to use the evil $[, we localize it to 0.
  #(as suggested by MidLifeXis (PerlMonk) and confirmed OK in
  #Perl 4 by tye
  #print STDERR "in croak_on_error: verifying\n";


  #Note: don't want to use shift or copy because then we would
  #need to free it to avoid a memory leak.
  local $[ = 0;
  return @_ unless SVN::Error::is_error($_[0]);

  #print STDERR "in croak_on_error: processing\n";

  my $oSwigErr = shift;
  my $oPerlErr = ERR_SWIG->new($oSwigErr->expanded_message()
                               , errno => $oSwigErr->apr_err());
  #my $oPerlErr = SVN::Friendly::ErrString->new
  #  ($oSwigErr->apr_err(), $oSwigErr->expanded_message());


  #gotta free the memory - to prevent a leak
  $oSwigErr->clear();

  #confess($oPerlErr);
  print STDERR "$oPerlErr";
}

#==================================================================
# MODULE INITIALIZATION
#==================================================================

1;