File Coverage

blib/lib/Catmandu/Fix/Datahub/Util.pm
Criterion Covered Total %
statement 6 20 30.0
branch n/a
condition n/a
subroutine 2 5 40.0
pod 2 2 100.0
total 10 27 37.0


line stmt bran cond sub pod time code
1             package Catmandu::Fix::Datahub::Util;
2              
3 1     1   744 use strict;
  1         1  
  1         25  
4              
5 1     1   2 use Exporter qw(import);
  1         1  
  1         172  
6              
7             our @EXPORT_OK = qw(declare_source walk);
8              
9             ##
10             # For a source $var, that is a path parameter to a fix,
11             # use walk() to get the value and return the generated
12             # $perl code.
13             # @param $var
14             # @param $declared_var
15             # @return $fixer emit code
16             sub declare_source {
17 0     0 1   my ($fixer, $var, $declared_var) = @_;
18            
19 0           my $perl = '';
20              
21 0           my $var_path = $fixer->split_path($var);
22 0           my $var_key = pop @$var_path;
23 0           $perl .= walk($fixer, $var_path, $var_key, $declared_var);
24 0           return $perl;
25             }
26              
27             ##
28             # Walk through a path ($path) until at
29             # $key. Set $h = $val in the fixer code.
30             # $h must be declared before calling walk()
31             # This has the effect of assigning $val (the value of the leaf
32             # node you're walking to) to $h, so you can use $h in your fix.
33             # @param $path
34             # @param $key
35             # @param $h
36             # @return $fixer emit code
37             sub walk {
38 0     0 1   my ($fixer, $path, $key, $h) = @_;
39              
40 0           my $perl = '';
41            
42             $perl .= $fixer->emit_walk_path(
43             $fixer->var,
44             $path,
45             sub {
46 0     0     my $var = shift;
47             $fixer->emit_get_key(
48             $var,
49             $key,
50             sub {
51 0           my $val = shift;
52 0           "${h} = ${val};";
53             }
54 0           );
55             }
56 0           );
57            
58 0           return $perl;
59             }
60              
61             1;
62             __END__
63              
64             __END__
65              
66             =encoding utf-8
67              
68             =head1 NAME
69              
70             =for html <a href="https://travis-ci.org/thedatahub/Catmandu-Fix-Datahub"><img src="https://travis-ci.org/thedatahub/Catmandu-Fix-Datahub.svg?branch=master"></a>
71              
72             Catmandu::Fix::Datahub - Utility functions and generic fixes developed for the Datahub project
73              
74             =head1 SYNOPSIS
75              
76             use Catmandu::Fix::Datahub::Util;
77              
78             =head1 DESCRIPTION
79              
80             use Catmandu::Fix::Datahub::Util;
81              
82             =over 4
83              
84             =item C<declare_source($fixer, $var, $declared_var)>
85              
86             For an item C<$var>, which is a path (as a string) in a Catmandu fix, assign the value at the path to C<$declared_var>,
87             which is a variable that was previously declared in the fix code:
88              
89             my $f_var = $self->fixer->generate_var();
90             $code .= "my ${f_var};";
91             $code .= declare_source($self->fixer, 'foo.bar', $f_var);
92              
93             =item C<walk($fixer, $path, $key, $h)>
94              
95             Walk through a C<$path> (as an arrayref) until at C<$key>. Assign the value of C<$key> to C<$h>.
96             C<$h> must be declared in the fix code.
97              
98             my $f_var = $self->fixer->generate_var();
99             $code .= "my ${f_var};";
100             $code .= walk($self->fixer, ['foo', 'bar'], $f_var);
101              
102             =back
103              
104             =head1 AUTHOR
105              
106             Pieter De Praetere E<lt>pieter@packed.beE<gt>
107              
108             =head1 COPYRIGHT
109              
110             Copyright 2017- PACKED vzw
111              
112             =head1 LICENSE
113              
114             This library is free software; you can redistribute it and/or modify
115             it under the same terms as Perl itself.
116              
117             =head1 SEE ALSO
118              
119             L<Catmandu>
120              
121             =cut