File Coverage

blib/lib/Pod/Simple/TiedOutFH.pm
Criterion Covered Total %
statement 27 36 75.0
branch 5 8 62.5
condition 4 9 44.4
subroutine 7 11 63.6
pod 0 1 0.0
total 43 65 66.1


line stmt bran cond sub pod time code
1             package Pod::Simple::TiedOutFH;
2 71     71   113932 use strict;
  71         215  
  71         3050  
3 71     71   380 use warnings;
  71         140  
  71         4664  
4 71     71   35202 use Symbol ('gensym');
  71         104519  
  71         6658  
5 71     71   565 use Carp ();
  71         126  
  71         26795  
6             our $VERSION = '3.47';
7              
8             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
9              
10             sub handle_on { # some horrible frightening things are encapsulated in here
11 885     885 0 150211 my $class = shift;
12 885   33     3011 $class = ref($class) || $class;
13              
14 885 50       2133 Carp::croak "Usage: ${class}->handle_on(\$somescalar)" unless @_;
15              
16 885 100 66     3464 my $x = (defined($_[0]) and ref($_[0]))
17             ? $_[0]
18             : ( \( $_[0] ) )[0]
19             ;
20 885 50       1954 $$x = '' unless defined $$x;
21              
22             #Pod::Simple::DEBUG and print STDERR "New $class handle on $x = \"$$x\"\n";
23              
24 885         2755 my $new = gensym();
25 885         23547 tie *$new, $class, $x;
26 885         2875 return $new;
27             }
28              
29             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
30              
31             sub TIEHANDLE { # Ties to just a scalar ref
32 885     885   2508 my($class, $scalar_ref) = @_;
33 885 50       2397 $$scalar_ref = '' unless defined $$scalar_ref;
34 885   33     5126 return bless \$scalar_ref, ref($class) || $class;
35             }
36              
37             sub PRINT {
38 18180     18180   29213 my $it = shift;
39 18180         32028 foreach my $x (@_) { $$$it .= $x }
  39190         75868  
40              
41             #Pod::Simple::DEBUG > 10 and print STDERR " appended to $$it = \"$$$it\"\n";
42              
43 18180         38893 return 1;
44             }
45              
46             sub FETCH {
47 0     0     return ${$_[0]};
  0            
48             }
49              
50             sub PRINTF {
51 0     0     my $it = shift;
52 0           my $format = shift;
53 0           $$$it .= sprintf $format, @_;
54 0           return 1;
55             }
56              
57 0     0     sub FILENO { ${ $_[0] } + 100 } # just to produce SOME number
  0            
58              
59 0     0     sub CLOSE { 1 }
60              
61             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
62             1;
63             __END__