File Coverage

blib/lib/assign/Hash.pm
Criterion Covered Total %
statement 41 43 95.3
branch 5 8 62.5
condition n/a
subroutine 8 8 100.0
pod 0 2 0.0
total 54 61 88.5


line stmt bran cond sub pod time code
1 5     5   35 use strict; use warnings;
  5     5   10  
  5         151  
  5         21  
  5         9  
  5         177  
2             package assign::Hash;
3              
4 5     5   80 use assign::Struct;
  5         10  
  5         116  
5 5     5   28 use base 'assign::Struct';
  5         9  
  5         500  
6              
7 5     5   31 use assign::Types;
  5         11  
  5         110  
8              
9 5     5   22 use XXX;
  5         8  
  5         22  
10              
11             sub parse_elem {
12 9     9 0 18 my ($self) = @_;
13 9         12 my $in = $self->{in};
14 9         17 my $elems = $self->{elems};
15 9         33 while (@$in) {
16 15         23 my $tok = shift(@$in);
17 15         26 my $type = ref($tok);
18 15 100       32 next if $type eq 'PPI::Token::Whitespace';
19              
20 9 50       17 if ($type eq 'PPI::Token::Symbol') {
21 9         20 my $str = $tok->content;
22 9 50       53 if ($str =~ /^\$\w+$/) {
23 9         26 push @$elems, assign::var->new($str);
24 9         26 return 1;
25             }
26             }
27 0         0 XXX $tok, "unexpected token";
28             }
29 0         0 return 0;
30             }
31              
32             sub gen_code {
33 3     3 0 12 my ($self, $decl, $oper, $from, $init) = @_;
34              
35 3         7 my $code = [ @$init ];
36 3         6 my $elems = $self->{elems};
37              
38 3 50       8 if ($decl) {
39 3         16 push @$code,
40             "$decl(" .
41             join(', ',
42             map $_->val,
43             @$elems
44             ) .
45             ');';
46             }
47              
48 3         12 for my $elem (@$elems) {
49 9         15 my $type = ref $elem;
50 9         18 my $var = $elem->val;
51 9         28 (my $key = $var) =~ s/^\$//;
52 9         34 push @$code, "$var $oper $from\->{$key};";
53             }
54              
55 3         17 return join "\n", @$code;
56             }
57              
58             1;