File Coverage

blib/lib/Treex/PML/Schema/Constant.pm
Criterion Covered Total %
statement 22 44 50.0
branch 0 6 0.0
condition 0 9 0.0
subroutine 8 17 47.0
pod 7 9 77.7
total 37 85 43.5


line stmt bran cond sub pod time code
1             package Treex::PML::Schema::Constant;
2              
3 1     1   12 use strict;
  1         1  
  1         26  
4 1     1   3 use warnings;
  1         1  
  1         24  
5              
6 1     1   4 use vars qw($VERSION);
  1         1  
  1         39  
7             BEGIN {
8 1     1   21 $VERSION='2.22'; # version template
9             }
10 1     1   3 no warnings 'uninitialized';
  1         1  
  1         25  
11 1     1   3 use Carp;
  1         1  
  1         67  
12              
13 1     1   3 use Treex::PML::Schema::Constants;
  1         1  
  1         75  
14 1     1   4 use base qw( Treex::PML::Schema::Decl );
  1         1  
  1         326  
15              
16             =head1 NAME
17              
18             Treex::PML::Schema::Constant - implements constant declaration.
19              
20             =head1 INHERITANCE
21              
22             This class inherits from L.
23              
24             =head1 METHODS
25              
26             See the super-class for the complete list.
27              
28             =over 3
29              
30             =item $decl->get_decl_type ()
31              
32             Returns the constant PML_CONSTANT_DECL.
33              
34             =item $decl->get_decl_type_str ()
35              
36             Returns the string 'constant'.
37              
38             =item $decl->get_value ()
39              
40             Return the constant value.
41              
42             =item $decl->get_values ()
43              
44             Returns a singleton list consisting of the constant value (for
45             compatibility with choice declarations).
46              
47             =item $decl->is_atomic ()
48              
49             Returns 1.
50              
51             =item $decl->get_content_decl ()
52              
53             Returns undef.
54              
55              
56              
57             =back
58              
59             =cut
60              
61              
62 0     0 1   sub is_atomic { 1 }
63 0     0 1   sub get_decl_type { return PML_CONSTANT_DECL; }
64 0     0 1   sub get_decl_type_str { return 'constant'; }
65 0     0 1   sub get_content_decl { return(undef); }
66 0     0 1   sub get_value { return $_[0]->{value}; }
67 0     0 1   sub get_values { my @val=($_[0]->{value}); return @val; }
  0            
68             sub init {
69 0     0 0   my ($self,$opts)=@_;
70 0           $self->{-parent}{-decl} = 'constant';
71             }
72              
73             sub validate_object {
74 0     0 1   my ($self, $object, $opts) = @_;
75 0           my $const = $self->{value};
76 0 0         my $ok = ($object eq $const) ? 1 : 0;
77 0 0 0       if (!$ok and ref($opts) and ref($opts->{log})) {
      0        
78 0           my $path = $opts->{path};
79 0           my $tag = $opts->{tag};
80 0 0         $path.="/".$tag if $tag ne q{};
81 0           push @{$opts->{log}}, "$path: invalid constant, should be '$const', got: '$object'";
  0            
82             }
83 0           return $ok;
84             }
85              
86             sub serialize_get_children {
87 0     0 0   my ($self,$opts)=@_;
88 0   0       my $writer = $opts->{writer} || croak __PACKAGE__."->serialize: missing required option 'writer'!\n";
89 0           return [undef, $self->{value}];
90             }
91              
92             1;
93             __END__