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

use strict;
use warnings;

use vars qw($VERSION);
BEGIN {
  $VERSION='2.16'; # version template
}
no warnings 'uninitialized';
use Carp;
use Treex::PML::Schema::Constants;
use base qw( Treex::PML::Schema::Decl );

=head1 NAME

Treex::PML::Schema::Choice - implements declaration of an enumerated
type (choice).

=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->is_atomic ()

Returns 1.

=item $decl->get_decl_type ()

Returns the constant PML_CHOICE_DECL.

=item $decl->get_decl_type_str ()

Returns the string 'choice'.

=item $decl->get_values ()

Return list of possible values.

=item $decl->set_values (\@values)

Set possible values.

=item $decl->get_content_decl ()

Returns undef.

=item $decl->validate_object($object)

See C<validate_object()> in L<Treex::PML::Schema>.

=back

=cut

sub is_atomic { 1 }
sub get_decl_type { return PML_CHOICE_DECL; }
sub get_decl_type_str { return 'choice'; }
sub get_content_decl { return(undef); }
sub get_values { return @{ $_[0]->{values} }; }
sub set_values {
  my ($self,$values) = @_;
  croak(__PACKAGE__."::set_values : argument is not an array reference\n") unless ref($values) eq 'ARRAY';
  @{ $self->{values} }=@$values;
}
sub init {
  my ($self,$opts)=@_;
  $self->{-parent}{-decl} = 'choice';
}
sub post_process {
  my ($choice,$opts)=@_;
  $choice->{values} = delete $choice->{value};
}

sub validate_object {
  my ($self, $object, $opts) = @_;
  my $ok = 0;
  my $values = $self->{values};
  if ($values) {
    foreach (@{$values}) {
      if ($_ eq $object) {
	$ok = 1;
	last;
      }
    }
  }
  if (!$ok and ref($opts) and ref($opts->{log})) {
    my $path = $opts->{path};
    my $tag = $opts->{tag};
    $path.="/".$tag if $tag ne q{};
    push @{$opts->{log}}, "$path: Invalid value: '$object'";
  }
  return $ok;
}

sub serialize_get_children {
  my ($choice,$opts)=@_;
  return map ['value',$_],@{$choice->{values}};
}


1;
__END__

=head1 SEE ALSO

L<Treex::PML::Schema::Decl>, L<Treex::PML::Schema>, L<Treex::PML::CDATA>.

=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