File Coverage

blib/lib/Treex/PML/Schema/Constant.pm
Criterion Covered Total %
statement 25 44 56.8
branch 0 6 0.0
condition 0 9 0.0
subroutine 10 17 58.8
pod 7 9 77.7
total 42 85 49.4


line stmt bran cond sub pod time code
1             package Treex::PML::Schema::Constant;
2              
3 6     6   42 use strict;
  6         12  
  6         172  
4 6     6   30 use warnings;
  6         12  
  6         170  
5              
6 6     6   28 use vars qw($VERSION);
  6         11  
  6         256  
7             BEGIN {
8 6     6   100 $VERSION='2.24'; # version template
9             }
10 6     6   28 no warnings 'uninitialized';
  6         11  
  6         165  
11 6     6   29 use Carp;
  6         11  
  6         299  
12              
13 6     6   31 use Treex::PML::Schema::Constants;
  6         10  
  6         485  
14 6     6   33 use base qw( Treex::PML::Schema::Decl );
  6         9  
  6         2144  
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 0 sub is_atomic { 1 }
63 16     16 1 46 sub get_decl_type { return PML_CONSTANT_DECL; }
64 0     0 1 0 sub get_decl_type_str { return 'constant'; }
65 0     0 1 0 sub get_content_decl { return(undef); }
66 0     0 1 0 sub get_value { return $_[0]->{value}; }
67 0     0 1 0 sub get_values { my @val=($_[0]->{value}); return @val; }
  0         0  
68             sub init {
69 2     2 0 7 my ($self,$opts)=@_;
70 2         15 $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__