require AMF::Parser::ContextForeign;
package AMF::Parser::Contexts;

#use Carp::Assert;
no Carp::Assert;

require AMF;

# $AMF::Parser::Basic::self -> {XML_LANG_CASCADING};
use vars qw( $XML_LANG );


use AMF::Parser::Basic;
use strict;

sub new { 
  shift;
  my $type   = shift;
  my $parser = shift;
  my @para = @_;

  assert( $type =~ /^[a-zA-Z]+$/ ) if DEBUG;
  
  my $class = "AMF::Parser::Context::" . $type ;

  my $self  = { TYPE   => $type,
                PARSER => $parser,
              };
  bless $self, $class;


  ###  XML LANG
  $self -> {XML_LANG_ABOVE} = $XML_LANG;

  if ( $_{'xml:lang'} ) {
    $XML_LANG = $_{'xml:lang'};
    if ( AMF::Parser::Contexts::DEBUG ) {
      debug "set global XML_LANG to: $XML_LANG";
    }
    
  } elsif ( $AMF::Parser::Basic::self -> {XML_LANG_CASCADING} ) {
    if ( defined $XML_LANG ) {
      $_{'xml:lang'} = $XML_LANG;
    }
  }


  $self -> init( @para );

  return $self;
}


package AMF::Parser::Context;

use AMF::Parser::Basic;
#use Carp::Assert;
no Carp::Assert;

sub type {
  my $self = shift;
  return $self ->{TYPE};
}

sub init {
  my $self = shift;
  my $name = shift;
  
  my %att  = ( %_ );

  assert( $name ) if DEBUG;
  $self -> {NAME} = $name;
  $self -> {ATTR} = \%att;
  

#  print "NAME: $name\n";
};


sub element {};
sub text    {};

sub end_tag {
};

sub DESTROY {
  my $self = shift;
  $AMF::Parser::Contexts::XML_LANG =  $self -> {XML_LANG_ABOVE};
  if ( AMF::Parser::Contexts::DEBUG ) {
    if ( defined $self -> {XML_LANG_ABOVE} ) {
      print "restore global XML_LANG to: $self->{XML_LANG_ABOVE}\n";
    }
  }
};


package AMF::Parser::Context::Free;


use AMF::Parser::Basic;
use vars qw( @ISA );
@ISA = qw( AMF::Parser::Context );


sub init {
  my $self = shift;
  my $name = shift;

  if ( $name ) {
    $self -> {NAME} = $name;
    $self -> {ATTR} = { %_ };

    $self -> {NS}   = '';

    if ( AMF::Parser::Contexts::DEBUG ) {
      debug "NAME: $name";
    }
  }

  $self -> {level} = 0;  
  $self -> {langs} = [];
};


sub element {
  my $self = shift;
  my $name = shift;
  my $ns   = shift;

  my $nouns = $spec -> {nouns};

  if ( 
      $ns eq $spec ->{default_namespace}
      and $nouns -> {$name} ) {
    my $type = $nouns -> {$name} {type};
    open_context( 'Noun', $type, $name, @_ );
    return;
  }

  push @{ $self -> {langs} }, $AMF::Parser::Contexts::XML_LANG;
  if ( $_{'xml:lang'} ) {
    $AMF::Parser::Contexts::XML_LANG = $_{'xml:lang'};
  }

  $self -> {level} ++;
  if ( AMF::Parser::Contexts::DEBUG ) {
    print "el: $name ($self->{level})\n";
  }
  return;
}


sub end_tag {
  my $self = shift;
  my $name = shift;
  my $ns   = shift;


  $self -> {level} --;
  if ( AMF::Parser::Contexts::DEBUG ) {
    print "end of $name\n";
  }

  if ( $self -> {level} == -1 ) {
    close_context();
#    $self -> SUPER::end_tag( $name, $ns );
  } else {
    $AMF::Parser::Contexts::XML_LANG = 
      shift @{ $self -> {langs} };
  }
}


sub child {
  my $self = shift;
  my $type = shift;
  my $noun = shift;
  

  my $p = $self -> {PARSER};
  if ( $p ->{NOUN_CB} ) {
    my $cb = $p -> {NOUN_CB};

    &$cb ( $noun );

    my $rlist = $p ->{LIST} ;
    while ( $rlist and scalar @$rlist ) {
      my $n = shift @$rlist;
      &$cb ( $n );
    }

  } else {
    my $rlist = $p ->{LIST} ;
    push @$rlist, $noun;
    if ( AMF::Parser::Contexts::DEBUG ) {
      print "ADDED A ROOT-LEVEL NOUN: $noun\n";
    }
  }
}




package AMF::Parser::Context::Error;

use vars qw( @ISA );
@ISA = qw( AMF::Parser::Context::Free );


sub child {}


package AMF::Parser::Context::Noun;


use vars qw( @ISA );
@ISA = qw( AMF::Parser::Context );
use AMF::Parser::Basic;

use Carp::Assert;


sub init {
  my $self     = shift;
  my $spectype = shift;
  my $name     = shift;
  my $context  = shift;
  my %att  = ( %_ );
 
  $self -> SUPER::init( $name, @_ );

  assert( $spectype ) if DEBUG;
  assert( $spec -> {types} {$spectype} ) if DEBUG ;
  $self -> {SPECTYPE} = $spectype;
  
  my $id  = $att{id};
  my $ref = $att{ref};
  
  debug "noun: $name" , ($id) ? " of $id" : "",  
    ($ref) ? " of ref=$ref" : "";

  foreach ( qw( id ref ) ) {
    next if not exists $att{$_};
#    my $r = AMF::Spec::Check::process_value( $spec, 'XML_NAME', $att{$_} );
    my $r = AMF::Spec::Check::process_value( $spec, 'absoluteURI', $att{$_} );
    if ( not $r ) { 
      warning "$_ attribute of $self->{NAME} noun is invalid: '$att{$_}'";
      delete $att{$_};
    }
  }
      

  my $data = AMF::Record -> new( 
                                TYPE => "$name", 
                                ATTR => \%att,
                               );

  $self -> {data} = $data;

  ###  AMF interpretation document, question 1.1, answer 3, not 1:

  if ( $context ) {
    my $self_noun = $self -> {data};

    my $verb = $context ->{verb};
    my $noun = $context ->{noun};
    assert( $verb and $noun ) if DEBUG ;

    debug "Noun enclosed into $verb of another noun (", $noun ->id, ")";

    my $ntype = $noun -> type;
    my $nid   = $noun -> id;

    $self_noun -> {ENCLOSED} = {};
    $self_noun -> {ENCLOSED}{THROUGH}  = "$verb";
    $self_noun -> {ENCLOSED}{NOUNTYPE} = $ntype;
    if ( $nid ) {
      $self_noun -> {ENCLOSED}{INTO}     = $nid;
    }
  }

  if ( UNIVERSAL::isa( $data, 'AMF::Record' ) ) {
    push_record( $data );
  }

};


sub element {
  my $self = shift;
  my $name = shift;
  my $ns   = shift;

#  print "NS: $ns\n\n";

  my $myspectype = $self -> {SPECTYPE};
  
  my $st = $spec -> {types} { $myspectype };


  if ( not defined $ns  
       or $ns ne $spec ->{default_namespace} ) {
    debug "Noun: foreign element started";
    open_context( 'ForeignEl', '', $name, $ns );
    return;
  }

  if ( not $st -> {$name} ) {
    ###  unknown element
    
    warning "Unknown element in $self->{NAME} noun: <$name>";
    return 'Error';
  }
  
  my $childdef = $st -> {$name};
  my $childstype;

  if ( $childdef -> [0] eq 'adj' ) {
    $childstype = $childdef -> [2];
    open_context( 'Adjective', $childstype, $name );
    return;

  } elsif ( $childdef -> [0] eq 'adjcontainer' ) {
    $childstype = $childdef -> [2];
    assert( $childstype ) if DEBUG;
    open_context( 'AdjContainer', $childstype, $name );
    return;

  } elsif ( $childdef -> [0] eq '_verb' ) {    
    $childstype = [ @$childdef ]; 
    shift @$childstype;
    shift @$childstype;
    open_context( 'Verb', $childstype, $name, $self ->{data} );
    return;
  }


}

sub end_tag {
  my $self = shift;
  my $name = shift;
  
  ###  THIS WILL PASS THE DATA STRUCTURE--THE NOUN ITSELF--TO THE PREVIOUS
  ###  CONTEXT LEVEL.

  my $data = $self -> {data};
  close_context( 'noun', $data );

  if ( UNIVERSAL::isa( $data, 'AMF::Record' ) ) {
    pop_record;
  }

#  $self -> SUPER::end_tag( $name );
}


sub child {
  my $self = shift;
  my $type = shift;
  
  my $data = $self -> {data};

  if ( $type eq 'verb' ) {

    debug "---> a noun's verb: $_[0]";
    ###  here: element name, attributes, noun, noun, ...
    $data -> verb( @_ );

  } elsif ( $type eq 'Adjective' ) {
    $data -> adjective( @_ );

  } elsif ( $type eq 'AdjContainer' ) {
    $data -> adjcontainer( @_ );

  } elsif ( $type eq 'ForeignEl' ) {

    debug "Noun: child: $type: $_[0]";
    $data -> foreignel( @_ );

  } else {

    debug "---> unknown child type: $type";
  }
}





package AMF::Parser::Context::Verb;


use vars qw( @ISA );
@ISA = qw( AMF::Parser::Context );
use AMF::Parser::Basic;
no Carp::Assert;


sub init {
  my $self    = shift;
  my $nouns   = shift;
  my $name    = shift;
  my $context = shift;
 
  $self -> SUPER::init( $name, @_ );

  $self -> {content} = [];

  assert( ref $nouns eq 'ARRAY' ) if DEBUG ;
  $self ->{NOUNS}   = {};
  $self ->{CONTEXT} = $context;
  assert( $context ) if DEBUG ;

#  print "Verb: $self->{NAME}, possible children: ";
  foreach ( @$nouns ) {
    $self ->{NOUNS} -> {$_} = 1;
#    print "$_ ";
  }
#  print "\n";

  ###  attributes: from and until
  my $attr  = $self -> {ATTR};
  foreach ( qw( from until ) ) {
    my $val = $attr -> {$_};
    if ( defined $val and $val ) {
      my $che = AMF::Spec::Check::process_value( $spec, 'DATE', $val );
      if ( $che ) {
        $attr -> {$_} = $che;
        
      } else {
        warning "Attribute $_ of verb $self->{NAME} has invalid value: '$val'";
        delete $attr -> {$_};
      }
    }
  }
  
}


sub element {
  my $self = shift;
  my $name = shift;
  my $ns   = shift;
  
  if ( defined $ns 
       and $ns eq $spec ->{default_namespace} 
       and $self ->{NOUNS} -> {$name} ) {

    if ( $self -> {nouncontent} ) { 
      warning "Only one noun is allowed in a verb (in $self->{NAME}: <$name>)";
      return "Error";
    }

    my $t = $spec -> {nouns} {$name} {type};
    assert( $t ) if DEBUG ;
    my $context = {};
    $context ->{verb} = $self ->{NAME};
    $context ->{noun} = $self ->{CONTEXT};
    open_context( 'Noun', $t, $name, $context, @_ );
    return;
  }

  if ( not defined $ns  
       or $ns ne $spec ->{default_namespace} ) {
    open_context( 'ForeignEl', '', $name, $ns );
    return;
  }


  warning "unexpected element in $self->{NAME} verb: <$name>";

  return "Error";
}


sub end_tag {
  my $self = shift;
  
  my $cont = $self->{content};
  if ( scalar @$cont ) {
    close_context( 'verb', $self -> {NAME}, $self -> {ATTR}, @$cont );

  } else {
    close_context();
  }
}


sub child {
  my $self = shift;
  my $type = shift;
  
  if ( $type eq 'noun' ) {
    my $noun = shift;
    my $cont = $self ->{content};
    push @$cont, $noun;
    $self -> {nouncontent} = $noun;
    
    if ( $noun -> isa( "AMF::Record" ) ) {
      my $p = $self -> {PARSER};
      if ( $p -> {REPORT_ENCLOSED_NOUNS} ) {
        my $l = $p -> {LIST};
        assert( $l and ref $l ) if DEBUG ;
        push @$l, $noun;
      }
    } else {
      #    die ref $noun;
    }

  } elsif ( $type eq 'ForeignEl' ) {
    my @content = @_;
    my $cont = $self ->{content};
    push @$cont, \@content;

  }
  
  assert( $type eq 'noun' ) if DEBUG ;

}



package AMF::Parser::Context::Adjective;


use AMF::Parser::Basic;
use strict;

use vars qw( @ISA );
@ISA = qw( AMF::Parser::Context );


sub init {
  my $self = shift;
  my $type = shift || '';
  my $name = shift;

  $self -> SUPER::init( $name );
  my $attr = $self -> {ATTR};

#  print "attributes: ", join( ' ', keys %_ ), "\n";

  my $typedef = $spec -> {types} -> {$type};
  

  ###  adjective attribute checking
  
  if ( $typedef 
       and ref $typedef eq 'ARRAY'
       and $typedef -> [0] 
       and $typedef -> [0] eq 'element' ) {

    ###  those types must be defined as 'element' with some children

    my @checks = @{ $typedef->[1] };
    
    my $val_type;
    
    foreach ( @checks ) {

      ###  children must be either an attribute or value type definition

      my ( $wa, $na, undef, $ty ) = @$_;

      if ( $wa eq 'attribute' 
           and $na 
           and $ty ) {

        my $va = $attr -> {$na};        
        my $r  = $va ? AMF::Spec::Check::process_value( $spec, $ty, $va ) : 0;
        if ( $r ) {
          $attr -> {$na} = $r;
        } else {
          delete $attr -> {$na};
          warning "attribute $na of adjective $self->{NAME} has invalid value: '$va'";
        }

      } elsif ( $wa eq 'value' ) {
        my $ty = $_->[2];
        $val_type = $ty;
      }
    }
    
    if ( $val_type ) { 
      $type = $val_type;
    } else { 
      undef $type;
    }
  }



  my $valtype;

  if ( exists $_{'xsi:type'} ) {
    $valtype = $_{'xsi:type'};
  }

  if ( $valtype ) {
    $type = "$type:$valtype";
  }

  
  $self -> {SPECTYPE} = $type;
  
}


sub text {
  my $self = shift;
  my $text = shift;
  $self -> {text} = $text;  
}


require AMF::Spec::Check;

sub end_tag {
  my $self = shift;

  if ( $self -> {BAD} ) {
    return close_context;
  }

  my $v    = $self->{text};
  my $type = $self->{SPECTYPE};

  my $r = $v;
  
  if ( $type and $v ) {
    $r = AMF::Spec::Check::process_value( $spec, $type, $v );
  }

  if ( not defined $r ) {
    warning "adjective $self->{NAME} has an invalid value: '$v'";
    close_context();

  } else {
    close_context( 'Adjective', $self -> {NAME}, $self ->{ATTR}, $r );
  }

}


sub element {
  my $self = shift;
  my $name = shift;
  my $ns   = shift || '';

  if ( $ns ) {
    $ns = ", namespace: $ns";
  } 

  warning "adjective $self->{NAME} has an element inside it: <$name>$ns";
  $self -> {BAD} = 1; 
  return "Error";
}


package AMF::Parser::Context::ForeignAdjective;


use AMF::Parser::Basic;
use strict;

use vars qw( @ISA );
@ISA = qw( AMF::Parser::Context );


sub init {
  my $self = shift;
  my $type = shift;
  my $name = shift;
  my $ns   = shift;

  $self -> SUPER::init( $name );
  $self -> {NS} = $ns;

  $self -> {text} = '';
#  $self -> {SPECTYPE} = 'foreign-adjective';
}

sub text {
  my $self = shift;
  my $text = shift;
  $self -> {text} .= $text;  
}

sub element {
  my $self = shift;
  my $name = shift;
  my $ns   = shift;
  $self -> {BROKEN} = 1;
  return "Layer";
}


sub end_tag {
  my $self = shift;

  my $ns   = $self ->{NS} || '';
  my $name = $self ->{NAME};

  ###  Check that the adjective had no other children
  if ( $self->{BROKEN} ) {
    close_context();
    return;
  } 

  close_context( 'Adjective', "$ns $name", 
                 $self ->{ATTR},
                 $self ->{text} );

}


package AMF::Parser::Context::Layer;

use vars qw( @ISA );
@ISA = qw( AMF::Parser::Context );
use AMF::Parser::Basic;

sub element {
  my $self = shift;
  my $name = shift;
  my $ns   = shift;
  return "Layer";
}

sub end_tag {
  my $self = shift;
  my $ns   = shift;
  close_context();
}



package AMF::Parser::Context::AdjContainer;

use vars qw( @ISA );
@ISA = qw( AMF::Parser::Context );
use AMF::Parser::Basic;
no Carp::Assert;


sub init {
  my $self     = shift;
  my $spectype = shift;
  my $name     = shift;
  my %att  = ( %_ );
 
  $self -> SUPER::init( $name, @_ );

  assert( $spectype ) if DEBUG;
  assert( $spec -> {types} {$spectype} ) if DEBUG;
  $self -> {SPECTYPE} = $spectype;
  
  debug "container: $name";
  

  my $data = { };
  bless $data, 'AMF::AdjContainer';

  $self -> {data} = $data;

};


sub element {
  my $self = shift;
  my $name = shift;
  my $ns   = shift;

  my $type = 'Layer';
  
  my $myspectype = $self -> {SPECTYPE};
  
  my $st = $spec -> {types} { $myspectype };
  
  assert( $st ) if DEBUG;

  if ( not defined $ns 
       or $ns ne $spec ->{default_namespace} ) {
    open_context( 'ForeignEl', '', $name, $ns );
    return;
  }

  if ( not $st -> {$name} ) {
    warning "Unknown element in $self->{NAME} adjective container: <$name>";
    return 'Error';
  }
  
  my $childdef = $st -> {$name};
  my $childstype;

  if ( $childdef -> [0] eq 'adj' ) {
    $type       = 'Adjective';
    $childstype = $childdef -> [2];
    open_context( 'Adjective', $childstype, $name );
    return;
  }

  ### should never reach this point, because adjcontainer is supposed to have
  ### only adjectives in it, by specification
}

sub end_tag {
  my $self = shift;
  my $name = shift;
  
  close_context( 'AdjContainer', $self->{NAME}, $self->{ATTR}, $self ->{data} );
}


sub child {
  my $self = shift;
  my $type = shift;

  my $data = $self -> {data};
  if ( $type eq 'Adjective' ) {

    my $name  = shift;
    my $attr  = shift;
    my $value = shift;

    my $v = AMF::Noun::adjective( $data, $name, $attr, $value );

  } elsif ( $type eq 'ForeignEl' ) {

    my $name  = shift;
    my $attr  = shift;

    my $v = AMF::Noun::foreignel( $data, $name, $attr, @_ );   

  } else {
    debug "---> unknown child type: $type";
  }
}



package AMF::VerbInstance;

####  a sketch, not used yet

use vars qw( @ISA );
@ISA = qw(  );

sub get_value {
  my $self = shift;
  my $spec = shift;
  
  if ( $spec =~ m/^@([^\/]+)$/ ) {
    return $self -> [1] -> {$1};
  } else {
    return $self -> [0] -> get_value( $spec );
  }
}

1;

