package LIMS::Controller::Roles::PDF; use IO::All; use Moose::Role; use Data::Dumper; use Data::Printer; use IPC::Run; use PDF::API2; use PDF::WebKit; use PDF::WebKit::Configuration; BEGIN { # necessary to make PDF::WebKit::Configuration::_find_wkhtmltopdf work properly: local $SIG{CHLD} = 'DEFAULT'; die "Couldn't find wkhtmltopdf" unless PDF::WebKit::Configuration->configuration->wkhtmltopdf; # alternative is to set path manually: # PDF::WebKit->configure( sub { $_->wkhtmltopdf('/usr/local/bin/wkhtmltopdf') } ); } has webkit_stylesheets => ( is => 'ro', isa => 'ArrayRef[Str]', lazy => 1, default => sub { [] }, traits => ['Array'], handles => { add_webkit_stylesheet => 'push', all_webkit_stylesheets => 'elements', }, ); # set metric defaults: PDF::WebKit->configure( sub { $_->default_options->{page_size} = 'A4'; $_->default_options->{margin_top} = '10mm'; $_->default_options->{margin_left} = '10mm'; $_->default_options->{margin_right} = '10mm'; $_->default_options->{margin_bottom} = '10mm'; }); # uses PDF::WebKit, takes html scalarref as stdin (doesn't need temp file): sub inline_html_to_pdf { # ok for single pdf - too slow for print-run my ($self, $html_ref, %args) = @_; # warn Dumper \%args; # scalarref, optional @args my $html = _escape($html_ref); # substitute any chars wkhtmltopdf can't handle my $webkit = PDF::WebKit->new(\$html, %args); # $content must be scalarref push @{ $webkit->stylesheets }, $_ for $self->all_webkit_stylesheets; my $pdf = $webkit->to_pdf; # warn Dumper $webkit->command; # outputs args return $pdf; } # uses same method as PDF::WebKit but faster - for functions doing multiple pdfs: sub inline_html_to_pdf_no_webkit { my ($self, $html_ref, $args) = @_; # warn Dumper $args; warn $html_ref; # aref, scalarref my $html = _escape($html_ref); # substitute any chars wkhtmltopdf can't handle my $output; # $html is str IPC::Run::run( $args, "<", \$html, ">", \$output ); return $output; } sub render_pdf { # used by RecordHandler::_format_report() my ($self, $args) = @_; my $o = $self->stash->{request_data}; # warn Dumper $o->as_tree; # RDBO $args->{data} = $o->as_tree; my $settings = $self->get_pdf_settings($args); # warn Dumper $settings; # aref my $html_ref = $args->{content}; # warn $content; # scalarref my $supplimentary_files = $args->{supplimentary_files}; # optional pdfs to append my $report = $self->inline_html_to_pdf_no_webkit($html_ref, $settings); # faster than WebKit return $report unless $supplimentary_files; { # have supplementary pdfs to append so create new blank pdf: my $pdf = PDF::API2->new; # open report pdf and import into new: my $api = PDF::API2->open_scalar($report); $pdf->importpage($api, $_) foreach 1 .. $api->pages; # append supplementary pdf's to original report: $self->import_supplimentary_files($pdf, $supplimentary_files); return $pdf->stringify(); } } sub combine_pdfs { # used by HILIS4 print-run function (not print_run.pl or reports.pl crons): my ($self, $report, $args) = @_; # $report = aref of reports hashrefs my $tmpl = 'record/default.tt'; my $pdf = PDF::API2->new; # optional supplimentary files to append: my $supplimentary_files = $args->{supplimentary_files}; # HoA { # set tab header: my $reports = scalar @$report; my $start = $args->{offset} + 1; # calculate end as offset + limit, or offset + no. of reports - will work # for all instances except final block with < 50 reports but with some cc's # makings total no. of reports >= 50 my $end = ( $reports < $args->{limit} ) # if no. of reports less than limit: ? $args->{offset} + $reports # eg 201 - 233 : $args->{offset} + $args->{limit}; # eg 201 - 250 my $title = sprintf 'Print run [%s - %s]', $start, $end; $pdf->info( Title => $title ); } for my $r (@$report) { my $html_ref = $self->render_view($tmpl, $r); # warn $html_ref; # scalarref my $request = $r->{data}; # warn ref $request; # LIMS::DB::Request unless copy_to: $request = $request->as_tree unless ref $request eq 'HASH'; # ie copy_to from _generate_copy() my $args = $self->get_pdf_settings({ data => $request }); # aref my $str = $self->inline_html_to_pdf_no_webkit($html_ref, $args); my $api = PDF::API2->open_scalar($str); $pdf->importpage($api, $_) foreach 1 .. $api->pages; # append any supplementary files: my $request_id = $request->{id}; if ( my $files = $supplimentary_files->{$request_id} ) { $self->import_supplimentary_files($pdf, $files); } } # $pdf->saveas('/tmp/print_run.pdf'); # save file to disk return $pdf->stringify(); } # shared by combine_pdfs() & render_pdf() sub import_supplimentary_files { my ($self, $pdf, $supplimentary_files) = @_; for my $new_pdf(@$supplimentary_files) { my $new = PDF::API2->open($new_pdf); foreach ( 1 .. $new->pages ) { my ($llx, $lly, $x, $y) = $new->openpage($_)->get_mediabox(); # p [$llx, $lly, $x, $y]; if ( $x > $y ) { # landscape orientation, convert to portrait: my $page = $pdf->page; my $gfx = $page->gfx(); # import each page from the landscape PDF: my $xo = $pdf->importPageIntoForm($new, $_); # rotate 90 degrees $gfx->rotate(90); # add it to the new PDF (dimensions maybe specific for MLPA): $gfx->formimage($xo, -15, -600, 0.98); # need .98 to fit on page } else { $pdf->importpage($new, $_); } } } # $pdf->saveas('/tmp/print_run.pdf'); # save file to disk } sub get_pdf_settings { my ($self, $args) = @_; my $wkhtmltopdf = '/usr/local/bin/wkhtmltopdf'; # symlink to wkhtmltopdf-0.12.3 (Aug/2017) my $session_id = $args->{session_id} || 1; # only needed for external calls my $settings = $self->cfg('settings'); # warn Dumper $settings; my $request = $args->{data}; my $patient = $request->{patient_case}->{patient}; my $footer = $settings->{report_footer}; # default footer space is 26, UKAS logo requires more: my $foot_spacer = $settings->{footer_spacing} || 26; # warn $footer_spacer; my $report_id = sprintf '%s, %s :: %s/%s', uc $patient->{last_name}, ucfirst $patient->{first_name}, $request->{request_number}, $request->{year} - 2000; my @args = ( $wkhtmltopdf, '--page-size' => 'A4', '--margin-top' => 7, # with header-spacing to provide optimum layout '--margin-bottom' => $foot_spacer, # provide space for footer '--header-spacing' => 2, # provide gap between header & banner '--header-left' => $report_id, # double-quote to allow for eg o'connor '--header-font-size' => 8, '--header-right' => 'Printed on: [date]', # [date] replaced by system date (in local format) '--footer-html' => 'http://localhost/'.$footer, # '--footer-spacing' => nn, # might need this if long content reaches footer '--cookie-jar' => 'CGISESSID ' . $session_id, '--disable-javascript', # if any '--disable-external-links', # no urls '--quiet', '-', # stdin '-', # stdout ); # warn Dumper \@args; return \@args; } # replace some chars wkhtmltopdf can't understand (seems to be only necessary if # HTML contains , without it all chars render OK): sub _escape { my $ref = shift; # scalarref my $str = ${$ref}; # p $str; # doesn't need to be ref anymore - here or downstream my %h = ( # '±' (0xB1 & \x{B1}) see: https://en.wikipedia.org/wiki/Plus-minus_sign#Encodings chr(0xB1) => '±', # '±' prints as '▒' on console & '?' in pdf ); # perform substitutions on deref'd var: $str =~ s/$_/$h{$_}/g for keys %h; # p $str; return $str; # expecting string return } =begin # original method, saving temp file: sub _render_pdf { my ($self, $args) = @_; my $session_id = $args->{session_id}; # needs session_id for chart function my $content = $args->{content}; # warn $content; # scalarref my $data = $self->stash->{request_data}; # warn Dumper $data->as_tree; my $patient = $data->patient_case->patient; my $report_id = sprintf '%s, %s :: %s/%s', uc $patient->last_name, ucfirst $patient->first_name, $data->request_number, $data->year - 2000; # perl 5.13+ supports: my $foo = $bar =~ s/foo/bar/r; # r = non-destructive # ( my $base_addr = $self->query->url(-base => 1) ) =~ s/\:8080//; # if dev server my $settings = $self->cfg('settings'); my ($base_addr, $footer) = map $settings->{$_}, qw (base_href report_footer); my @args = ( '--margin-top 7', # combined with header-spacing to provide optimum layout '--header-spacing 2', # provide gap between header & banner qq!--header-left "$report_id"!, # double-quote to allow for eg o'connor qq!--header-right 'Printed on: [date]'!, # [date] replaced by system date (in local format) qq!--footer-html $base_addr/$footer!, '--header-font-size 8', '--margin-bottom 26', # provide space for footer '--cookie CGISESSID ' . $session_id, '--disable-javascript', # if any '--disable-external-links', # no urls # '--footer-line', # draw line above - doesn't print # '--footer-spacing x', # might need this if long content reaches footer ); # create temp file for input to wkhtmltopdf: my $tmp_file = sprintf '%s/%s.html', $self->cfg->{tmpdir}, $data->id; # warn $tmp_file; { # save file to disk: my $html = _escape($content); # substitute any chars wkhtmltopdf can't handle io($tmp_file)->print($html); # $html is str } my $pdf = `wkhtmltopdf -q @args $tmp_file -`; if ( -e $tmp_file ) { # occasionally doesn't exist - maybe simultaneous access ?? io($tmp_file)->unlink or warn "could not unlink $tmp_file: $!"; } return $pdf; } =cut 1;