File Coverage

blib/lib/Pod/Simple/LinkSection.pm
Criterion Covered Total %
statement 26 31 83.8
branch 8 10 80.0
condition 7 11 63.6
subroutine 6 8 75.0
pod 0 4 0.0
total 47 64 73.4


line stmt bran cond sub pod time code
1              
2             require 5;
3             package Pod::Simple::LinkSection;
4             # Based somewhat dimly on Array::Autojoin
5              
6 67     67   5473 use strict;
  67         129  
  67         2065  
7 67     67   38860 use Pod::Simple::BlackBox;
  67         192  
  67         2929  
8 67     67   408 use vars qw($VERSION );
  67         113  
  67         5031  
9             $VERSION = '3.42';
10              
11             use overload( # So it'll stringify nice
12 67         536 '""' => \&Pod::Simple::BlackBox::stringify_lol,
13             'bool' => \&Pod::Simple::BlackBox::stringify_lol,
14             # '.=' => \&tack_on, # grudgingly support
15            
16             'fallback' => 1, # turn on cleverness
17 67     67   52614 );
  67         43217  
18              
19             sub tack_on {
20 0     0 0 0 $_[0] = ['', {}, "$_[0]" ];
21 0         0 return $_[0][2] .= $_[1];
22             }
23              
24             sub as_string {
25 0     0 0 0 goto &Pod::Simple::BlackBox::stringify_lol;
26             }
27             sub stringify {
28 2     2 0 118 goto &Pod::Simple::BlackBox::stringify_lol;
29             }
30              
31             sub new {
32 530     530 0 936 my $class = shift;
33 530   33     1345 $class = ref($class) || $class;
34 530         665 my $new;
35 530 50       1006 if(@_ == 1) {
36 530 100 50     1631 if (!ref($_[0] || '')) { # most common case: one bare string
    50 50        
37 166         709 return bless ['', {}, $_[0] ], $class;
38             } elsif( ref($_[0] || '') eq 'ARRAY') {
39 364         501 $new = [ @{ $_[0] } ];
  364         991  
40             } else {
41 0         0 Carp::croak( "$class new() doesn't know to clone $new" );
42             }
43             } else { # misc stuff
44 0         0 $new = [ '', {}, @_ ];
45             }
46              
47             # By now it's a treelet: [ 'foo', {}, ... ]
48 364         702 foreach my $x (@$new) {
49 1294 100 100     4185 if(ref($x || '') eq 'ARRAY') {
    100 100        
50 126         271 $x = $class->new($x); # recurse
51             } elsif(ref($x || '') eq 'HASH') {
52 364         911 $x = { %$x };
53             }
54             # otherwise leave it.
55             }
56              
57 364         1049 return bless $new, $class;
58             }
59              
60             # Not much in this class is likely to be link-section specific --
61             # but it just so happens that link-sections are about the only treelets
62             # that are exposed to the user.
63              
64             1;
65              
66             __END__