#
# Copyright (c) 2003 Lev A. Serebryakov <lev@serebryakov.spb.ru>
#
#    This module is free software; you can redistribute it and/or modify it
#    under the same terms as Perl itself.
#
# This package contains object to store exception & two simple
# commands: throw, whcih generate new exception with given message & call
# `die` and `rethrow` which does nothing if here is no exception and generate
# new exception in other case. Old one will be linked with new.
#
# $Id: Exception.pm 783 2003-12-05 17:08:35Z lev $
#
package Cvs::Repository::Exception;

use strict;

use vars qw($VERSION);
$VERSION  = join('.',0,76,('$LastChangedRevision: 783 $' =~ /^\$\s*LastChangedRevision:\s+(\d+)\s*\$$/),'cvs2svn');

use vars qw(@EXPORT @EXPORT_OK @ISA %EXPORT_TAGS);

require Exporter;
@ISA = qw(Exporter);

@EXPORT      = ();
@EXPORT_OK   = qw(throw condthrow rethrow condrethrow);
%EXPORT_TAGS = ('INTERNAL' => [qw(throw condthrow rethrow condrethrow)]);

use vars   qw($FORMAT);
use overload '""' => \&getString;

$FORMAT = "%{|UNKNOWN EXCEPTION}m%{ raised at }f%{:}l%{\n--> }s";

sub New
{
  my $proto = shift;

  my $class = ref($proto) || $proto;
  my $self = bless({},$class);

  # We support
  $self->{'msg'}  = shift || '';
  $self->{'pkg'}  = shift || '';
  $self->{'file'} = shift || '';
  $self->{'line'} = shift || 0;
  $self->{'prev'} = shift || undef;
  $self->{'cond'} = shift || undef;
  
  return $self;
}

sub getString
{
  my $s = '';
  # Process format message.
  foreach my $f (split(/(%(?:\{.+?\})?.)/s,$FORMAT)) {
    if($f =~ /^%(?:\{(.+?)\})?(.)$/s) {
      my $field = undef;
      my ($ift,$iff,$code) = (undef,undef,$2);
      ($ift,$iff) = split(/\|/,$1) if defined $1;
      if      ('m' eq $code) {
        $field = 'msg';
      } elsif ('f' eq $code) {
        $field = 'file';
      } elsif ('l' eq $code) {
        $field = 'line';
      } elsif ('p' eq $code) {
        $field = 'pkg';
      } elsif ('s' eq $code) {
        $field = 'prev';
      } elsif ('c' eq $code) {
        $field = 'cond';
      } elsif ('%' eq $code) {
        $s .= '%';
      }
      if(defined $field) {
        if(defined $_[0]->{$field} && $_[0]->{$field}) {
          $s .= $ift if defined $ift;
          $s .= $_[0]->{$field};
        } else {
          $s .= $iff if defined $iff;
        }
      }
    } else {
      $s .= $f;
    }
  }
  return $s;
}

sub throw
{
  die Cvs::Repository::Exception->New($_[0],(caller));
}

sub condthrow
{
  my ($msg,$cb,$name) = @_;
  # Delete 3 elements from @_
  splice(@_,0,3);
  
  die Cvs::Repository::Exception->New($msg,(caller)) unless ref($cb) eq 'HASH';
  $cb->{$name} = 1 unless exists $cb->{$name};
  # check: callback is code or onter?
  if      (ref($cb->{$name}) eq 'CODE') {
    $cb->{$name}->($name,@_) or die Cvs::Repository::Exception->New($msg,(caller),undef,$name);
  } elsif ($cb->{$name}) {
    die Cvs::Repository::Exception->New($msg,(caller),undef,$name);
  }
  # do nothing if it is not code or "true" value
}

sub rethrow
{
  # Don't throw anything, if here is no previous message
  return unless defined $@ && $@;
  my $msg = $_[0] || undef;
  # Don't re-throw, but simple throw if here is no new message
  die $@ unless defined $msg && $msg;
  # And now, two variants of "die" with old exception:
  if(ref($@) eq 'Cvs::Repository::Exception') {
    die Cvs::Repository::Exception->New($msg,(caller),$@);
  } else {
    # Make proper string from unknown (string?) exception
    my $s = "$@";
    $s =~ s/\s+$//; $s =~ s/^\s+//;
    die Cvs::Repository::Exception->New($msg,(caller),Cvs::Repository::Exception->New("Unknown exception: '$s'"));
  }
}

sub condrethrow
{
  # Don't throw anything, if here is no previous message
  return 0 unless defined $@ && $@;

  my ($msg,$cb,$name) = @_;
  # Delete 3 elements from @_
  splice(@_,0,3);

  my $need = 1;

  # If $cb is not hash ref, rethrow error
  if(ref($cb) eq 'HASH') {
    $cb->{$name} = 1 unless exists $cb->{$name};
    if (ref($cb->{$name}) eq 'CODE') {
      $need = !$cb->{$name}->($name,@_);
    } else {
      $need = $cb->{$name};
    }
  }
  # Do nothing if we don't need rethrow
  return 1 unless $need;

  # Don't re-throw, but simple throw if here is no new message
  die $@ unless defined $msg && $msg;
  # And now, two variants of "die" with old exception:
  if(ref($@) eq 'Cvs::Repository::Exception') {
    die Cvs::Repository::Exception->New($msg,(caller),$@,$name);
  } else {
    # Make proper string from unknown (string?) exception
    my $s = "$@";
    $s =~ s/\s+$//; $s =~ s/^\s+//;
    die Cvs::Repository::Exception->New($msg,(caller),Cvs::Repository::Exception->New("Unknown exception: '$s'"),$name);
  }
}

1;
