File Coverage

lib/PDF/WebKit.pm
Criterion Covered Total %
statement 19 21 90.4
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 26 28 92.8


line stmt bran cond sub pod time code
1             package PDF::WebKit;
2 3     3   565294 use 5.008008;
  3         19  
  3         119  
3 3     3   15 use strict;
  3         6  
  3         94  
4 3     3   14 use warnings;
  3         9  
  3         83  
5 3     3   15 use Carp ();
  3         5  
  3         65  
6 3     3   3539 use IO::File ();
  3         3555  
  3         61  
7 3     3   5009 use IPC::Run ();
  3         140632  
  3         76  
8              
9 3     3   1472 use PDF::WebKit::Configuration;
  0            
  0            
10             use PDF::WebKit::Source;
11              
12             our $VERSION = '0.92';
13              
14             use Moose;
15              
16             has source => ( is => 'rw' );
17             has stylesheets => ( is => 'rw' );
18             has options => ( is => 'ro', writer => '_set_options' );
19              
20             around 'BUILDARGS' => sub {
21             my $orig = shift;
22             my $class = shift;
23              
24             if (@_ % 2 == 0) {
25             Carp::croak "Usage: ${class}->new(\$url_file_or_html,%options)";
26             }
27              
28             my $url_file_or_html = shift;
29             my $options = { @_ };
30             return $class->$orig({ source => $url_file_or_html, options => $options });
31             };
32              
33             sub BUILD {
34             my ($self,$args) = @_;
35              
36             $self->source( PDF::WebKit::Source->new($args->{source}) );
37             $self->stylesheets( [] );
38             $self->_set_options({
39             $self->_normalize_options(%{ $self->configuration->default_options }),
40             $self->_normalize_options(%{ $args->{options} }),
41             $self->_normalize_options($self->_find_options_in_meta),
42             });
43              
44             if (not -e $self->configuration->wkhtmltopdf) {
45             my $msg = "No wkhtmltopdf executable found\n";
46             $msg .= ">> Please install wkhtmltopdf - https://github.com/jdpace/PDFKit/wiki/Installing-WKHTMLTOPDF";
47             die $msg;
48             }
49             }
50              
51             sub configuration {
52             PDF::WebKit::Configuration->configuration
53             }
54              
55             sub configure {
56             my $class = shift;
57             $class->configuration->configure(@_);
58             }
59              
60             sub command {
61             my $self = shift;
62             my $path = shift;
63             my @args = ( $self->_executable, $self->_prepare_options, '--quiet' );
64            
65             if ($self->source->is_html) {
66             push @args, '-'; # Get HTML from stdin
67             }
68             else {
69             push @args, $self->source->content;
70             }
71              
72             push @args, $path || '-'; # write to file or stdout
73              
74             return grep { defined($_) } @args;
75             }
76              
77             sub _executable {
78             my $self = shift;
79             my $default = $self->configuration->wkhtmltopdf;
80             return $default if $default !~ /^\//; # it's not a path, so nothing we can do
81             if (-e $default) {
82             return $default;
83             }
84             else {
85             return (split(/\//, $default))[-1];
86             }
87             }
88              
89             sub to_pdf {
90             my $self = shift;
91             my $path = shift;
92              
93             $self->_append_stylesheets;
94             my @args = $self->command($path);
95              
96             my $input = $self->source->is_html ? $self->source->content : undef;
97             my $output;
98              
99             IPC::Run::run( \@args, "<", \$input, ">", \$output );
100              
101             if ($path) {
102             $output = do { local (@ARGV,$/) = ($path); <> };
103             }
104              
105             if (not (defined($output) && length($output))) {
106             Carp::croak "command failed: $args[0]";
107             }
108             return $output;
109             }
110              
111             sub to_file {
112             my $self = shift;
113             my $path = shift;
114             $self->to_pdf($path);
115             my $FH = IO::File->new($path,"<")
116             || Carp::croak "can't open '$path': $!";
117             $FH->binmode();
118             return $FH;
119             }
120              
121             sub _find_options_in_meta {
122             my ($self) = @_;
123             return () if $self->source->is_url;
124             # if we can't parse for whatever reason, keep calm and carry on.
125             my @result = eval { $self->_pdf_webkit_meta_tags };
126             return $@ ? () : @result;
127             }
128              
129             sub _pdf_webkit_meta_tags {
130             my ($self) = @_;
131             return () unless eval { require XML::LibXML };
132             my $source = $self->source;
133              
134             my $prefix = $self->configuration->meta_tag_prefix;
135              
136             # these options do not work at the constructor level in XML::LibXML 1.70, so pass
137             # them through to the parser.
138             my %options = (
139             recover => 2,
140             suppress_errors => 1,
141             suppress_warnings => 1,
142             no_network => 1,
143             );
144              
145             my $parser = XML::LibXML->new();
146             my $doc = $source->is_html ? $parser->parse_html_string($source->content,\%options)
147             : $source->is_file ? $parser->parse_html_file($source->string,\%options)
148             : return ();
149              
150             my %meta;
151             for my $node ($doc->findnodes('html/head/meta')) {
152             my $name = $node->getAttribute('name');
153             next unless ($name && ($name =~ s{^\Q$prefix}{}s));
154             $meta{$name} = $node->getAttribute('content');
155             }
156              
157             return %meta;
158             }
159              
160             sub _style_tag_for {
161             my ($self,$stylesheet) = @_;
162             my $styles = do { local (@ARGV,$/) = ($stylesheet); <> };
163             return "<style>$styles</style>";
164             }
165              
166             sub _append_stylesheets {
167             my $self = shift;
168             if (@{ $self->stylesheets } && !$self->source->is_html) {
169             Carp::croak "stylesheets may only be added to an HTML source";
170             }
171             return unless $self->source->is_html;
172              
173             my $styles = join "", map { $self->_style_tag_for($_) } @{$self->stylesheets};
174             return unless length($styles) > 0;
175              
176             # can't modify in-place, because the source might be a reference to a
177             # read-only constant string literal
178             my $html = $self->source->content;
179             if (not ($html =~ s{(?=</head>)}{$styles})) {
180             $html = $styles . $html;
181             }
182             $self->source->string(\$html);
183             }
184              
185             sub _prepare_options {
186             my ($self) = @_;
187             my $options = $self->options;
188             my @args;
189             while (my ($name,$val) = each %$options) {
190             next unless defined($val) && length($val);
191             if ($val eq 'yes' || $val eq 'YES') {
192             push @args, $name;
193             }
194             else {
195             push @args, $name, $val;
196             }
197             }
198             return @args;
199             }
200              
201             sub _normalize_options {
202             my $self = shift;
203             my %orig_options = @_;
204             my %normalized_options;
205             while (my ($key,$val) = each %orig_options) {
206             my $normalized_key = $self->_normalize_arg($key);
207             $normalized_options{$normalized_key} = $val;
208             }
209             return %normalized_options;
210             }
211              
212             sub _normalize_arg {
213             my ($self,$arg) = @_;
214             $arg =~ lc($arg);
215             $arg =~ s{[^a-z0-9]}{-}g;
216             $arg =~ s{^-*}{--};
217             return $arg;
218             }
219              
220             no Moose;
221             __PACKAGE__->meta->make_immutable;
222              
223             1;
224              
225             =head1 NAME
226              
227             PDF::WebKit - Use WebKit to Generate PDFs from HTML (via wkhtmltopdf)
228              
229             =head1 SYNOPSIS
230              
231             use PDF::WebKit;
232              
233             # PDF::WebKit->new takes the HTML and any options for wkhtmltopdf
234             # run `wkhtmltopdf --extended-help` for a full list of options
235             my $kit = PDF::WebKit->new(\$html, page_size => 'Letter');
236             push @{ $kit->stylesheets }, "/path/to/css/file";
237              
238             # Get an inline PDF
239             my $pdf = $kit->to_pdf;
240              
241             # save the PDF to a file
242             my $file = $kit->to_file('/path/to/save/pdf');
243              
244             # PDF::WebKit can optionally accept a URL or a File
245             # Stylesheets cannot be added when source is provided as a URL or File.
246             my $kit = PDF::WebKit->new('http://google.com');
247             my $kit = PDF::WebKit->new('/path/to/html');
248              
249             # Add any kind of option through meta tags
250             my $kit = PDF::WebKit->new(\'<html><head><meta name="pdfkit-page_size" content="Letter"...');
251              
252             =head1 DESCRIPTION
253              
254             PDF::WebKit uses L<wkhtmltopdf|http://code.google.com/p/wkhtmltopdf/> to
255             convert HTML documents into PDFs. It is a port of the elegant
256             L<PDFKit|https://github.com/jdpace/PDFKit> Ruby library.
257              
258             wkhtmltopdf generates beautiful PDFs by leveraging the rendering power
259             of Qt's WebKit browser engine (used by both Apple Safari and Google
260             Chrome browsers).
261              
262             =head2 Configuration
263              
264             Configuration of PDF::WebKit is configured globally by calling the
265             C<PDF::WebKit->configure> class method:
266              
267             PDF::WebKit->configure(sub {
268             # default `which wkhtmltopdf`
269             $_->wkhtmltopdf('/path/to/wkhtmltopdf');
270              
271             # default 'pdf-webkit-'
272             $_->meta_tag_prefix('my-prefix-');
273              
274             $_->default_options->{'--orientation'} = 'Portrait';
275             });
276              
277             See the L<new|/Constructor> method for the standard default options.
278              
279             =head2 Constructor
280              
281             =over 4
282              
283             =item new($SOURCE_URL,%OPTIONS)
284              
285             =item new($SOURCE_FILENAME,%OPTIONS)
286              
287             =item new(\$SOURCE_HTML,%OPTIONS)
288              
289             Creates and returns a new instance. If the first parameter looks like a
290             URL, it is treated as a URL and handed off to wkhtmltopdf verbatim. If
291             it is is a reference to a scalar, it is an HTML document body.
292             Otherwise, the parameter is interpreted as a filename.
293              
294             The %OPTIONS hash is a list of name/value pairs for command-line
295             options to wkhtmltopdf. These options can augment or override the
296             default options. For options with no associated value, pass C<undef> as
297             the value.
298              
299             The default options are:
300              
301             --page-size Letter
302             --margin-top 0.75in
303             --margin_right 0.75in
304             --margin_bottom 0.75in
305             --margin_left 0.75in
306             --encoding UTF-8
307              
308             =back
309              
310             =head2 Methods
311              
312             =over 4
313              
314             =item command
315              
316             Returns the list of command-line arguments that would be used to execute
317             wkhtmltopdf.
318              
319             =item to_pdf
320              
321             Processes the source material and returns a PDF as a string.
322              
323             =item to_file($PATH)
324              
325             Processes the source material and creates a PDF at C<$PATH>. Returns a
326             filehandle opened on C<$PATH>.
327              
328             back
329              
330             =head1 SEE ALSO
331              
332             L<PDFKit|https://github.com/jdpace/PDFKit>,
333             L<wkhtmltopdf|http://code.google.com/p/wkhtmltopdf/>,
334             L<WKHTMLTOPDF|http://search.cpan.org/~tbr/WKHTMLTOPDF-0.02/lib/WKHTMLTOPDF.pm>
335             (a lower-level wrapper for wkhtmltopdf).
336              
337             =head1 AUTHOR
338              
339             Philip Garrett <philip.garrett@icainformatics.com>
340              
341             =head1 CONTRIBUTING
342              
343             If you'd like to contribute, just fork my repository on Github, commit
344             your changes and send me a pull request.
345              
346             http://github.com/kingpong/perl-PDF-WebKit
347              
348             =head1 ACKNOWLEDGMENTS
349              
350             This code is nearly a line-by-line port of Jared Pace's PDFKit.
351             https://github.com/jdpace/PDFKit
352              
353             =head1 COPYRIGHT & LICENSE
354              
355             Copyright (c) 2011 by Informatics Corporation of America.
356              
357             This library is free software; you can redistribute it and/or modify
358             it under the same terms as Perl itself, either Perl version 5.8.8 or,
359             at your option, any later version of Perl 5 you may have available.
360              
361             =cut