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   5175 use strict;
  67         128  
  67         2137  
7 67     67   42538 use Pod::Simple::BlackBox;
  67         198  
  67         3226  
8 67     67   427 use vars qw($VERSION );
  67         116  
  67         5750  
9             $VERSION = '3.43';
10              
11             use overload( # So it'll stringify nice
12 67         585 '""' => \&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   56683 );
  67         46250  
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 117 goto &Pod::Simple::BlackBox::stringify_lol;
29             }
30              
31             sub new {
32 530     530 0 1128 my $class = shift;
33 530   33     1640 $class = ref($class) || $class;
34 530         768 my $new;
35 530 50       1213 if(@_ == 1) {
36 530 100 50     2095 if (!ref($_[0] || '')) { # most common case: one bare string
    50 50        
37 166         938 return bless ['', {}, $_[0] ], $class;
38             } elsif( ref($_[0] || '') eq 'ARRAY') {
39 364         575 $new = [ @{ $_[0] } ];
  364         1326  
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         779 foreach my $x (@$new) {
49 1294 100 100     4473 if(ref($x || '') eq 'ARRAY') {
    100 100        
50 126         348 $x = $class->new($x); # recurse
51             } elsif(ref($x || '') eq 'HASH') {
52 364         934 $x = { %$x };
53             }
54             # otherwise leave it.
55             }
56              
57 364         1108 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__