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 12     12   45 use strict;
  12         13  
  12         342  
3 12     12   36 use warnings;
  12         14  
  12         240  
4 12     12   97 use 5.10.0;
  12         24  
  12         407  
5 12     12   38 use Exporter qw< import >;
  12         12  
  12         2462  
6             our @EXPORT = qw< open_file >;
7              
8             sub _source_for_nargs (_) {
9 4 50   4   7 my $nargs = shift or die;
10 4         5 my $args = join ',', map {'$a'.$_} 1..$nargs;
  10         16  
11 4         266 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         6 +{ map {
20 1     1   2 my $cb = eval _source_for_nargs;
21 4 50       8 $@ and die $@;
22 4         9 $_ => $cb; } 1..4 };
23             }
24              
25             sub _callback_for_nargs(_) {
26             # build callbacks for number of arguments from 1 to 4
27 2     2   3 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     40 $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 426 return shift if ref ($_[0]||=$_);
36 2         5 ( _callback_for_nargs +@_ )->(@_)
37             }