File Coverage

blib/lib/assign/Hash.pm
Criterion Covered Total %
statement 38 40 95.0
branch 5 8 62.5
condition n/a
subroutine 7 7 100.0
pod 0 2 0.0
total 50 57 87.7


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