File Coverage

blib/lib/PDF/Create/Outline.pm
Criterion Covered Total %
statement 62 68 91.1
branch 13 16 81.2
condition 3 6 50.0
subroutine 12 13 92.3
pod 0 6 0.0
total 90 109 82.5


line stmt bran cond sub pod time code
1             #
2             # PDF::Create::Outline - PDF outline support for PDF::Create
3             #
4             # Author: Fabien Tassin
5             #
6             # Copyright 1999-2001 Fabien Tassin
7             # Copyright 2007 Markus Baertschi
8             # Copyright 2010 Gary Lieberman
9             #
10             # Please see the CHANGES and Changes file for the detailed change log
11             #
12             # Please do not use any of the methods here directly. You will be
13             # punished with your application no longer working after an upgrade !
14             #
15              
16             package PDF::Create::Outline;
17              
18 18     18   457 use 5.006;
  18         43  
19 18     18   64 use strict;
  18         23  
  18         355  
20 18     18   56 use warnings;
  18         19  
  18         492  
21              
22 18     18   64 use Carp;
  18         18  
  18         1118  
23 18     18   60 use FileHandle;
  18         19  
  18         126  
24 18     18   4833 use Data::Dumper;
  18         20  
  18         751  
25 18     18   65 use Scalar::Util qw(weaken);
  18         20  
  18         8377  
26              
27             our $VERSION = '1.42';
28             our $DEBUG = 0;
29              
30             sub new
31             {
32 43     43 0 8130 my $this = shift;
33 43   33     8221 my $class = ref($this) || $this;
34 43         8200 my $self = {};
35 43         8259 bless $self, $class;
36 43         8103 $self->{'Kids'} = [];
37 43         16585 $self;
38             }
39              
40             sub add
41             {
42 34     34 0 6368 my $self = shift;
43 34         6413 my $outline = PDF::Create::Outline->new();
44 34         6490 $outline->{'id'} = shift;
45 34         6257 $outline->{'name'} = shift;
46 34         6355 $outline->{'Parent'} = $self;
47 34         6830 weaken $outline->{Parent};
48 34         6360 $outline->{'pdf'} = $self->{'pdf'};
49 34         6509 weaken $outline->{pdf};
50 34         6331 my %params = @_;
51 34 50       6408 $outline->{'Title'} = $params{'Title'} if defined $params{'Title'};
52 34 50       6308 $outline->{'Action'} = $params{'Action'} if defined $params{'Action'};
53             $outline->{'Status'} = defined $params{'Status'}
54 34 100 66     6789 && ( $params{'Status'} eq 'closed' || !$params{'Status'} ) ? 0 : 1;
55             $outline->{'Dest'} = $params{'Destination'}
56 34 50       6518 if defined $params{'Destination'};
57 34         6311 push @{ $self->{'Kids'} }, $outline;
  34         12476  
58 34         12613 $outline;
59             }
60              
61             sub count
62             {
63 87     87 0 16703 my $self = shift;
64              
65 87         16962 my $c = scalar @{ $self->{'Kids'} };
  87         32987  
66 87 100       28317 return $c unless $c;
67 27         5465 for my $outline ( @{ $self->{'Kids'} } ) {
  27         10604  
68 52         9927 my $v = $outline->count;
69 52 100       15222 $c += $v if $outline->{'Status'};
70             }
71 27 100       5592 $c *= -1 unless $self->{'Status'};
72 27         10779 $c;
73             }
74              
75             sub kids
76             {
77 0     0 0 0 my $self = shift;
78              
79 0         0 my $t = [];
80 0         0 map { push @$t, $_->{'id'} } @{ $self->{'Kids'} };
  0         0  
  0         0  
81 0         0 $t;
82             }
83              
84             sub list
85             {
86 35     35 0 6076 my $self = shift;
87 35         6062 my @l;
88 35         6065 for my $e ( @{ $self->{'Kids'} } ) {
  35         11875  
89 30         5233 my @t = $e->list;
90 30         5112 push @l, $e;
91 30 100       7866 push @l, @t if scalar @t;
92             }
93 35         12493 @l;
94             }
95              
96             sub new_outline
97             {
98 16     16 0 7125 my $self = shift;
99              
100 16         3422 $self->{'pdf'}->new_outline( 'Parent' => $self, @_ );
101             }
102              
103             1;