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   346 use 5.006;
  18         37  
19 18     18   57 use strict;
  18         20  
  18         627  
20 18     18   55 use warnings;
  18         20  
  18         427  
21              
22 18     18   58 use Carp;
  18         18  
  18         1000  
23 18     18   65 use FileHandle;
  18         18  
  18         116  
24 18     18   4705 use Data::Dumper;
  18         21  
  18         729  
25 18     18   62 use Scalar::Util qw(weaken);
  18         19  
  18         7468  
26              
27             our $VERSION = '1.41';
28             our $DEBUG = 0;
29              
30             sub new
31             {
32 43     43 0 8513 my $this = shift;
33 43   33     8569 my $class = ref($this) || $this;
34 43         8476 my $self = {};
35 43         8537 bless $self, $class;
36 43         8557 $self->{'Kids'} = [];
37 43         17200 $self;
38             }
39              
40             sub add
41             {
42 34     34 0 6618 my $self = shift;
43 34         6644 my $outline = PDF::Create::Outline->new();
44 34         6630 $outline->{'id'} = shift;
45 34         6580 $outline->{'name'} = shift;
46 34         6605 $outline->{'Parent'} = $self;
47 34         6658 weaken $outline->{Parent};
48 34         6610 $outline->{'pdf'} = $self->{'pdf'};
49 34         6713 weaken $outline->{pdf};
50 34         6714 my %params = @_;
51 34 50       6658 $outline->{'Title'} = $params{'Title'} if defined $params{'Title'};
52 34 50       6640 $outline->{'Action'} = $params{'Action'} if defined $params{'Action'};
53             $outline->{'Status'} = defined $params{'Status'}
54 34 100 66     6696 && ( $params{'Status'} eq 'closed' || !$params{'Status'} ) ? 0 : 1;
55             $outline->{'Dest'} = $params{'Destination'}
56 34 50       6691 if defined $params{'Destination'};
57 34         6599 push @{ $self->{'Kids'} }, $outline;
  34         13245  
58 34         13319 $outline;
59             }
60              
61             sub count
62             {
63 87     87 0 17790 my $self = shift;
64              
65 87         17788 my $c = scalar @{ $self->{'Kids'} };
  87         35669  
66 87 100       29993 return $c unless $c;
67 27         5921 for my $outline ( @{ $self->{'Kids'} } ) {
  27         11925  
68 52         10981 my $v = $outline->count;
69 52 100       16951 $c += $v if $outline->{'Status'};
70             }
71 27 100       5933 $c *= -1 unless $self->{'Status'};
72 27         11933 $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 6769 my $self = shift;
87 35         6735 my @l;
88 35         6658 for my $e ( @{ $self->{'Kids'} } ) {
  35         13530  
89 30         5865 my @t = $e->list;
90 30         5804 push @l, $e;
91 30 100       8728 push @l, @t if scalar @t;
92             }
93 35         13434 @l;
94             }
95              
96             sub new_outline
97             {
98 16     16 0 7569 my $self = shift;
99              
100 16         3826 $self->{'pdf'}->new_outline( 'Parent' => $self, @_ );
101             }
102              
103             1;