The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

ZABA / Treex-PML-2.06 / lib / Treex / PML / Schema / Constant.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
—
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
—
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111

              
package Treex::PML::Schema::Constant;
use strict;
use warnings;
use vars qw($VERSION);
BEGIN {
  $VERSION='2.06'; # version template
}
no warnings 'uninitialized';
use Carp;
use Treex::PML::Schema::Constants;
use base qw( Treex::PML::Schema::Decl );
=head1 NAME
Treex::PML::Schema::Constant - implements constant declaration.
=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_CONSTANT_DECL.
=item $decl->get_decl_type_str ()
Returns the string 'constant'.
=item $decl->get_value ()
Return the constant value.
=item $decl->get_values ()
Returns a singleton list consisting of the constant value (for
compatibility with choice declarations).
=item $decl->is_atomic ()
Returns 1.
=item $decl->get_content_decl ()
Returns undef.
=back
=cut
sub is_atomic { 1 }
sub get_decl_type { return PML_CONSTANT_DECL; }
sub get_decl_type_str { return 'constant'; }
sub get_content_decl { return(undef); }
sub get_value { return $_[0]->{value}; }
sub get_values { my @val=($_[0]->{value}); return @val; }
sub init {
  my ($self,$opts)=@_;
  $self->{-parent}{-decl} = 'constant';
}
sub validate_object {
  my ($self, $object, $opts) = @_;
  my $const = $self->{value};
  my $ok = ($object eq $const) ? 1 : 0;
  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 constant, should be '$const', got: '$object'";
  }
  return $ok;
}
sub serialize_get_children {
  my ($self,$opts)=@_;
  my $writer = $opts->{writer} || croak __PACKAGE__."->serialize: missing required option 'writer'!\n";
  return [undef, $self->{value}];
}
1;
__END__
=head1 SEE ALSO
L<Treex::PML::Schema::Decl>, L<Treex::PML::Schema>, L<Treex::PML::Schema::Choice>.
=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