package ExtReturn;
use Filter::Util::Call;
use strict;
use warnings;

sub import
{
  my $type = shift;
  my $self={};
  $self->{quote}='';
  $self->{regtyp}=0;
  $self->{croak}=0;
  filter_add(bless $self);
}

sub replace
{
  my $data=shift;
  $data=~s/return-a/return !wantarray ? croak('Wrong Context'): /gs;
  return $data
}

sub special
{
  my $key=shift;
  return '}' if($key eq '{');
  return ')' if($key eq '(');
  return ']' if($key eq '[');
  return $key;
}

sub filter
{
  my $self = shift;
  my $status;

  if(($status = filter_read()) >0 )
  {
    my $data=$_;
    #Modul Carp einfügen...
    $data="use Carp;\n" if(!$self->{croak});
    $self->{croak}=1;

    #print "IN : $data";
    my $out='';
    my $block='';
    my ($vor,$q);
    # alles nicht beachten,
    # was innerhalb von einem String oder Regexp ist
    my $reg=$self->{regtyp}? '|'.$self->{quote}: '';
    while($data=~m/^(.+?)(['"]|=~|q[wxrq]?$reg)(.+)$/s)
    {
      #print "QUOTE is [$self->{quote}]  REGTYP=$self->{regtyp}\n";
      ($vor,$q,$data)=($1,$2,$3);
      #print "FOUND: $q\n";
      # regexp ignorieren
      # String finden und ignorieren
      if($self->{quote} ne '')
      {
        #print "INSIDE QUOTE\n";
        if($self->{quote} eq $q)
        {
          #print "MATCH : $q\n";
          if($vor=~m!(\\+)$! && length($1)%2>0)
          {
            $block.=$vor.$q;
          }
          else
          {
            if($self->{regtyp}>0)
            {
              #print "REDUCE REGEXP\n";
              $self->{regtyp}--;
              $block.=$vor.$q;
              if($self->{regtyp}==0)
              {
                #print "LEAVE QUOTE\n";
                $self->{quote}='';
                $out.=$block;
                $block='';
              }
            }
            else
            {
              #print "LEAVE QUOTE\n";
              $self->{quote}='';
              $out.=$block.$vor.$q;
              $block='';
            }
          }
        }
        else
        { $block.=$vor.$q; }
      }
      else
      {
        # außerhalb von String/Regexp
        $out.=replace($block.$vor).$q;
        $block='';

        # Regexp gesondert behandeln
        # aber auch qw,qx,qr,qq,q
        if($q eq '=~')
        {
          # was für eine regexp?
          if($data=~/^(\s*([msy]|tr)(.))(.+)$/s)
          {
            $out.=$1;
            $data=$4;
            if($2 eq 'm')
            {
              # suchen
              $self->{quote}=special($3);
              $self->{regtyp}=1;
            }
            else
            {
              # suchen/ersetzen
              $self->{quote}=special($3);
              $self->{regtyp}=2;
            }
          }
          elsif($data=~m!^(\s*/)(.+)$!)
          {
            $out.=$1;
            $data=$2;
            # suchen
            $self->{quote}='/';
            $self->{regtyp}=1;
          }
          else
          {
            # wasn das???
            # Fehler im Programm??
            # ignorieren...
            $self->{quote}='';
            $self->{regtyp}=0;
          }
        }
        elsif($q eq 'qw' || $q eq 'qx' || $q eq 'qr' || $q eq 'qq' || $q eq 'q')
        {
          if($data=~/^(.)(.+)$/s)
          {
            $out.=$1;
            $data=$2;
            $self->{quote}=special($3);
            $self->{regtyp}=1;
          }
          else
          {
            # wasn das???
            # Fehler im Programm??
            # ignorieren...
            $self->{quote}='';
            $self->{regtyp}=0;
          }
        }
        else
        {
          $self->{quote}=$q;
        }
      }
      $reg=$self->{regtyp}? '|'.$self->{quote}: '';
    }
    $block=replace($block) if($self->{quote} eq '');
    $data =replace($data) if($self->{quote} eq '');
    $out.=$block.$data;
    #print "OUT: $out";
    $_=$out;
  }
  return $status;
}

1;