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 9     9   524 use strict;
  9         71  
  9         325  
4 9     9   39 use warnings;
  9         13  
  9         488  
5              
6 9     9   40 use vars qw($VERSION);
  9         12  
  9         467  
7             BEGIN {
8 9     9   160 $VERSION='2.29'; # version template
9             }
10 9     9   37 no warnings 'uninitialized';
  9         13  
  9         340  
11 9     9   39 use Carp;
  9         12  
  9         525  
12              
13 9     9   37 use Treex::PML::Schema::Constants;
  9         10  
  9         882  
14 9     9   46 use base qw( Treex::PML::Schema::Decl );
  9         13  
  9         4156  
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 34 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 5 my ($self,$opts)=@_;
70 2         12 $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__