package LIMS::Controller::Roles::PDF; use Moose::Role; use Data::Dumper; use IO::All; # wkhtmltopdf needs to be in web-server path ie /usr/local/bin 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; } # replace some chars wkhtmltopdf can't understand: sub _escape { my $ref = shift; # scalarref my $str = ${$ref}; # 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; # warn $str; return $str; # expecting string return } 1;