File Coverage

blib/lib/Treex/PML/Schema/List.pm
Criterion Covered Total %
statement 25 48 52.0
branch 0 10 0.0
condition 0 3 0.0
subroutine 9 15 60.0
pod 5 6 83.3
total 39 82 47.5


line stmt bran cond sub pod time code
1             package Treex::PML::Schema::List;
2              
3 1     1   3 use strict;
  1         1  
  1         21  
4 1     1   3 use warnings;
  1         1  
  1         19  
5              
6 1     1   3 use vars qw($VERSION);
  1         1  
  1         31  
7             BEGIN {
8 1     1   12 $VERSION='2.21'; # version template
9             }
10 1     1   2 no warnings 'uninitialized';
  1         1  
  1         29  
11 1     1   2 use Carp;
  1         1  
  1         43  
12 1     1   3 use UNIVERSAL::DOES;
  1         1  
  1         27  
13 1     1   3 use Treex::PML::Schema::Constants;
  1         1  
  1         75  
14 1     1   47 use base qw( Treex::PML::Schema::Decl );
  1         1  
  1         274  
15              
16             =head1 NAME
17              
18             Treex::PML::Schema::List - implements declaration of a list.
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_LIST_DECL.
33              
34             =item $decl->get_decl_type_str ()
35              
36             Returns the string 'list'.
37              
38             =item $decl->get_content_decl ()
39              
40             Return type declaration of the list members.
41              
42             =item $decl->is_ordered ()
43              
44             Return 1 if the list is declared as ordered.
45              
46             =item $decl->is_atomic ()
47              
48             Returns 0.
49              
50             =back
51              
52             =cut
53              
54 0     0 1   sub is_atomic { 0 }
55 0     0 1   sub get_decl_type { return PML_LIST_DECL; }
56 0     0 1   sub get_decl_type_str { return 'list'; }
57 0     0 1   sub is_ordered { return $_[0]->{ordered} }
58              
59             sub init {
60 0     0 0   my ($self,$opts)=@_;
61 0           $self->{-parent}{-decl} = 'list';
62             }
63              
64              
65             sub validate_object {
66 0     0 1   my ($self, $object, $opts) = @_;
67              
68 0           my ($path,$tag,$flags);
69 0           my $log = [];
70 0 0         if (ref($opts)) {
71 0           $flags = $opts->{flags};
72 0           $path = $opts->{path};
73 0           $tag = $opts->{tag};
74 0 0         $path.="/".$tag if $tag ne q{};
75             }
76 0 0         if (UNIVERSAL::DOES::does($object,'Treex::PML::List')) {
77 0           my $lm_decl = $self->get_knit_content_decl;
78 0           for (my $i=0; $i<@$object; $i++) {
79 0           $lm_decl->validate_object($object->[$i], {
80             flags => $flags,
81             path=> $path,
82             tag => "[".($i+1)."]",
83             log => $log,
84             });
85             }
86             } else {
87 0           push @$log, "$path: unexpected content of a list: $object";
88             }
89 0 0 0       if ($opts and ref($opts->{log})) {
90 0           push @{$opts->{log}}, @$log;
  0            
91             }
92 0 0         return @$log ? 0 : 1;
93             }
94              
95             1;
96             __END__