package PDF::API2::Outline; use base 'PDF::API2::Basic::PDF::Dict'; use strict; use warnings; our $VERSION = '2.043'; # VERSION use Carp qw(croak); use PDF::API2::Basic::PDF::Utils; use Scalar::Util qw(weaken); =head1 NAME PDF::API2::Outline - Manage PDF outlines (a.k.a. bookmarks) =head1 SYNOPSIS # Get/create the top-level outline tree my $outline = $pdf->outline(); # Add an entry my $item = $outline->outline(); $item->title('First Page'); $item->destination($pdf->open_page(1)); =head1 METHODS =cut sub new { my ($class, $api, $parent, $prev) = @_; my $self = $class->SUPER::new(); $self->{'Parent'} = $parent if defined $parent; $self->{'Prev'} = $prev if defined $prev; $self->{' api'} = $api; weaken $self->{' api'}; weaken $self->{'Parent'}; return $self; } =head2 Examine the Outline Tree =head3 has_children my $boolean = $outline->has_children(); Return true if the current outline item has child items. =cut sub has_children { my $self = shift(); # Opened by PDF::API2 return 1 if exists $self->{'First'}; # Created by PDF::API2 return @{$self->{' children'}} > 0 if exists $self->{' children'}; return; } =head3 count my $integer = $outline->count(); Return the number of descendants that are visible when the current outline item is open (expanded). =cut sub count { my $self = shift(); # Set count to the number of descendant items that will be visible when the # current item is open. my $count = 0; if ($self->has_children()) { $self->_load_children() unless exists $self->{' children'}; $count += @{$self->{' children'}}; foreach my $child (@{$self->{' children'}}) { next unless $child->has_children(); next unless $child->is_open(); $count += $child->count(); } } if ($count) { $self->{'Count'} = PDFNum($self->is_open() ? $count : -$count); } return $count; } sub _load_children { my $self = shift(); my $item = $self->{'First'}; return unless $item; $item->realise(); bless $item, __PACKAGE__; push @{$self->{' children'}}, $item; while ($item->next()) { $item = $item->next(); $item->realise(); bless $item, __PACKAGE__; push @{$self->{' children'}}, $item; } return $self; } =head3 first my $child = $outline->first(); Return the first child of the current outline level, if one exists. =cut sub first { my $self = shift(); if (defined $self->{' children'} and defined $self->{' children'}->[0]) { $self->{'First'} = $self->{' children'}->[0]; } return $self->{'First'}; } =head3 last my $child = $outline->last(); Return the last child of the current outline level, if one exists. =cut sub last { my $self = shift(); if (defined $self->{' children'} and defined $self->{' children'}->[-1]) { $self->{'Last'} = $self->{' children'}->[-1]; } return $self->{'Last'}; } =head3 parent my $parent = $outline->parent(); Return the parent of the current item, if not at the top level of the outline tree. =cut sub parent { my $self = shift(); $self->{'Parent'} = shift() if defined $_[0]; return $self->{'Parent'}; } =head3 prev my $sibling = $outline->prev(); Return the previous item of the current level of the outline tree. =cut sub prev { my $self = shift(); $self->{'Prev'} = shift() if defined $_[0]; return $self->{'Prev'}; } =head3 next my $sibling = $outline->next(); Return the next item of the current level of the outline tree. =cut sub next { my $self = shift(); $self->{'Next'} = shift() if defined $_[0]; return $self->{'Next'}; } =head2 Modify the Outline Tree =head3 outline my $child = $outline->outline(); Add an outline item at the end of the current outline's list of children. =cut sub outline { my $self = shift(); my $child = PDF::API2::Outline->new($self->{' api'}, $self); $self->{' children'} //= []; $child->prev($self->{' children'}->[-1]) if @{$self->{' children'}}; $self->{' children'}->[-1]->next($child) if @{$self->{' children'}}; push @{$self->{' children'}}, $child; unless ($child->is_obj($self->{' api'}->{'pdf'})) { $self->{' api'}->{'pdf'}->new_obj($child); } return $child; } =head3 insert_after my $sibling = $outline->insert_after(); Add an outline item immediately following the current item. =cut sub insert_after { my $self = shift(); my $sibling = PDF::API2::Outline->new($self->{' api'}, $self->parent()); $sibling->next($self->next()); $self->next->prev($sibling) if $self->next(); $self->next($sibling); $sibling->prev($self); unless ($sibling->is_obj($self->{' api'}->{'pdf'})) { $self->{' api'}->{'pdf'}->new_obj($sibling); } $self->parent->_reset_children(); return $sibling; } =head3 insert_before $sibling = $outline->insert_before(); Add an outline item immediately preceding the current item. =cut sub insert_before { my $self = shift(); my $sibling = PDF::API2::Outline->new($self->{' api'}, $self->parent()); $sibling->prev($self->prev()); $self->prev->next($sibling) if $self->prev(); $self->prev($sibling); $sibling->next($self); unless ($sibling->is_obj($self->{' api'}->{'pdf'})) { $self->{' api'}->{'pdf'}->new_obj($sibling); } $self->parent->_reset_children(); return $sibling; } sub _reset_children { my $self = shift(); my $item = $self->first(); $self->{' children'} = []; return unless $item; push @{$self->{' children'}}, $item; while ($item->next()) { $item = $item->next(); push @{$self->{' children'}}, $item; } return $self; } =head3 delete $outline->delete(); Remove the current outline item from the outline tree. If the item has any children, they will effectively be deleted as well since they will no longer be linked. =cut sub delete { my $self = shift(); my $prev = $self->prev(); my $next = $self->next(); $prev->next($next) if defined $prev; $next->prev($prev) if defined $next; my $siblings = $self->parent->{' children'}; @$siblings = grep { $_ ne $self } @$siblings; delete $self->parent->{' children'} unless $self->parent->has_children(); return; } =head3 is_open # Get my $boolean = $outline->is_open(); # Set my $outline = $outline->is_open($boolean); Get/set whether the outline is expanded or collapsed. =cut sub is_open { my $self = shift(); # Get unless (@_) { # Created by PDF::API2 return $self->{' closed'} ? 0 : 1 if exists $self->{' closed'}; # Opened by PDF::API2 return $self->{'Count'}->val() > 0 if exists $self->{'Count'}; # Default return 1; } # Set my $is_open = shift(); $self->{' closed'} = (not $is_open); return $self; } # Deprecated sub open { my $self = shift(); return $self->is_open(1); } # Deprecated sub closed { my $self = shift(); return $self->is_open(0); } =head2 Set Outline Attributes =head3 title # Get my $title = $outline->title(); # Set $outline = $outline->title($text); Get/set the title of the outline item. =cut sub title { my $self = shift(); # Get unless (@_) { return unless $self->{'Title'}; return $self->{'Title'}->val(); } # Set my $text = shift(); $self->{'Title'} = PDFStr($text); return $self; } =head3 destination $outline = $outline->destination($destination, $location, @args); Set the destination page and optional position of the outline. C<$location> and C<@args> are as defined in L. C<$destination> can optionally be the name of a named destination defined elsewhere. =cut sub _destination { require PDF::API2::NamedDestination; return PDF::API2::NamedDestination::_destination(@_); } sub destination { my ($self, $destination, $location, @args) = @_; # Remove an existing action dictionary delete $self->{'A'}; if (ref($destination)) { # Page Destination $self->{'Dest'} = _destination($destination, $location, @args); } else { # Named Destination $self->{'Dest'} = PDFStr($destination); } return $self; } # Deprecated: Use destination with the indicated changes sub dest { my ($self, $destination, $location, @args) = @_; # Replace -fit => 1 or -fitb => 1 with just the location if (defined $location) { @args = () if $location eq '-fit' or $location eq '-fitb'; } # Convert args from arrayref to array @args = @{$args[0]} if @args and ref($args[0]) eq 'ARRAY'; # Remove hyphen prefix from location $location =~ s/^-// if defined $location; return $self->destination($destination, $location, @args); } =head3 uri $outline = $outline->uri($uri); Launch a URI -- typically a web page -- when the outline item is activated. =cut # Deprecated (renamed) sub url { return uri(@_) } sub uri { my ($self, $uri) = @_; delete $self->{'Dest'}; $self->{'A'} = PDFDict(); $self->{'A'}->{'S'} = PDFName('URI'); $self->{'A'}->{'URI'} = PDFStr($uri); return $self; } =head3 launch $outline->launch($file); Launch an application or file when the outline item is activated. =cut # Deprecated (renamed) sub file { return launch(@_) } sub launch { my ($self, $file) = @_; delete $self->{'Dest'}; $self->{'A'} = PDFDict(); $self->{'A'}->{'S'} = PDFName('Launch'); $self->{'A'}->{'F'} = PDFStr($file); return $self; } =head3 pdf $outline = $outline->pdf($filename, $page_number, $location, @args); Open another PDF file to a particular page number (first page is zero, which is also the default). The page can optionally be positioned at a particular location if C<$location> and C<@args> are set -- see L for possible settings. =cut # Deprecated (renamed) sub pdfile { return pdf_file(@_) } # Deprecated; use pdf instead, with the indicated changes sub pdf_file { my ($self, $file, $page_number, $location, @args); # Replace -fit => 1 or -fitb => 1 with just the location if (defined $location) { @args = () if $location eq '-fit' or $location eq '-fitb'; } # Convert args from arrayref to array @args = @{$args[0]} if @args and ref($args[0]) eq 'ARRAY'; # Remove hyphen prefix from location $location =~ s/^-// if defined $location; return $self->pdf($file, $page_number, $location, @args); } sub pdf { my ($self, $file, $page_number, $location, @args) = @_; $page_number //= 0; delete $self->{'Dest'}; $self->{'A'} = PDFDict(); $self->{'A'}->{'S'} = PDFName('GoToR'); $self->{'A'}->{'F'} = PDFStr($file); $self->{'A'}->{'D'} = _destination(PDFNum($page_number), $location, @args); return $self; } sub fix_outline { my $self = shift(); $self->first(); $self->last(); $self->count(); } sub outobjdeep { my $self = shift(); $self->fix_outline(); return $self->SUPER::outobjdeep(@_); } 1;