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              
2 53     53   7062 use strict;
  53         114  
  53         2265  
3             package Pod::Simple::TiedOutFH;
4 53     53   22850 use Symbol ('gensym');
  53         39285  
  53         3285  
5 53     53   359 use Carp ();
  53         113  
  53         974  
6 53     53   280 use vars qw($VERSION );
  53         102  
  53         16063  
7             $VERSION = '3.42';
8              
9             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
10              
11             sub handle_on { # some horrible frightening things are encapsulated in here
12 870     870 0 1639 my $class = shift;
13 870   33     2509 $class = ref($class) || $class;
14            
15 870 50       1737 Carp::croak "Usage: ${class}->handle_on(\$somescalar)" unless @_;
16            
17 870 100 66     2809 my $x = (defined($_[0]) and ref($_[0]))
18             ? $_[0]
19             : ( \( $_[0] ) )[0]
20             ;
21 870 50       1726 $$x = '' unless defined $$x;
22            
23             #Pod::Simple::DEBUG and print STDERR "New $class handle on $x = \"$$x\"\n";
24            
25 870         2094 my $new = gensym();
26 870         15112 tie *$new, $class, $x;
27 870         2234 return $new;
28             }
29              
30             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
31              
32             sub TIEHANDLE { # Ties to just a scalar ref
33 870     870   2335 my($class, $scalar_ref) = @_;
34 870 50       1849 $$scalar_ref = '' unless defined $$scalar_ref;
35 870   33     4020 return bless \$scalar_ref, ref($class) || $class;
36             }
37              
38             sub PRINT {
39 18141     18141   24702 my $it = shift;
40 18141         26572 foreach my $x (@_) { $$$it .= $x }
  39096         63077  
41              
42             #Pod::Simple::DEBUG > 10 and print STDERR " appended to $$it = \"$$$it\"\n";
43              
44 18141         32908 return 1;
45             }
46              
47             sub FETCH {
48 0     0     return ${$_[0]};
  0            
49             }
50              
51             sub PRINTF {
52 0     0     my $it = shift;
53 0           my $format = shift;
54 0           $$$it .= sprintf $format, @_;
55 0           return 1;
56             }
57              
58 0     0     sub FILENO { ${ $_[0] } + 100 } # just to produce SOME number
  0            
59              
60 0     0     sub CLOSE { 1 }
61              
62             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
63             1;
64             __END__