line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
##################################################################### |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# This is a stripped down version of IO::Scalar |
4
|
|
|
|
|
|
|
# Given a reference to a scalar, it supplies either: |
5
|
|
|
|
|
|
|
# a getline method which reads lines (mode='r'), or |
6
|
|
|
|
|
|
|
# a print method which reads lines (mode='w') |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
##################################################################### |
9
|
|
|
|
|
|
|
package Perl::Tidy::IOScalar; |
10
|
38
|
|
|
38
|
|
301
|
use strict; |
|
38
|
|
|
|
|
108
|
|
|
38
|
|
|
|
|
1315
|
|
11
|
38
|
|
|
38
|
|
262
|
use warnings; |
|
38
|
|
|
|
|
131
|
|
|
38
|
|
|
|
|
1208
|
|
12
|
38
|
|
|
38
|
|
219
|
use Carp; |
|
38
|
|
|
|
|
96
|
|
|
38
|
|
|
|
|
3460
|
|
13
|
|
|
|
|
|
|
our $VERSION = '20230701'; |
14
|
|
|
|
|
|
|
|
15
|
38
|
|
|
38
|
|
269
|
use constant EMPTY_STRING => q{}; |
|
38
|
|
|
|
|
122
|
|
|
38
|
|
|
|
|
24589
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub AUTOLOAD { |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# Catch any undefined sub calls so that we are sure to get |
20
|
|
|
|
|
|
|
# some diagnostic information. This sub should never be called |
21
|
|
|
|
|
|
|
# except for a programming error. |
22
|
0
|
|
|
0
|
|
0
|
our $AUTOLOAD; |
23
|
0
|
0
|
|
|
|
0
|
return if ( $AUTOLOAD =~ /\bDESTROY$/ ); |
24
|
0
|
|
|
|
|
0
|
my ( $pkg, $fname, $lno ) = caller(); |
25
|
0
|
|
|
|
|
0
|
my $my_package = __PACKAGE__; |
26
|
0
|
|
|
|
|
0
|
print STDERR <<EOM; |
27
|
|
|
|
|
|
|
====================================================================== |
28
|
|
|
|
|
|
|
Error detected in package '$my_package', version $VERSION |
29
|
|
|
|
|
|
|
Received unexpected AUTOLOAD call for sub '$AUTOLOAD' |
30
|
|
|
|
|
|
|
Called from package: '$pkg' |
31
|
|
|
|
|
|
|
Called from File '$fname' at line '$lno' |
32
|
|
|
|
|
|
|
This error is probably due to a recent programming change |
33
|
|
|
|
|
|
|
====================================================================== |
34
|
|
|
|
|
|
|
EOM |
35
|
0
|
|
|
|
|
0
|
exit 1; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
0
|
|
|
sub DESTROY { |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# required to avoid call to AUTOLOAD in some versions of perl |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub new { |
44
|
2759
|
|
|
2759
|
0
|
7641
|
my ( $package, $rscalar, $mode ) = @_; |
45
|
2759
|
|
|
|
|
5792
|
my $ref = ref $rscalar; |
46
|
2759
|
50
|
|
|
|
8495
|
if ( $ref ne 'SCALAR' ) { |
47
|
0
|
|
|
|
|
0
|
confess <<EOM; |
48
|
|
|
|
|
|
|
------------------------------------------------------------------------ |
49
|
|
|
|
|
|
|
expecting ref to SCALAR but got ref to ($ref); trace follows: |
50
|
|
|
|
|
|
|
------------------------------------------------------------------------ |
51
|
|
|
|
|
|
|
EOM |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
} |
54
|
2759
|
100
|
|
|
|
9730
|
if ( $mode eq 'w' ) { |
|
|
50
|
|
|
|
|
|
55
|
1103
|
|
|
|
|
3720
|
${$rscalar} = EMPTY_STRING; |
|
1103
|
|
|
|
|
3725
|
|
56
|
1103
|
|
|
|
|
5996
|
return bless [ $rscalar, $mode ], $package; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
elsif ( $mode eq 'r' ) { |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# Convert a scalar to an array. |
61
|
|
|
|
|
|
|
# This avoids looking for "\n" on each call to getline |
62
|
|
|
|
|
|
|
# |
63
|
|
|
|
|
|
|
# NOTES: The -1 count is needed to avoid loss of trailing blank lines |
64
|
|
|
|
|
|
|
# (which might be important in a DATA section). |
65
|
1656
|
|
|
|
|
3077
|
my @array; |
66
|
1656
|
100
|
66
|
|
|
6125
|
if ( $rscalar && ${$rscalar} ) { |
|
1656
|
|
|
|
|
7576
|
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
#@array = map { $_ .= "\n" } split /\n/, ${$rscalar}, -1; |
69
|
1321
|
|
|
|
|
3285
|
@array = map { $_ . "\n" } split /\n/, ${$rscalar}, -1; |
|
16932
|
|
|
|
|
34342
|
|
|
1321
|
|
|
|
|
9965
|
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# remove possible extra blank line introduced with split |
72
|
1321
|
100
|
66
|
|
|
10094
|
if ( @array && $array[-1] eq "\n" ) { pop @array } |
|
1183
|
|
|
|
|
2691
|
|
73
|
|
|
|
|
|
|
} |
74
|
1656
|
|
|
|
|
3857
|
my $i_next = 0; |
75
|
1656
|
|
|
|
|
9171
|
return bless [ \@array, $mode, $i_next ], $package; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
else { |
78
|
0
|
|
|
|
|
0
|
confess <<EOM; |
79
|
|
|
|
|
|
|
------------------------------------------------------------------------ |
80
|
|
|
|
|
|
|
expecting mode = 'r' or 'w' but got mode ($mode); trace follows: |
81
|
|
|
|
|
|
|
------------------------------------------------------------------------ |
82
|
|
|
|
|
|
|
EOM |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub getline { |
87
|
17405
|
|
|
17405
|
0
|
26696
|
my $self = shift; |
88
|
17405
|
|
|
|
|
29744
|
my $mode = $self->[1]; |
89
|
17405
|
50
|
|
|
|
37469
|
if ( $mode ne 'r' ) { |
90
|
0
|
|
|
|
|
0
|
confess <<EOM; |
91
|
|
|
|
|
|
|
------------------------------------------------------------------------ |
92
|
|
|
|
|
|
|
getline call requires mode = 'r' but mode = ($mode); trace follows: |
93
|
|
|
|
|
|
|
------------------------------------------------------------------------ |
94
|
|
|
|
|
|
|
EOM |
95
|
|
|
|
|
|
|
} |
96
|
17405
|
|
|
|
|
27036
|
my $i = $self->[2]++; |
97
|
17405
|
|
|
|
|
43073
|
return $self->[0]->[$i]; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub print { |
101
|
8563
|
|
|
8563
|
0
|
17079
|
my ( $self, $msg ) = @_; |
102
|
8563
|
|
|
|
|
14462
|
my $mode = $self->[1]; |
103
|
8563
|
50
|
|
|
|
18540
|
if ( $mode ne 'w' ) { |
104
|
0
|
|
|
|
|
0
|
confess <<EOM; |
105
|
|
|
|
|
|
|
------------------------------------------------------------------------ |
106
|
|
|
|
|
|
|
print call requires mode = 'w' but mode = ($mode); trace follows: |
107
|
|
|
|
|
|
|
------------------------------------------------------------------------ |
108
|
|
|
|
|
|
|
EOM |
109
|
|
|
|
|
|
|
} |
110
|
8563
|
|
|
|
|
11759
|
${ $self->[0] } .= $msg; |
|
8563
|
|
|
|
|
24934
|
|
111
|
8563
|
|
|
|
|
19952
|
return; |
112
|
|
|
|
|
|
|
} |
113
|
1666
|
|
|
1666
|
0
|
4192
|
sub close { return } |
114
|
|
|
|
|
|
|
1; |
115
|
|
|
|
|
|
|
|