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