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 69     69   69846 use strict;
  69         137  
  69         2232  
3 69     69   350 use warnings;
  69         127  
  69         2055  
4 69     69   29290 use Symbol ('gensym');
  69         47346  
  69         4787  
5 69     69   468 use Carp ();
  69         162  
  69         19620  
6             our $VERSION = '3.45';
7              
8             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
9              
10             sub handle_on { # some horrible frightening things are encapsulated in here
11 872     872 0 3028 my $class = shift;
12 872   33     2603 $class = ref($class) || $class;
13              
14 872 50       1860 Carp::croak "Usage: ${class}->handle_on(\$somescalar)" unless @_;
15              
16 872 100 66     2966 my $x = (defined($_[0]) and ref($_[0]))
17             ? $_[0]
18             : ( \( $_[0] ) )[0]
19             ;
20 872 50       1824 $$x = '' unless defined $$x;
21              
22             #Pod::Simple::DEBUG and print STDERR "New $class handle on $x = \"$$x\"\n";
23              
24 872         2480 my $new = gensym();
25 872         16234 tie *$new, $class, $x;
26 872         2360 return $new;
27             }
28              
29             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
30              
31             sub TIEHANDLE { # Ties to just a scalar ref
32 872     872   2157 my($class, $scalar_ref) = @_;
33 872 50       1977 $$scalar_ref = '' unless defined $$scalar_ref;
34 872   33     3900 return bless \$scalar_ref, ref($class) || $class;
35             }
36              
37             sub PRINT {
38 18158     18158   27602 my $it = shift;
39 18158         28866 foreach my $x (@_) { $$$it .= $x }
  39150         68958  
40              
41             #Pod::Simple::DEBUG > 10 and print STDERR " appended to $$it = \"$$$it\"\n";
42              
43 18158         35455 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__