File Coverage

blib/lib/Perlude/Open.pm
Criterion Covered Total %
statement 24 24 100.0
branch 4 6 66.6
condition 2 6 33.3
subroutine 8 8 100.0
pod 0 1 0.0
total 38 45 84.4


line stmt bran cond sub pod time code
1             package Perlude::Open;
2 13     13   68 use strict;
  13         21  
  13         427  
3 13     13   73 use warnings;
  13         23  
  13         336  
4 13     13   175 use 5.10.0;
  13         43  
  13         647  
5 13     13   82 use Exporter qw< import >;
  13         25  
  13         3761  
6             our @EXPORT = qw< open_file >;
7              
8             sub _source_for_nargs (_) {
9 4 50   4   10 my $nargs = shift or die;
10 4         8 my $args = join ',', map {'$a'.$_} 1..$nargs;
  10         28  
11 4         518 sprintf 'sub {
12             my (%s) = @_;
13             open my $fh, %s
14             or die "$! while open_file %s";
15             $fh; }', ($args)x3;
16             };
17              
18             sub _prepare_special_forms {
19 4         11 +{ map {
20 1     1   3 my $cb = eval _source_for_nargs;
21 4 50       15 $@ and die $@;
22 4         15 $_ => $cb; } 1..4 };
23             }
24              
25             sub _callback_for_nargs(_) {
26             # build callbacks for number of arguments from 1 to 4
27 2     2   5 state $open_with = _prepare_special_forms;
28             # the 4 arguments form callback should work for 4 and more.
29             # i copy this ref on demand whenever i see a new number of arguments
30 2   33     79 $open_with->{ +@_ } ||= $open_with->{4};
31             }
32              
33             sub open_file {
34             # if the file (can be $_) is open, just return
35 4 100 33 4 0 1498 return shift if ref ($_[0]||=$_);
36 2         9 ( _callback_for_nargs +@_ )->(@_)
37             }