decoded results from the CPAN

decoded

CSS-Inliner

view release on metacpan or search on metacpan

    html => undef,
    html_tree => defined($$params{html_tree}) ? $$params{html_tree} : CSS::Inliner::TreeBuilder->new(),
    query => undef,
    content_warnings => {},
    strip_attrs => (defined($$params{strip_attrs}) && $$params{strip_attrs}) ? 1 : 0,
    relaxed => (defined($$params{relaxed}) && $$params{relaxed}) ? 1 : 0,
    leave_style => (defined($$params{leave_style}) && $$params{leave_style}) ? 1 : 0,
    warns_as_errors => (defined($$params{warns_as_errors}) && $$params{warns_as_errors}) ? 1 : 0,
    agent => (defined($$params{agent}) && $$params{agent}) ? $$params{agent} : 'Mozilla/4.0',
    fixlatin => eval { require Encoding::FixLatin; return 1; } ? 1 : 0,
    encode_entities => (defined($$params{encode_entities}) && $$params{encode_entities}) ? 1 : 0,
    ignore_style_type_attr => (defined($$params{ignore_style_type_attr}) && $$params{ignore_style_type_attr}) ? 1 : 0,
  };

  bless $self, $class;

  $self->_configure_tree({ tree => $self->_html_tree });

  return $self;
}

=head2 fetch_file

Fetches a remote HTML file that supposedly contains both HTML and a
style declaration, properly tags the data with the proper charset
as provided by the remote webserver (if any). Subsequently calls the
read method automatically.

This method expands all relative urls, as well as fully expands the
stylesheet reference within the document.

This method requires you to pass in a params hash that contains a
url argument for the requested document. For example:

$self->fetch_file({ url => 'http://www.example.com' });

Note that you can specify a user-agent to override the default user-agent
of 'Mozilla/4.0' within the constructor. Doing so may avoid certain issues
with agent filtering related to quirky webserver configs.

Input Parameters:
 url - the desired url for a remote asset presumably containing both html and css
 charset - (optional) programmer specified charset for the pass url

=cut

sub fetch_file {
  my ($self,$params) = @_;

  $self->_check_object();

  unless ($params && $$params{url}) {
    croak 'You must pass in hash params that contain a url argument';
  }

  # fetch and retrieve the remote content
  my ($content,$baseref,$ctcharset) = $self->_fetch_url({ url => $$params{url} });

  my $charset = $self->detect_charset({ content => $content, charset => $$params{charset}, ctcharset => $ctcharset });

  my $decoded_html;
  if ($charset) {
    $decoded_html = $self->decode_characters({ content => $content, charset => $charset });
  }
  else {
    # no good hints found, do the best we can

    if ($self->_fixlatin()) {
      Encoding::FixLatin->import('fix_latin');
      $decoded_html = fix_latin($content);
    }
    else {
      $decoded_html = $self->decode_characters({ content => $content, charset => 'ascii' });
    }
  }

  my $html = $self->_absolutize_references({ content => $decoded_html, baseref => $baseref });

  $self->read({ html => $html, charset => $charset });

  return();
}

=head2 read_file

Opens and reads an HTML file that supposedly contains both HTML and a
style declaration, properly tags the data with the proper charset
if specified. It subsequently calls the read() method automatically.

This method requires you to pass in a params hash that contains a
filename argument. For example:

$self->read_file({ filename => 'myfile.html' });

Additionally you can specify the character encoding within the file, for
example:

$self->read_file({ filename => 'myfile.html', charset => 'utf8' });

Input Parameters:
 filename - name of local file presumably containing both html and css
 charset - (optional) programmer specified charset of the passed file

=cut

sub read_file {
  my ($self,$params) = @_;

  $self->_check_object();

  unless ($params && $$params{filename}) {
    croak "You must pass in hash params that contain a filename argument";
  }

  open FILE, "<", $$params{filename} or die $!;
  my $content = do { local( $/ ) ; <FILE> };

  my $charset = $self->detect_charset({ content => $content, charset => $$params{charset} });

  my $decoded_html;
  if ($charset) {
    $decoded_html = $self->decode_characters({ content => $content, charset => $charset });
  }
  else {
    # no good hints found, do the best we can

    if ($self->_fixlatin()) {
      Encoding::FixLatin->import('fix_latin');
      $decoded_html = fix_latin($content);
    }
    else {
      $decoded_html = $self->decode_characters({ content => $content, charset => 'ascii' });
    }
  }

  $self->read({ html => $decoded_html, charset => $charset });

  return();
}

=head2 read

Reads passed html data and parses it.  The intermediate data is stored in
class variables.

The <style> block is ripped out of the html here, and stored
separately. Class/ID/Names used in the markup are left alone.

This method requires you to pass in a params hash that contains scalar
html data. For example:

$self->read({ html => $html });

NOTE: You are required to pass a properly encoded perl reference to the
html data. This method does *not* do the dirty work of encoding the html
as utf8 - do that before calling this method.

Input Parameters:
 html - scalar presumably containing both html and css
 charset - (optional) scalar representing the original charset of the passed html

=cut

sub read {
  my ($self,$params) = @_;

  $self->_check_object();

  unless ($params && $$params{html}) {
    croak 'You must pass in hash params that contains html data';
  }

  if ($params && $$params{charset} && !find_encoding($$params{charset})) {
    croak "Invalid charset passed to read()";
  }

  $self->_html_tree->parse_content($$params{html});

  $self->_init_query();

  #suck in the styles for later use from the head section - stylesheets anywhere else are invalid
  my $stylesheet = $self->_parse_stylesheet();

  #save the data
  $self->_html($$params{html});
  $self->_stylesheet($stylesheet);

  return();
}

=head2 detect_charset

Detect the charset of the passed content.

The algorithm present here is roughly based off of the HTML5 W3C working group document,
which lays out a recommendation for determining the character set of a received document, which

lib/CSS/Inliner.pm view on Meta::CPAN


  unless ($params && $$params{content}) {
    croak "You must pass content for content character decoding";
  }

  my $charset;
  if (exists($$params{charset}) && $$params{charset} && find_encoding($$params{charset})) {
    # precedence given to programmer provided charset
    $charset = $$params{charset};
  }
  elsif (exists($$params{ctcharset}) && $$params{ctcharset} && find_encoding($$params{ctcharset})) {
    # use the Content-Type charset if available
    $charset = $$params{ctcharset};
  }
  else {
    # analyze the document to scan for any meta charset hints we can use
    my $meta_charset = $self->_extract_meta_charset({ content => $$params{content} });

    if ($meta_charset && find_encoding($meta_charset)) {
      # use the meta charset from the document if available
      $charset = $meta_charset;
    }
    else {
      # no hints found...
    }
  }

  return $charset;
}

=head2 decode_characters

Implement the character decoding algorithm for HTML as outlined by the various working groups

Basically apply best practices for determining the applied character encoding and properly decode it

It is expected that this method will be called before any calls to read()

Input Parameters:
 content - scalar presumably containing both html and css
 charset - known charset for the passed content

=cut

sub decode_characters {
  my ($self,$params) = @_;

  $self->_check_object();

  unless ($params && $$params{content}) {
    croak "You must pass content for content character decoding";
  }

  unless ($params && $$params{charset}) {
    croak "You must pass the charset type of the content to decode";
  }

  my $content = $$params{content};
  my $charset = $$params{charset};

  my $decoded_html;
  eval {
    $decoded_html = decode($charset,$content);
  };

  if (!$decoded_html) {
    croak('Error decoding content with character set "'.$$params{charset}.'"');
  }

  return $decoded_html;
}

=head2 inlinify

Processes the html data that was entered through either 'read' or
'read_file', returns a scalar that contains a composite chunk of html
that has inline styles instead of a top level <style> declaration.

=cut

sub inlinify {
  my ($self,$params) = @_;

  $self->_check_object();

  $self->_content_warnings({}); # overwrite any existing warnings

  unless ($self->_html() && $self->_html_tree()) {
    croak 'You must instantiate and read in your content before inlinifying';
  }

  # perform a check to see how bad this html is...
  $self->_validate_html({ html => $self->_html() });

  my $html;
  if (defined $self->_css()) {
    #parse and store the stylesheet as a hash object

    $self->_css->read({ css => $self->_stylesheet() });

    my @css_warnings = @{$self->_css->content_warnings()};
    foreach my $css_warning (@css_warnings) {
      $self->_report_warning({ info => $css_warning });
    }

    my %matched_elements;
    my $count = 0;

    foreach my $entry (@{$self->_css->get_rules()}) {
      next unless exists $$entry{selector} && $$entry{declarations};

      my $selector = $$entry{selector};
      my $declarations = $$entry{declarations};

      #skip over the following pseudo selectors, these particular ones are not inlineable
      if ($selector =~ /(?:^|[\w\._\*\]])::?(?:([\w\-]+))\b/io && $1 !~ /first-child|last-child/i) {
        $self->_report_warning({ info => "The pseudo-class ':$1' cannot be supported inline" });
        next;
      }

      #skip over @import or anything else that might start with @ - not inlineable
      if ($selector =~ /^\@/io) {
        $self->_report_warning({ info => "The directive '$selector' cannot be supported inline" });
        next;
      }

      my $query_result;

      #check to see if query fails, possible for jacked selectors
      eval {

lib/CSS/Inliner.pm view on Meta::CPAN

  }

  return $stylesheet;
}

sub _collapse_inline_styles {
  my ($self,$params) = @_;

  $self->_check_object();

  #check if we were passed a node to recurse from, otherwise use the root of the tree
  my $content = exists($$params{content}) ? $$params{content} : [$self->_html_tree()];

  foreach my $i (@{$content}) {

    next unless (ref $i && $i->isa('HTML::Element'));

    if ($i->attr('style')) {

      #flatten out the styles currently in place on this entity
      my $existing_styles = $self->_encode_entities ? decode_entities($i->attr('style')) : $i->attr('style');
      $existing_styles =~ tr/\n\t/  /;

      # hold the property value pairs
      my $styles = $self->_split({ style => $existing_styles });

      my $collapsed_style = '';

      # loop in reverse order as the latter rule wins
      my %exist;
      for (my $i = $#$styles; $i > 0; $i -= 2) {
        my $property = $styles->[$i-1];
        my $value = $styles->[$i];
        next if $exist{$property}++; # the former rule with the same name is overridden
        $collapsed_style = "$property: $value; " . $collapsed_style;
      }

      $collapsed_style =~ s/\s*$//;
      $i->attr('style', $self->_encode_entities ? encode_entities($collapsed_style) : $collapsed_style);
    }

    #if we have specifically asked to remove the inlined attrs, remove them
    if ($self->_strip_attrs()) {
      $i->attr('id',undef);
      $i->attr('class',undef);
    }

    # Recurse down tree
    if (defined $i->content) {
      $self->_collapse_inline_styles({ content => $i->content() });
    }
  }
}

sub _extract_meta_charset {
  my ($self,$params) = @_;

  $self->_check_object();

  # we are going to parse an html document as ascii that is not necessarily ascii - silence the warning
  local $SIG{__WARN__} = sub { my $warning = shift; warn $warning unless $warning =~ /^Parsing of undecoded UTF-8/ };

  # parse document and pull out key header elements
  my $extract_tree = new CSS::Inliner::TreeBuilder();
  $self->_configure_tree({ tree => $extract_tree });

  $extract_tree->parse_content($$params{content});

  my $head = $extract_tree->look_down("_tag", "head"); # there should only be one

  my $meta_charset;
  if ($head) {
    # pull key header meta elements
    my $meta_charset_elem = $head->look_down('_tag','meta','charset',qr/./);
    my $meta_equiv_charset_elem = $head->look_down('_tag','meta','http-equiv',qr/content-type/i,'content',qr/./);

    # assign meta charset, we give precedence to meta http_equiv content type
    if ($meta_equiv_charset_elem) {
      my $meta_equiv_content = $meta_equiv_charset_elem->attr('content');

      # leverage charset allowable chars from https://tools.ietf.org/html/rfc2978
      if ($meta_equiv_content =~ /charset(?:\s*)=(?:\s*)([\w!#$%&'\-+^`{}~]+)/i) {
        $meta_charset = find_encoding($1);
      }
    }

    if (!defined($meta_charset) && $meta_charset_elem) {
      $meta_charset = find_encoding($meta_charset_elem->attr('charset'));
    }
  }

  return $meta_charset;
}

sub _init_query {
  my ($self,$params) = @_;

  $self->_check_object();

  $self->{query} = HTML::Query->new($self->_html_tree());

  return();
}

sub _expand {
  my ($self, $params) = @_;

  $self->_check_object();

  my $declarations = $$params{declarations};
  my $inline = '';
  for ( my $i = 0; $i < @$declarations; $i += 2 ) {
    my $property = $declarations->[$i];
    my $value = $declarations->[$i+1];
    $inline .= "$property:$value;";
  }

  return $inline;
}

sub _split {

( run in 2.007 seconds using v1.01-cache-2.11-cpan-7fcb06a456a )