File Coverage

blib/lib/PDF/Template.pm

Criterion	Covered	Total	%
statement	21	23	91.3
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	29	31	93.5

package PDF::Template;

use strict;

BEGIN {
    use PDF::Template::Base;
    use vars qw ($VERSION @ISA);

    $VERSION = '0.22';
    @ISA     = qw (PDF::Template::Base);
}

use pdflib_pl;

use File::Basename;
use IO::File;
use XML::Parser;

#-----------------------------------------------
# TODO
#-----------------------------------------------
# PDF_set_info - find out more about this
# Providers - I need to create some provider classes that abstract
#    the process of PDF creation.    This will enable P::T to work with
#    different PDF providers.    A provider could be passed in to the
#    constructor.    If non is passed, P::T should try to instantiate a
#    sensible provider depending on what is installed.
#-----------------------------------------------

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

    $self->{TEMPLATES} = [] unless UNIVERSAL::isa($self->{TEMPLATES}, 'ARRAY');
    $self->{PARAM_MAP} = {} unless UNIVERSAL::isa($self->{PARAM_MAP}, 'HASH');

    $self->{PDF_VERSION} = 0;
    for my $version (reverse 1 .. 6)
    {
        eval "UNIVERSAL::VERSION('pdflib_pl', $version.0)";
        unless ($@)
        {
            $self->{PDF_VERSION} = $version;
            last;
        }
    }
    die "Cannot find pdflib_pl version",$/ unless $self->{PDF_VERSION};

    $self->_validate_option($_)
        for qw(OPENACTION OPENMODE);

    $self->parse_xml($self->{FILENAME}) if defined $self->{FILENAME};

    return $self;
}

sub param
{
    my $self = shift;

    # Allow an arbitrary number of hashrefs, so long as they're the first things
    # into param(). Put each one onto the end, de-referenced.
    push @_, %{shift @_} while UNIVERSAL::isa($_[0], 'HASH');

    (@_ % 2)
        && die __PACKAGE__, "->param() : Odd number of parameters to param()\n";

    my %params = @_;
    $params{uc $_} = delete $params{$_} for keys %params;
    @{$self->{PARAM_MAP}}{keys %params} = @params{keys %params};

    return 1;
}

sub write_file
{
    my $self = shift;
    my ($fname) = @_;

    my $p = pdflib_pl::PDF_new();

    pdflib_pl::PDF_open_file($p, $fname) == -1
        && die "pdflib_pl::PDF_open_file could not open file '$fname'.", $/;

    $self->_prepare_output($p);

    pdflib_pl::PDF_close($p);

    return 1;
}

sub output
{
    my $self = shift;

    $self->get_buffer(@_);
}

sub get_buffer
{
    my $self = shift;

    my $p = pdflib_pl::PDF_new();

    pdflib_pl::PDF_open_file($p, '') == -1
        && die "pdflib_pl::PDF_open_file could not open buffer.", $/;

    $self->_prepare_output($p);

    pdflib_pl::PDF_close($p);

    return pdflib_pl::PDF_get_buffer($p);
}

sub parse
{
    my $self = shift;

    $self->parse_xml(@_);
}

sub parse_xml
{
    my $self = shift;
    my ($fname) = @_;

    my %Has_TextObject = map { $_ => undef } qw(
        BOOKMARK
        IMAGE
        TEXTBOX
    );

    my ($filename, $dirname) = fileparse($fname);

    my @stack;
    my $parser = XML::Parser->new(
        Base => $dirname,
        Handlers => {
            Start => sub {
                shift;
#                { local $"="', '"; print "Start: '@_'\n"; }
                my $name = uc shift;

                # Pass the PDF encoding in.
                if ($name eq 'PDFTEMPLATE')
                {
                    if (exists $self->{PDF_ENCODING})
                    {
                        push @_, (
                            PDF_ENCODING => $self->{PDF_ENCODING},
                        );
                    }
                }

                my $node = PDF::Template::Factory->create_node($name, @_);
                die "'$name' (@_) didn't make a node!\n" unless defined $node;

                if ($name eq 'VAR')
                {
                    return unless @stack;

                    if (exists $stack[-1]{TXTOBJ} && $stack[-1]{TXTOBJ}->isa('TEXTOBJECT'))
                    {
                        push @{$stack[-1]{TXTOBJ}{STACK}}, $node;
                    }
                }
                elsif ($name eq 'PDFTEMPLATE')
                {
                    push @{$self->{TEMPLATES}}, $node;
                }
                else
                {
                    push @{$stack[-1]{ELEMENTS}}, $node
                        if @stack;
                }

                push @stack, $node;
#                print "Pushed $node onto stack\n";
            },
            Char => sub {
                shift;
#                { local $"="', '"; print "Char:  '@_'\n"; }
                return unless @stack;

                my $parent = $stack[-1];
                if (exists $parent->{TXTOBJ} && $parent->{TXTOBJ}->isa('TEXTOBJECT'))
                {
#                    print "Added '@_' to TextObject stack for '$parent'\n";
                    push @{$parent->{TXTOBJ}{STACK}}, @_;
                }
            },
            End => sub {
                shift;
#                { local $"="', '"; print "End:   '@_'\n"; }
                return unless @stack;

                pop @stack if $stack[-1]->isa(uc $_[0]);
            },
        },
    );

    {
        my $fh = IO::File->new($fname)
            || die "Cannot open '$fname' for reading: $!\n";

        $parser->parse(do { local $/ = undef; <$fh> });

        $fh->close;
    }

    return 1;
}

my %NoSetProperty = (
    'CreationDate' => 1,
    'Producer' => 1,
    'ModDate' => 1,
    'Trapped' => 1,
);

sub _prepare_output
{
    my $self = shift;
    my ($p) = @_;

    pdflib_pl::PDF_set_parameter($p, 'openaction', $self->{OPENACTION});
    pdflib_pl::PDF_set_parameter($p, 'openmode', $self->{OPENMODE});

    if (UNIVERSAL::isa($self->{INFO}, 'HASH'))
    {
        foreach my $key ( keys %{$self->{INFO}} )
        {
            if ($NoSetProperty{$key})
            {
                warn "Document property '$key' cannot be set.", $/;
                next;
            }

            pdflib_pl::PDF_set_info($p, $key, $self->{INFO}{$key});
        }
    }
    else
    {
        pdflib_pl::PDF_set_info($p, $_, __PACKAGE__) for qw/Creator Author/;
    }

    # __PAGE__ is incremented after the page is done.
    $self->{PARAM_MAP}{__PAGE__} = 1;

    # __PAGEDEF__ is incremented when the pagedef begins.
    $self->{PARAM_MAP}{__PAGEDEF__} = 0;

    my $context = PDF::Template::Factory->create(
        'CONTEXT',
        # Un-scoped variables
        X => 0,
        Y => 0,

        # Other variables
        PDF       => $p,
        PARAM_MAP => [ $self->{PARAM_MAP} ],

        PDF_VERSION     => $self->{PDF_VERSION},
        DIE_ON_NO_PARAM => $self->{DIE_ON_NO_PARAM},
    );

    # Do a first pass through, noting important values
    $_->preprocess($context) for @{$self->{TEMPLATES}};

    # Do a second pass through, for actual rendering
    $_->render($context) for @{$self->{TEMPLATES}};

    $context->close_images;

    return 1;
}

sub register { shift; PDF::Template::Factory::register(@_) }

1;
__END__