PDF-Writer-0.06/0000755000076400001440000000000010343653105012027 5ustar robusersPDF-Writer-0.06/META.yml0000644000076400001440000000076110343653105013304 0ustar robusers--- name: PDF-Writer version: 0.06 author: ~ abstract: PDF writer abstraction layer license: perl requires: perl: 5.6.0 build_requires: Test::More: 0.47 provides: PDF::Writer: file: lib/PDF/Writer.pm version: 0.06 PDF::Writer::mock: file: lib/PDF/Writer/mock.pm version: 0.03 PDF::Writer::pdfapi2: file: lib/PDF/Writer/pdfapi2.pm version: 0.01 PDF::Writer::pdflib: file: lib/PDF/Writer/pdflib.pm version: 0.02 generated_by: Module::Build version 0.2701 PDF-Writer-0.06/t/0000755000076400001440000000000010343653105012272 5ustar robusersPDF-Writer-0.06/t/998_pod.t0000644000076400001440000000025710343653105013656 0ustar robusers#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); PDF-Writer-0.06/t/000_interface.t0000644000076400001440000000103010343653105014770 0ustar robusersuse strict; use warnings; use Test::More tests => 3; use_ok( 'PDF::Writer', 'mock' ); can_ok( 'PDF::Writer', 'new' ); my $mock = PDF::Writer->new; my @methods = qw{ open close save begin_page end_page open_image close_image image_height image_width place_image save_state restore_state font font_size find_font show_boxed show_xy circle rect color move linewidth line fill stroke fill_stroke stringify parameter info add_weblink add_bookmark }; can_ok( $mock, @methods ); PDF-Writer-0.06/lib/0000755000076400001440000000000010343653105012575 5ustar robusersPDF-Writer-0.06/lib/PDF/0000755000076400001440000000000010343653105013206 5ustar robusersPDF-Writer-0.06/lib/PDF/Writer/0000755000076400001440000000000010343653105014462 5ustar robusersPDF-Writer-0.06/lib/PDF/Writer/mock.pm0000644000076400001440000000134010343653105015747 0ustar robuserspackage PDF::Writer::mock; use strict; use warnings; our $VERSION = '0.03'; our @mock; my @methods = qw( open close save begin_page end_page open_image close_image image_height image_width place_image save_state restore_state font font_size find_font show_boxed show_xy circle rect color move linewidth line fill stroke fill_stroke stringify parameter info add_weblink add_bookmark ); my $x; sub new { return bless \$x, shift; } foreach my $method (@methods) { no strict 'refs'; *$method = sub { my $self = shift; push @mock, [ $method, @_ ]; return 1; }; } sub mock_reset { @mock = (); } sub mock_retrieve { @mock } 1; __END__ PDF-Writer-0.06/lib/PDF/Writer/pdflib.pm0000644000076400001440000000617610343653105016272 0ustar robuserspackage PDF::Writer::pdflib; use strict; use warnings; our $VERSION = '0.02'; use pdflib_pl; =head1 NAME PDF::Writer::pdflib - pdflib_pl backend =head1 SYNOPSIS (internal use only) =head1 DESCRIPTION No user-serviceable parts inside. =cut my %dispatch = ( close => 'close', info => 'set_info', parameter => 'set_parameter', font => 'setfont', find_font => 'findfont', begin_page => 'begin_page', end_page => 'end_page', save_state => 'save', restore_state => 'restore', linewidth => 'setlinewidth', move => 'moveto', line => 'lineto', rect => 'rect', fill => 'fill', stroke => 'stroke', fill_stroke => 'fill_stroke', show_boxed => 'show_boxed', show_xy => 'show_xy', open_image => 'open_image_file', close_image => 'close_image', place_image => 'place_image', circle => 'circle', add_weblink => 'add_weblink', add_bookmark => 'add_bookmark', ); sub new { my $class = shift; return bless({ pdf => pdflib_pl::PDF_new() }, $class); } sub open { my ($self, $f) = @_; my $p = $self->{pdf}; $f = '' unless defined $f; return (pdflib_pl::PDF_open_file($p, $f) != -1); } sub stringify { my $self = shift; my $p = $self->{pdf}; $self->close; return pdflib_pl::PDF_get_buffer($p); } sub save { goto &{$_[0]->can('close')}; } sub color { my $self = shift; my $p = $self->{pdf}; my ($mode, $palette, @colors) = @_; if (pdflib_pl->VERSION >= 4) { pdflib_pl::PDF_setcolor($p, $mode, $palette, @colors, 0); } elsif ($palette ne 'rgb') { die 'Palette other than "rgb" is not supported'; } elsif ($mode eq 'fill') { pdflib_pl::PDF_setrgbcolor_fill($p, @colors); } elsif ($mode eq 'stroke') { pdflib_pl::PDF_setrgbcolor_stroke($p, @colors); } else { # both pdflib_pl::PDF_setrgbcolor($p, @colors); } } sub font_size { my $self = shift; my $p = $self->{pdf}; return pdflib_pl::PDF_get_value($p, 'fontsize', 0); } sub image_width { my $self = shift; my $p = $self->{pdf}; my ($image) = @_; return pdflib_pl::PDF_get_value($p, 'imagewidth', $image); } sub image_height { my $self = shift; my $p = $self->{pdf}; my ($image) = @_; return pdflib_pl::PDF_get_value($p, 'imageheight', $image); } while (my ($k, $v) = each %dispatch) { no strict 'refs'; my $method = "pdflib_pl::PDF_$v"; *$k = sub { my $self = shift; my $rv = &$method($self->{pdf}, @_); if ($v ne 'show_boxed' && defined $rv) { $rv = '0 but true' if $rv eq '0'; $rv = undef if $rv eq '-1'; } return $rv; }; } 1; =head1 AUTHORS Autrijus Tang Eautrijus@autrijus.orgE =head1 COPYRIGHT Copyright 2004, 2005 by Autrijus Tang Eautrijus@autrijus.orgE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut PDF-Writer-0.06/lib/PDF/Writer/pdfapi2.pm0000644000076400001440000001535210343653105016353 0ustar robuserspackage PDF::Writer::pdfapi2; use strict; use warnings; our $VERSION = '0.01'; use charnames ':full'; use PDF::API2 0.40; =head1 NAME PDF::Writer::pdfapi2 - PDF::API2 backend =head1 SYNOPSIS (internal use only) =head1 DESCRIPTION No user-serviceable parts inside. =cut my %dispatch = ( pdf => [qw( stringify info )], txt => [qw( font )], gfx => [qw( move line linewidth stroke fill circle )], '' => [qw( parameter save_state restore_state end_page )], ); sub new { my $class = shift; return bless({ pdf => PDF::API2->new }, $class); } sub open { my ($self, $f) = @_; $self->{filename} = $f; return !$f || (!-e $f or (!-d $f and -w $f)); } sub save { my $self = shift; my $p = $self->{pdf}; $p->saveas($self->{filename}); } sub open_image { my $self = shift; my $p = $self->{pdf}; my ($type, $file, $foo, $bar) = @_; require "PDF/API2/Resource/XObject/Image/\U$type\E.pm"; return "PDF::API2::Resource::XObject::Image::\U$type\E"->new($p->{pdf}, $file); } sub image_width { my $self = shift; my $p = $self->{pdf}; my ($image) = @_; return $image->width; } sub image_height { my $self = shift; my $p = $self->{pdf}; my ($image) = @_; return $image->height; } sub place_image { my $self = shift; my $p = $self->{pdf}; my ($image, $x, $y, $scale) = @_; #$y -= $image->height; $self->{gfx}->image($image, $x, $y, $scale); } sub close_image { } sub find_font { my $self = shift; my $p = $self->{pdf}; my ($face, $pdf_encoding, $is_embed) = @_; my $mode = ( ($face =~ /\.(?:pf[ab]|ps)$/i) ? 'ps' : ($face =~ /\.(?:ttf|otf|ttc)$/i) ? 'tt' : ($face =~ /(traditional|simplified|korean|japanese2?)/) ? 'cjk' : 'core' ) . 'font'; # XXX - handle $pdf_encoding and $is_embed? return $p->can($mode)->($p, $face); } sub begin_page { my $self = shift; my $p = $self->{pdf}; my ($width, $height) = @_; my $page = $p->page; $page->mediabox($width, $height); $self->{gfx} = $page->gfx; $self->{txt} = $page->text; $self->{page} = $page; return $page; } sub color { my $self = shift; my $p = $self->{pdf}; my ($mode, $palette, @colors) = @_; die 'Palette other than "rgb" is not supported' unless $palette eq 'rgb'; $self->{gfx}->fillcolor(@colors) unless $mode eq 'stroke'; $self->{gfx}->strokecolor(@colors) unless $mode eq 'fill'; $self->{txt}->fillcolor(@colors) unless $mode eq 'stroke'; $self->{txt}->strokecolor(@colors) unless $mode eq 'fill'; } my @SuperScript = ( "\N{SUPERSCRIPT ZERO}", "\N{SUPERSCRIPT ONE}", "\N{SUPERSCRIPT TWO}", "\N{SUPERSCRIPT THREE}", "\N{SUPERSCRIPT FOUR}", "\N{SUPERSCRIPT FIVE}", "\N{SUPERSCRIPT SIX}", "\N{SUPERSCRIPT SEVEN}", "\N{SUPERSCRIPT EIGHT}", "\N{SUPERSCRIPT NINE}", ); my @SubScript = ( "\N{SUBSCRIPT ZERO}", "\N{SUBSCRIPT ONE}", "\N{SUBSCRIPT TWO}", "\N{SUBSCRIPT THREE}", "\N{SUBSCRIPT FOUR}", "\N{SUBSCRIPT FIVE}", "\N{SUBSCRIPT SIX}", "\N{SUBSCRIPT SEVEN}", "\N{SUBSCRIPT EIGHT}", "\N{SUBSCRIPT NINE}", ); sub show_boxed { my $self = shift; my $p = $self->{pdf}; my ($str, $x, $y, $w, $h, $j, $m) = @_; my $txt = $self->{txt}; return 0 if $m eq 'blind'; my $method = 'text'; if ($j =~ /right/) { $x += $w; $method .= "_$j"; } elsif ($j =~ /center/) { $x += $w / 2; $method .= "_$j"; } $txt->translate($x, $y); my @tokens = split(/ /, $str); my @try; my $advance_width; while (@tokens) { push @try, shift(@tokens); $advance_width = $txt->advancewidth("@try"); if ($advance_width >= $w) { # overflow only if absolutely neccessary pop @try if @try > 1; my $chunk = $self->_transform_text("@try"); $self->_draw_underline($txt->advancewidth($chunk)) if $j =~ /underline/; # XXX - sup/sub handling here $txt->can($method)->($self->{txt}, $chunk); return length($str) - length($chunk); } } my $chunk = $self->_transform_text($str); $self->_draw_underline($txt->advancewidth($chunk)) if $j =~ /underline/; $txt->can($method)->($self->{txt}, $chunk); return 0; } sub _transform_text { my ($self, $text) = @_; my $found; foreach my $i (0..9) { # XXX - handle subscript. # also, redraw using ->transform, instead of substituting $found++ if $text =~ s/$SuperScript[$i]/<-<$i>->/g; } if ($found) { $text =~ s/>-><-->/]/g; } return $text; } sub _draw_underline { my $self = shift; my $width = shift or return; my ($txt, $gfx) = @{$self}{'txt', 'gfx'}; my %state = $txt->textstate; my ($x1, $y1) = $txt->textpos; $txt->matrix_update($width, 0); my ($x2, $y2) = $txt->textpos; my $x3 = $x1 + (($y2 - $y1) / $width) * ($txt->{' font'}->underlineposition * $txt->{' fontsize'} / 1000); my $y3 = $y1 + (($x2 - $x1) / $width) * ($txt->{' font'}->underlineposition * $txt->{' fontsize' }/ 1000); my $x4 = $x3 + ($x2 - $x1); my $y4 = $y3 + ($y2 - $y1); $gfx->save; $gfx->linewidth(0.5); $gfx->strokecolor(0, 0, 0); $gfx->move($x3, $y3); $gfx->line($x4, $y4); $gfx->stroke; $gfx->restore; $txt->textstate(%state); } sub show_xy { my $self = shift; my $p = $self->{pdf}; my ($str, $x, $y) = @_; $self->{txt}->translate($x, $y); $self->{txt}->text($str); } sub font_size { my $self = shift; my $p = $self->{pdf}; return $self->{txt}{' fontsize'}; } sub rect { my $self = shift; my $p = $self->{pdf}; my $gfx = $self->{gfx}; $gfx->linewidth(0.2); $gfx->rect(@_); } sub fill_stroke { my $self = shift; my $p = $self->{pdf}; my $gfx = $self->{gfx}; $gfx->fillstroke(@_); } sub close { %{$_[0]} = (); } sub add_weblink { die "->add_weblink is not implemented yet for pdfapi2." } sub add_bookmark { die "->add_bookmark is not implemented yet for pdfapi2." } while (my ($k, $v) = each %dispatch) { foreach my $method (@$v) { no strict 'refs'; if ($k) { *$method = sub { my $self = shift; $self->{$k}->can($method)->($self->{$k}, @_); }; } else { *$method = sub { return 1; } } } } 1; =head1 AUTHORS Autrijus Tang Eautrijus@autrijus.orgE =head1 COPYRIGHT Copyright 2004, 2005 by Autrijus Tang Eautrijus@autrijus.orgE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut PDF-Writer-0.06/lib/PDF/Writer.pm0000644000076400001440000000507710343653105015031 0ustar robuserspackage PDF::Writer; use strict; use warnings; our $VERSION = '0.06'; our $Backend; sub import { my $class = shift; $Backend = shift if @_; require "PDF/Writer/$Backend.pm" if $Backend && $Backend eq 'mock'; } sub new { my $class = shift; my $backend = $Backend || ( eval { require PDF::API2; 1 } ? 'pdfapi2' : eval { require pdflib_pl; 1 } ? 'pdflib' : undef ); if ($backend) { require "PDF/Writer/$backend.pm"; } else { die "No supported PDF backends found!"; } $class .= "::$backend"; return $class->new(@_); } 1; __END__ =head1 NAME PDF::Writer - PDF writer abstraction layer =head1 VERSION This document describes version 0.05 of PDF::Writer, released Oct 25, 2005. =head1 SYNOPSIS use PDF::Writer; # Or, to explicitly specify a back-end ... use PDF::Writer 'pdflib'; use PDF::Writer 'pdfapi2'; use PDF::Writer 'mock'; my $writer = PDF::Writer->new; =head1 DESCRIPTION This is a generalized API that allows a module that generates PDFs to transparently target multiple backends without changing its code. The currently supported backends are: =over 4 =item * PDF::API2 Available from CPAN =item * PDFlib (versions 3+) Available from L. There is both a pay and free version. PDF::Writer will work with both, within their limitations. Please see the appropriate documentation for details. =item * Mock This allows modules that target PDF::Writer to write their tests against a mock interface. Please see L for more information. =back If both PDF::API2 and pdflib_pl are available, PDF::API2 is preferred. If neither is available, a run-time exception will be thrown. You must explicitly load the PDF::Writer::mock driver, if you wish to use it. =head1 METHODS =over 4 =item * B This acts as a factory, loading the appropriate PDF::Writer driver. =back =head1 CODE COVERAGE We use L to test the code coverage of our tests. Below is the L report on this module's test suite. =head1 AUTHORS Originally written by: Autrijus Tang Eautrijus@autrijus.orgE Currently maintained by: Rob Kinyon Erob.kinyon@iinteractive.comE Stevan Little Estevan.little@iinteractive.comE Thanks to Infinity Interactive for generously donating our time. =head1 COPYRIGHT Copyright 2004, 2005 by Autrijus Tang Eautrijus@autrijus.orgE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut PDF-Writer-0.06/Changes0000644000076400001440000000026410343653105013324 0ustar robusersRevision history for Perl extension PDF-Writer. 0.06 Thu Dec 1 15:00:00 2005 - Fixed undef warning in PDF::Writer::pdflib 0.01 Fri Dec 3 01:09:23 2004 - module created PDF-Writer-0.06/MANIFEST0000644000076400001440000000026010343653105013156 0ustar robusersBuild.PL Changes MANIFEST README Makefile.PL lib/PDF/Writer.pm lib/PDF/Writer/pdfapi2.pm lib/PDF/Writer/pdflib.pm lib/PDF/Writer/mock.pm t/000_interface.t t/998_pod.t META.yml PDF-Writer-0.06/Build.PL0000644000076400001440000000076410343653105013332 0ustar robusersuse Module::Build; use 5.6.0; use strict; use warnings; my $build = Module::Build->new( module_name => 'PDF::Writer', license => 'perl', requires => { 'perl' => '5.6.0', }, optional => { }, build_requires => { 'Test::More' => '0.47', }, create_makefile_pl => 'traditional', recursive_test_files => 1, add_to_cleanup => [ 'META.yml', '*.bak', '*.gz', 'Makefile.PL', ], ); $build->create_build_script; PDF-Writer-0.06/README0000644000076400001440000000076010343653105012712 0ustar robusersPDF::Writer version 0.01 =========================== See the individual module documentation for more information INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: None COPYRIGHT AND LICENCE Copyright 2004 & 2005 by Stevan Little, Rob Kinyon This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. PDF-Writer-0.06/Makefile.PL0000644000076400001440000000063010343653105014000 0ustar robusers# Note: this file was auto-generated by Module::Build::Compat version 0.03 use ExtUtils::MakeMaker; WriteMakefile ( 'PL_FILES' => {}, 'INSTALLDIRS' => 'site', 'NAME' => 'PDF::Writer', 'EXE_FILES' => [], 'VERSION_FROM' => 'lib/PDF/Writer.pm', 'PREREQ_PM' => { 'Test::More' => '0.47' } ) ;