File Coverage

blib/lib/Test/MockCommand/ScalarReadline.pm
Criterion Covered Total %
statement 61 61 100.0
branch 24 26 92.3
condition 6 9 66.6
subroutine 5 5 100.0
pod 1 1 100.0
total 97 102 95.1


line stmt bran cond sub pod time code
1             package Test::MockCommand::ScalarReadline;
2 19     19   66109 use strict;
  19         37  
  19         455  
3 19     19   83 use warnings;
  19         234  
  19         445  
4 19     19   83 use Carp qw(croak);
  19         33  
  19         931  
5              
6             require Exporter;
7 19     19   99 use vars qw(@ISA @EXPORT_OK);
  19         27  
  19         8109  
8             @ISA = qw(Exporter);
9             @EXPORT_OK = qw(scalar_readline);
10              
11             sub scalar_readline {
12 170 50 66 170 1 13914 croak "scalar context but no second parameter" unless wantarray() || @_ > 1;
13              
14             # return empty array or undef if there's no data
15 170 100 66     797 if ((!defined $_[0]) || $_[0] eq '') {
16 11 50       19 return () if wantarray();
17 11         13 $_[1] = 0;
18 11         21 return undef;
19             }
20              
21             # slurp mode: $/ = undef
22 159 100       482 if (not defined $/) {
23 5 100       79 return ($_[0]) if wantarray();
24 1         2 $_[1] = length $_[0];
25 1         3 return $_[0];
26             }
27              
28             # record mode: $/ = \$record_size
29 154 100 66     401 if (ref $/ eq 'SCALAR' && ${$/} > 0) {
  99         248  
30             # scalar wanted: return the first record
31 99 100       184 if (! wantarray()) {
32 83         94 my $out = substr($_[0], 0, ${$/});
  83         111  
33 83         92 $_[1] = length $out;
34 83         150 return $out;
35             }
36              
37             # list wanted: return all records
38 16         53 my ($offset, $length, @out) = (0, length $_[0]);
39 16         66 while ($offset < $length) {
40 332         371 push @out, substr($_[0], $offset, ${$/});
  332         516  
41 332         458 $offset += ${$/};
  332         565  
42             }
43 16         498 return @out;
44             }
45              
46             # paragraph mode: $/ = ''
47 55         224 my $rs = $/;
48 55         104 my $paras = 0;
49 55 100       138 if ($rs eq '') {
50 7         24 $rs = "\n\n";
51 7         17 $paras = 1;
52             }
53              
54             # regular or paragraph mode: scalar wanted
55 55 100       187 if (! wantarray()) {
56 24         32 my $found = index $_[0], $rs;
57 24 100       38 if ($found < 0) {
58 5         8 $_[1] = length $_[0];
59 5         11 return $_[0];
60             }
61             else {
62 19         25 $_[1] = $found + length $rs;
63 19 100       29 if ($paras) { while (substr($_[0], $_[1], 1) eq "\n") { $_[1]++; } }
  2         6  
  1         2  
64 19         58 return substr($_[0], 0, $found + length $rs);
65             }
66             }
67              
68             # regular or paragraph mode: list wanted
69 31         57 my @out;
70 31         64 my $pos = 0;
71 31         177 while ((my $found = index $_[0], $rs, $pos) >= 0) {
72 89         145 my $next = $found + length $rs;
73 89         218 push @out, substr($_[0], $pos, $next - $pos);
74 89 100       186 if ($paras) { while (substr($_[0], $next, 1) eq "\n") { $next++; } }
  8         38  
  3         17  
75 89         210 $pos = $next;
76             }
77 31 100       185 push @out, substr($_[0], $pos) if $pos < length $_[0];
78              
79 31         539 return @out;
80             }
81              
82             1;
83             __END__