view release on metacpan or  search on metacpan

lib/PDF/WebKit.pm  view on Meta::CPAN

  if (not -x $self->configuration->wkhtmltopdf) {
    my $msg = "No wkhtmltopdf executable found\n";
    $msg   .= ">> Please install wkhtmltopdf - https://github.com/jdpace/PDFKit/wiki/Installing-WKHTMLTOPDF";
    die $msg;
  }
}

sub configuration {
  PDF::WebKit::Configuration->configuration
}

sub configure {
  my $class = shift;
  $class->configuration->configure(@_);
}

sub command {
  my $self = shift;
  my $path = shift;
  my @args = ( $self->_executable, $self->_prepare_options, '--quiet' );
  
  if ($self->source->is_html) {
    push @args, '-';  # Get HTML from stdin
  }
  else {
    push @args, $self->source->content;
  }

  push @args, $path || '-'; # write to file or stdout

  return grep { defined($_) } @args;
}

sub _executable {
  my $self = shift;
  my $default = $self->configuration->wkhtmltopdf;
  return $default if $default !~ /^\//; # it's not a path, so nothing we can do
  if (-e $default) {
    return $default;
  }
  else {
    return (split(/\//, $default))[-1];
  }
}

sub to_pdf {
  my $self = shift;
  my $path = shift;

  $self->_append_stylesheets;
  my @args = $self->command($path);

  my $input = $self->source->is_html ? $self->source->content : undef;
  my $output;

  my %opt = map +( "binmode_std$_" => ":raw" ), "in", "out", "err";
  run3 \@args, \$input, \$output, \my $err, \%opt;

  if ($path) {
    $output = do { local (@ARGV,$/) = ($path); <> };
  }

  if (not (defined($output) && length($output))) {
    Carp::croak "command failed: $args[0]";
  }
  return $output;
}

sub to_file {
  my $self = shift;
  my $path = shift;
  $self->to_pdf($path);
  my $FH = IO::File->new($path,"<")
    || Carp::croak "can't open '$path': $!";
  $FH->binmode();
  return $FH;
}

sub _find_options_in_meta {
  my ($self) = @_;
  return () if $self->source->is_url;
  # if we can't parse for whatever reason, keep calm and carry on.
  my @result = eval { $self->_pdf_webkit_meta_tags };
  return $@ ? () : @result;
}

sub _pdf_webkit_meta_tags {
  my ($self) = @_;
  return () unless eval { require XML::LibXML };
  my $source = $self->source;

  my $prefix = $self->configuration->meta_tag_prefix;

  # these options do not work at the constructor level in XML::LibXML 1.70, so pass
  # them through to the parser.
  my %options = (
    recover => 2,
    suppress_errors => 1,
    suppress_warnings => 1,
    no_network => 1,
  );

  my $parser = XML::LibXML->new();
  my $doc = $source->is_html ? $parser->parse_html_string($source->content,\%options)
          : $source->is_file ? $parser->parse_html_file($source->string,\%options)
          : return ();

  my %meta;
  for my $node ($doc->findnodes('html/head/meta')) {
    my $name = $node->getAttribute('name');
    next unless ($name && ($name =~ s{^\Q$prefix}{}s));
    $meta{$name} = $node->getAttribute('content');
  }

  return %meta;
}

sub _style_tag_for {
  my ($self,$stylesheet) = @_;
  my $styles = do { local (@ARGV,$/) = ($stylesheet); <> };
  return "<style>$styles</style>";
}

sub _append_stylesheets {
  my $self = shift;
  if (@{ $self->stylesheets } && !$self->source->is_html) {
    Carp::croak "stylesheets may only be added to an HTML source";
  }
  return unless $self->source->is_html;

  my $styles = join "", map { $self->_style_tag_for($_) } @{$self->stylesheets};
  return unless length($styles) > 0;

  # can't modify in-place, because the source might be a reference to a
  # read-only constant string literal
  my $html = $self->source->content;
  if (not ($html =~ s{(?=</head>)}{$styles})) {
    $html = $styles . $html;
  }
  $self->source->string(\$html);
}

sub _prepare_options {
  my ($self) = @_;
  my $options = $self->options;
  my @args;
  while (my ($name,$val) = each %$options) {
    next unless defined($val) && length($val);
    if (lc($val) eq 'yes') {
      push @args, $name;
    }
    else {
      push @args, $name, $val;
    }
  }
  return @args;
}

sub _normalize_options {
  my $self = shift;
  my %orig_options = @_;
  my %normalized_options;
  while (my ($key,$val) = each %orig_options) {
    my $normalized_key = $self->_normalize_arg($key);
    $normalized_options{$normalized_key} = $val;
  }
  return %normalized_options;
}

sub _normalize_arg {
  my ($self,$arg) = @_;
  $arg =~ lc($arg);
  $arg =~ s{[^a-z0-9]}{-}g;
  $arg =~ s{^-*}{--};
  return $arg;
}

1;

=head1 NAME