File Coverage

blib/lib/Treex/PML/Schema/List.pm
Criterion Covered Total %
statement 28 48 58.3
branch 0 10 0.0
condition 0 3 0.0
subroutine 11 15 73.3
pod 5 6 83.3
total 44 82 53.6


line stmt bran cond sub pod time code
1             package Treex::PML::Schema::List;
2              
3 8     8   55 use strict;
  8         17  
  8         322  
4 8     8   36 use warnings;
  8         14  
  8         481  
5              
6 8     8   61 use vars qw($VERSION);
  8         27  
  8         548  
7             BEGIN {
8 8     8   220 $VERSION='2.28'; # version template
9             }
10 8     8   44 no warnings 'uninitialized';
  8         16  
  8         415  
11 8     8   46 use Carp;
  8         15  
  8         583  
12 8     8   49 use UNIVERSAL::DOES;
  8         15  
  8         317  
13 8     8   37 use Treex::PML::Schema::Constants;
  8         31  
  8         927  
14 8     8   44 use base qw( Treex::PML::Schema::Decl );
  8         13  
  8         4193  
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 0 sub is_atomic { 0 }
55 609     609 1 1332 sub get_decl_type { return PML_LIST_DECL; }
56 0     0 1 0 sub get_decl_type_str { return 'list'; }
57 0     0 1 0 sub is_ordered { return $_[0]->{ordered} }
58              
59             sub init {
60 98     98 0 217 my ($self,$opts)=@_;
61 98         359 $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__