File Coverage

lib/Devel/PerlySense/Util.pm
Criterion Covered Total %
statement 58 58 100.0
branch 9 12 75.0
condition n/a
subroutine 14 14 100.0
pod 5 5 100.0
total 86 89 96.6


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Devel::PerlySense::Util - Utility routines
4              
5             =cut
6              
7              
8              
9 64     64   228 use strict;
  64         72  
  64         2270  
10 64     64   239 use warnings;
  64         74  
  64         4771  
11 64     64   616 use utf8;
  64         84  
  64         336  
12              
13             package Devel::PerlySense::Util;
14 64     64   12671 use base "Exporter";
  64         82  
  64         508  
15              
16             our @EXPORT = (
17             qw/
18             slurp
19             spew
20             textRenderTemplate
21             filePathNormalize
22             /);
23              
24              
25              
26              
27              
28 64     64   10139 use Carp;
  64         69  
  64         3609  
29 64     64   642 use Data::Dumper;
  64         5215  
  64         2839  
30 64     64   237 use File::Basename;
  64         104  
  64         3703  
31 64     64   233 use Path::Class 0.11;
  64         1416  
  64         3036  
32 64     64   12388 use File::Spec::Functions qw/ splitdir /;
  64         16119  
  64         43884  
33              
34              
35              
36              
37              
38             =head1 ROUTINES
39              
40             =head2 aNamedArg($raParam, @aArg)
41              
42             Return list of argument valies in $rhArg for the param names in
43             $raParam.
44              
45             Die on missing arguments.
46              
47             =cut
48             sub aNamedArg {
49 518998     518998 1 1954956 my ($raParam, @aArg) = @_;
50 518998         1929361 my %hArg = @aArg;
51              
52 518998         380967 my @aResult;
53 518998         523632 for my $param (@$raParam) {
54 4109271 100       5439685 exists $hArg{$param} or do {
55 4         199 local $Carp::CarpLevel = 1;
56 4         114 croak("Missing argument ($param). Arguments: (" . join(", ", sort keys %hArg) . ")");
57             };
58 4109267         4302720 push(@aResult, $hArg{$param});
59             }
60              
61 518994         3670354 return(@aResult);
62             }
63              
64              
65              
66              
67              
68             =head2 slurp($file)
69              
70             Read the contents of $file and return it, or undef if the file
71             couldn't be opened.
72              
73             =cut
74             sub slurp {
75 63     63 1 140 my ($file) = @_;
76 63 100       997 open(my $fh, "<", $file) or return undef;
77 61         6609 local $/;
78 61         35779 return <$fh>;
79             }
80              
81              
82              
83              
84              
85             =head2 spew($file, $text)
86              
87             Crete a new $file a and print $text to it.
88              
89             Return 1 on success, else 0.
90              
91             =cut
92             sub spew {
93 5     5 1 13 my ($file, $text) = @_;
94 5 50       43 open(my $fh, ">", $file) or return 0;
95 5 50       813 print $fh $text or return 0;
96 5         450 return 1;
97             }
98              
99              
100              
101              
102              
103             =head2 filePathNormalize($file)
104              
105             Return the normalized path of $file, i.e. with "dir/dir2/../dir3"
106             becoming "dir/dir3".
107              
108             The path doesn't have to exist.
109              
110             =cut
111             sub filePathNormalize {
112 32     32 1 1737 my ($filePath) = @_;
113              
114 32         20 my @aDirNew;
115 32         59 for my $dir (splitdir($filePath)) {
116 459 100       1100 if($dir eq "..") {
117             ###TODO: @aDirNew or die("Malformed file ($filePath). Too many parent dirs ('sample_dir/../..')\n");
118 11         14 pop(@aDirNew);
119             }
120             else {
121 448         417 push(@aDirNew, $dir);
122             }
123             }
124            
125 32         139 return file(@aDirNew) . "";
126             }
127              
128              
129              
130              
131              
132             =head2 textRenderTemplate($template, $rhParam)
133              
134             Replace the keys in $rhParam with the values in $rhParam, for
135             everything in $template that looks like
136              
137             ${KEY_NAME}
138              
139             Return the rendered template.
140              
141             =cut
142             sub textRenderTemplate {
143 5     5 1 109 my ($template, $rhParam) = @_;
144              
145 5         25 my $rex = join("|", map { quotemeta } sort keys %$rhParam);
  10         20  
146 5         140 my $rhParamEnv = { %ENV, %$rhParam };
147              
148 5 50       83 $template =~ s/\${($rex)}/ $rhParamEnv->{$1} || "" /eg; ###TODO: should be //
  8         38  
149              
150 5         47 return $template;
151             }
152              
153              
154              
155              
156              
157             1;
158              
159              
160              
161              
162              
163             __END__
164              
165             =encoding utf8
166              
167             =head1 AUTHOR
168              
169             Johan Lindström, C<< <johanl[ÄT]DarSerMan.com> >>
170              
171             =head1 BUGS
172              
173             Please report any bugs or feature requests to
174             C<bug-devel-perlysense@rt.cpan.org>, or through the web interface at
175             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel-PerlySense>.
176             I will be notified, and then you'll automatically be notified of progress on
177             your bug as I make changes.
178              
179             =head1 ACKNOWLEDGEMENTS
180              
181             =head1 COPYRIGHT & LICENSE
182              
183             Copyright 2005 Johan Lindström, All Rights Reserved.
184              
185             This program is free software; you can redistribute it and/or modify it
186             under the same terms as Perl itself.
187              
188             =cut