The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Treex::PML::Schema::Alt;

use strict;
use warnings;

use vars qw($VERSION);
BEGIN {
  $VERSION='2.21'; # version template
}
no warnings 'uninitialized';
use Carp;

use Treex::PML::Schema::Constants;
use base qw( Treex::PML::Schema::Decl );

=head1 NAME

Treex::PML::Schema::Alt - implements declaration of an alternative (alt).

=head1 INHERITANCE

This class inherits from L<Treex::PML::Schema::Decl>.

=head1 METHODS

See the super-class for the complete list.

=over 3

=item $decl->get_decl_type ()

Returns the constant PML_ALT_DECL.

=item $decl->get_decl_type_str ()

Returns the string 'alt'.

=item $decl->get_content_decl ()

Return type declaration of the list members.

=item $decl->is_flat ()

Return 1 for ``flat'' alternatives, otherwise return 0. (Flat
alternatives are not part of PML specification, but are used for
translating attribute values from C<Treex::PML::FSFormat>.)

=item $decl->is_atomic ()

Returns 0.

=back

=cut

sub is_atomic { 0 }
sub get_decl_type { return PML_ALT_DECL; }
sub get_decl_type_str { return 'alt'; }
sub is_flat { return $_[0]->{-flat} }
sub init {
  my ($self,$opts)=@_;
  $self->{-parent}{-decl} = 'alt';
}

sub validate_object {
  my ($self, $object, $opts) = @_;

  my ($path,$tag,$flags);
  my $log = [];
  if (ref($opts)) {
    $flags = $opts->{flags};
    $path = $opts->{path};
    $tag = $opts->{tag};
    $path.="/".$tag if $tag ne q{};
  }
  my $am_decl = $self->get_content_decl;
  if ($self->is_flat) {
    # flat alternative:
    if (ref($object)) {
      push @$log, "$path: flat alternative is supposed to be a string: $object";
    } else {
      my $i = 1;
      foreach my $val (split /\|/,$object) {
	$am_decl->validate_object($val, {
	  flags => $flags,
	  path=> $path,
	  tag => "[".($i++)."]",
	  log => $log,
	});
      }
    }
  } elsif (ref($object) and UNIVERSAL::DOES::does($object,'Treex::PML::Alt')) {
    for (my $i=0; $i<@$object; $i++) {
      $am_decl->validate_object($object->[$i], {
	flags => $flags,
	path=> $path,
	tag => "[".($i+1)."]",
	log => $log,
      });
    }
  } else {
    $am_decl->validate_object($object,{
      flags => $flags,
      path=>$path,
      # tag => "[1]", # TrEdNodeEdit would very much like [1] here
      log => $log});
  }
  if ($opts and ref($opts->{log})) {
    push @{$opts->{log}}, @$log;
  }
  return @$log ? 0 : 1;
}


1;
__END__

=head1 SEE ALSO

L<Treex::PML::Schema::Decl>, L<Treex::PML::Schema>, L<Treex::PML::Alt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008-2010 by Petr Pajas

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.

=head1 BUGS

None reported... yet.

=cut