CAM::PDF::Annot - Perl extension for appending annotations on PDFs

  use strict;
  use CAM::PDF::Annot;
  my $pdf = CAM::PDF::Annot->new( 'pdf1.pdf' );
  my $otherDoc = CAM::PDF::Annot->new( 'pdf2.pdf' );
  for my $page ( 1 .. $pdf->numPages() ) {
	my %refs;
    for my $annotRef ( @{$pdf->getAnnotations( $page )} ) {
	  $otherDoc->appendAnnotation( $page, $pdf, $annotRef, \%refs );
	}
  }
  $otherDoc->output('pdf_merged.pdf');

package CAM::PDF::Annot;

use 5.010000;
use strict;
use warnings;

our $VERSION = '0.06';

# Changelog
# 0.06 - update on META.yml to require CAM::PDF
# 0.02 to 0.05 - World writables problem in PAUSE
# 0.01 - Release

use base qw(CAM::PDF);
use Data::Dumper;

sub new {
	my $class = shift;
    my $self = $class->SUPER::new( @_ );

    bless $self, $class;
}

sub appendAnnotation($$$\%) {
	my ( $self, $page, $otherDoc, $otherAnnotRef, $refKeys ) = @_;

	# Sanity check: it only appends objects of /Type /Annot /Subtype /Square|Circle|Polygon|Text
	# returns an empty hash reference
	return {} if ( $otherDoc->getValue( $otherAnnotRef )->{Subtype}{value} !~ /(Square|Circle|Polygon|Text)/ );

	# If document does not have annots in this page, create an annots property
	unless ( exists $self->getPage( $page )->{Annots} ) {
		$self->getPage( $page )->{Annots} = CAM::PDF::Node->new('array',[], scalar $self->getPageObjnum( $page ),'0');
	}

	# get this page's annotation object it will be widely used
	my $annots = $self->getPage( $page )->{Annots};
	# dereferences the previous value in case the annots object was originaly a reference to the object itself...
	$annots = $self->dereference( $annots->{value} )->{value} while $annots->{type} eq 'reference';

	# append the annot object based on the object number
	my $newkey = $self->appendObject( $otherDoc, $otherAnnotRef->{value}, 0 );
	# store the refkey for later
	$$refKeys{$otherAnnotRef->{value}} = $newkey;

	# append a reference to this annot to the annotations object of this page
	my $annotRef = CAM::PDF::Node->new('reference', "$newkey", $self->getPageObjnum( $page ), '0');
	push @{$annots->{value}}, $annotRef;

	# Append the appearance object (if it exists)
	$self->_appendAppearanceObject( $otherDoc, $annotRef, $refKeys );

	# Append the popup object (if it exists)
	$self->_appendPopupObject( $page, $otherDoc, $annotRef, { $otherAnnotRef->{value} => $newkey }, $refKeys );

	# Verify if it has an IRT reference (meaning, if it refers to another annotation)
	my $annotVal = $self->getValue( $annotRef );
	if ( exists $annotVal->{IRT} ) {
		# Check if it is a reference to an already added object
		unless ( exists $refKeys->{$annotVal->{IRT}{value}} ) {
			# In this case the IRT must be added
			$self->appendAnnotation( $page, $otherDoc, $annotVal->{IRT}, $refKeys );
		}
	}

	# Since the annots object was altered, let's flag it
	# I dont know if it is necessary to store it in cache but it seems to work
	$self->{objcache}{$annots->{objnum}} = $self->dereference( $annots->{objnum} );
	$self->{changes}{$annots->{objnum}} = 1;
	$self->{versions}{$annots->{objnum}} = -1;

	# Now, update all the references for the object
	$self->changeRefKeys( $self->{objcache}{$newkey}, $refKeys );

	if (wantarray) {
		return ($newkey, %$refKeys);
	}
	else {
		return $newkey;
	}
}

sub _appendAppearanceObject() {
	my ( $self, $otherDoc, $annotRef, $refKeys ) = @_;
	my $annotVal = $self->getValue( $annotRef );
	my %refs =();

	# Check if this annot has a reference to an APeareance object 
	# (it is expected it will have it...)
	if ( exists $annotVal->{AP} ) {
		my $ap = $self->getValue( $annotVal->{AP} );
		# Check if it wasn't already added before
		unless ( exists $refKeys->{$ap->{N}{value}} ) {
			my $apNkey = $self->appendObject( $otherDoc, $ap->{N}{value}, 0 );

			# keep track of this addition
			$$refKeys{$ap->{N}{value}} = $apNkey;
			$refs{$ap->{N}{value}} = $apNkey;
		}
		# Apparently only for reply cases (in which the APearance object seems to have more than one element
		if ( exists $ap->{D} ) {
			unless ( exists $refKeys->{$ap->{D}{value}} ) {
				my $apDkey = $self->appendObject( $otherDoc, $ap->{D}{value}, 0 );
				
				# keep track of this addition
				$$refKeys{$ap->{D}{value}} = $apDkey;
				$refs{$ap->{D}{value}} = $apDkey;
			}
		}
	}
	return %refs;
}

sub _appendPopupObject() {
	my ( $self, $page, $otherDoc, $annotRef, $parentKeys, $refKeys ) = @_;
	my $annotVal = $self->getValue( $annotRef );
	my $annots = $self->getPage( $page )->{Annots};
	my %refs =();

	# Now check if it has a reference to a popup object
	# (it is bound to have it...)
	# And also check if it wasnt already added
	if ( exists $annotVal->{Popup} ) {
		unless ( exists $refKeys->{$annotVal->{Popup}{value}} ) {
			my $pupkey = $self->appendObject( $otherDoc, $annotVal->{Popup}{value}, 0 );
			$$refKeys{$annotVal->{Popup}{value}} = $pupkey;
			$refs{$annotVal->{Popup}{value}} = $pupkey;
			
			# change its parent reference
			$self->changeRefKeys( $self->{objcache}{$pupkey}, $parentKeys );

			# it also gets a place on the Annots property of the page object
			my $pupRef = $self->copyObject( $annotVal->{Popup} );
			# change the keys in the newly created one to reflect the appended annotation object
			$self->changeRefKeys( $pupRef, { $pupRef->{value} => $pupkey } );
			$self->setObjNum( $pupRef, $annots->{objnum} );
			push @{$annots->{value}}, $pupRef;
		}
	}
	return %refs;
}

sub getAnnotations($) {
		my ( $self, $p ) = @_;
		return $self->getValue( $self->getPage( $p )->{Annots} ) || [];
}

1;
__END__