File Coverage

blib/lib/Treex/PML/Schema/Alt.pm
Criterion Covered Total %
statement 22 50 44.0
branch 0 14 0.0
condition 0 6 0.0
subroutine 8 14 57.1
pod 5 6 83.3
total 35 90 38.8


line stmt bran cond sub pod time code
1             package Treex::PML::Schema::Alt;
2              
3 1     1   3 use strict;
  1         1  
  1         22  
4 1     1   3 use warnings;
  1         0  
  1         20  
5              
6 1     1   2 use vars qw($VERSION);
  1         1  
  1         31  
7             BEGIN {
8 1     1   10 $VERSION='2.21'; # version template
9             }
10 1     1   3 no warnings 'uninitialized';
  1         1  
  1         28  
11 1     1   3 use Carp;
  1         1  
  1         37  
12              
13 1     1   4 use Treex::PML::Schema::Constants;
  1         1  
  1         75  
14 1     1   3 use base qw( Treex::PML::Schema::Decl );
  1         0  
  1         341  
15              
16             =head1 NAME
17              
18             Treex::PML::Schema::Alt - implements declaration of an alternative (alt).
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_ALT_DECL.
33              
34             =item $decl->get_decl_type_str ()
35              
36             Returns the string 'alt'.
37              
38             =item $decl->get_content_decl ()
39              
40             Return type declaration of the list members.
41              
42             =item $decl->is_flat ()
43              
44             Return 1 for ``flat'' alternatives, otherwise return 0. (Flat
45             alternatives are not part of PML specification, but are used for
46             translating attribute values from C.)
47              
48             =item $decl->is_atomic ()
49              
50             Returns 0.
51              
52             =back
53              
54             =cut
55              
56 0     0 1   sub is_atomic { 0 }
57 0     0 1   sub get_decl_type { return PML_ALT_DECL; }
58 0     0 1   sub get_decl_type_str { return 'alt'; }
59 0     0 1   sub is_flat { return $_[0]->{-flat} }
60             sub init {
61 0     0 0   my ($self,$opts)=@_;
62 0           $self->{-parent}{-decl} = 'alt';
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           my $am_decl = $self->get_content_decl;
77 0 0 0       if ($self->is_flat) {
    0          
78             # flat alternative:
79 0 0         if (ref($object)) {
80 0           push @$log, "$path: flat alternative is supposed to be a string: $object";
81             } else {
82 0           my $i = 1;
83 0           foreach my $val (split /\|/,$object) {
84 0           $am_decl->validate_object($val, {
85             flags => $flags,
86             path=> $path,
87             tag => "[".($i++)."]",
88             log => $log,
89             });
90             }
91             }
92             } elsif (ref($object) and UNIVERSAL::DOES::does($object,'Treex::PML::Alt')) {
93 0           for (my $i=0; $i<@$object; $i++) {
94 0           $am_decl->validate_object($object->[$i], {
95             flags => $flags,
96             path=> $path,
97             tag => "[".($i+1)."]",
98             log => $log,
99             });
100             }
101             } else {
102 0           $am_decl->validate_object($object,{
103             flags => $flags,
104             path=>$path,
105             # tag => "[1]", # TrEdNodeEdit would very much like [1] here
106             log => $log});
107             }
108 0 0 0       if ($opts and ref($opts->{log})) {
109 0           push @{$opts->{log}}, @$log;
  0            
110             }
111 0 0         return @$log ? 0 : 1;
112             }
113              
114              
115             1;
116             __END__