File Coverage

blib/lib/assign/Struct.pm
Criterion Covered Total %
statement 50 52 96.1
branch 15 22 68.1
condition 8 12 66.6
subroutine 8 8 100.0
pod 0 4 0.0
total 81 98 82.6


line stmt bran cond sub pod time code
1 5     5   33 use strict; use warnings;
  5     5   8  
  5         148  
  5         26  
  5         14  
  5         176  
2             package assign::Struct;
3              
4 5     5   2530 use assign::Types;
  5         15  
  5         159  
5              
6 5     5   31 use XXX;
  5         10  
  5         20  
7              
8             sub new {
9 24     24 0 48 my $class = shift;
10 24         146 bless {
11             elems => [],
12             @_,
13             }, $class;
14             }
15              
16             sub parse {
17 24     24 0 66 my ($self) = @_;
18              
19 24         59 my $node = $self->{node};
20 24         33 my $statement;
21 24         86 for my $child ($node->children) {
22 54         225 my $type = ref($child);
23 54 100       123 if ($type eq 'PPI::Token::Whitespace') {
24 30         57 next;
25             }
26 24 50       102 if ($type eq 'PPI::Statement') {
27 24 50       59 XXX $node, "more than one statement"
28             if $statement;
29 24         54 $statement = $child;
30 24         47 next;
31             }
32 0         0 XXX $node, "unexpected node";
33             }
34              
35 24 50       84 XXX $node, "no statement in array"
36             unless $statement;
37              
38 24         72 $self->{in} = [ $statement->children ];
39              
40 24         163 while (1) {
41 75 100       176 $self->parse_elem or last;
42 73 100       172 $self->parse_comma or last;
43             }
44              
45 24         91 return $self;
46             }
47              
48             sub parse_comma {
49 73     73 0 131 my ($self) = @_;
50 73         111 my $in = $self->{in};
51 73         144 while (@$in) {
52 51         88 my $tok = shift(@$in);
53 51         82 my $type = ref($tok);
54 51 50       107 next if $type eq 'PPI::Token::Whitespace';
55              
56 51 50 33     130 if ($type eq 'PPI::Token::Operator' and
57             $tok->content eq ','
58             ) {
59 51         295 return 1;
60             }
61             else {
62 0         0 XXX $tok, $in, "comma expected";
63             }
64             }
65 22         51 return 0;
66             }
67              
68             sub get_var {
69 59     59 0 110 my ($self, $var) = @_;
70 59         75 my $def;
71 59         96 my $in = $self->{in};
72 59 100 66     267 if (@$in > 1 and
      100        
73             ref($in->[0]) eq 'PPI::Token::Operator' and
74             $in->[0]->content eq '='
75             ) {
76 4         19 shift @$in;
77 4         15 my $d = shift @$in;
78 4 50       26 XXX $d, "Invalid token for variable default"
79             unless ref($d) =~
80             /^PPI::Token::(Number|Symbol|Quote::(Single|Double))$/;
81 4         10 $def = $d->content;
82 4 50 66     25 XXX $d, "Invalid token for variable default"
83             if ref($d) eq 'PPI::Token::Symbol' and
84             $def !~ /^\$\w+$/;
85             }
86 59         315 var->new($var, $def);
87             }
88              
89             1;