File Coverage

blib/lib/Mojo/DOM/Role/Analyzer.pm

Criterion	Covered	Total	%
statement	138	140	98.5
branch	35	42	83.3
condition	12	20	60.0
subroutine	23	23	100.0
pod	10	10	100.0
total	218	235	92.7

package Mojo::DOM::Role::Analyzer ;
$Mojo::DOM::Role::Analyzer::VERSION = '0.013';
use strict;
use warnings;
use Role::Tiny;
use Carp;

use overload "cmp" => sub { $_[0]->compare(@_) }, fallback => 1;

# wrap the find method so we can call the common method on collections
around find => sub {
  my $orig = shift;
  my $self = shift;
  return $self->$orig(@_)->with_roles('+Extra');
};

# traverses the DOM upward to find the closest tag node
sub closest_up {
  return _closest(@_, 'up');
}

# traverses the DOM downward to find the closest tag node
sub closest_down {
  return _closest(@_, 'down');
}

sub _closest {
  my $s = shift;
  my $sel = $s->selector;
  my $tag = shift;
  my $dir = shift || 'up';
  if ($dir ne 'up') {
    $dir = 'down';
  }

  my $found;
  if ($dir eq 'up') {
    $found = $s->root->find($tag)->grep(sub { ($s cmp $_) > 0  } );
  } else {
    $found = $s->root->find($tag)->grep(sub { ($s cmp $_) < 0  } );
  }

  return 0 unless $found->size;

  my @selectors;
  foreach my $f ($found->each) {
    push @selectors, $f->selector;
  }

  if (@selectors == 1) {
    return $s->root->at($selectors[0]);
  }

  my @sorted = sort { $s->root->at($a) cmp $s->root->at($b) } @selectors;
  if ($dir eq 'up') {
    return $s->root->at($sorted[-1]);  # get furtherest from the top (closest to node of interest)
  } else {
    return $s->root->at($sorted[0]);   # get futherest from the bottom (closest to node of interest)
  }

}

# find the common ancestor between a node and another node or group of nodes
sub common {
# uncomment to debug
# use Log::Log4perl::Shortcuts qw(:all); # for development only
#  if (ref $_[0]) { logd ref $_[0]; } else { logd $_[0]; }
#  if (ref $_[1]) { logd ref $_[1]; } else { logd $_[1]; }
#  if (ref $_[2]) { logd ref $_[2]; } else { logd $_[2]; }

   # The argument handling is a bit confusing. Keep these important notes in mind while reading this code:

   # 1) This method is called on Mojo::DOM objects (obviously)
   # 2) Don't confuse this method with its sister method also named "common"
   #    in Mojo::DOM::Collection::Extra which works with Mojo::Collection objects
   # 3) The argument handling below works for the different types of common syntaxes noted
   #    below in the comments.

  my ($s, $sel1, $sel2);

  # function-like use of common: $dom->commont($dom1, $dom2)
  if (ref $_[1] && ref $_[2]) {
    $s = $_[0];
    $sel1 = $_[1]->selector;
    $sel2 = $_[2]->selector;
  # DWIM syntax handling
  } else {
    if (!$_[1] && !$_[2]) {                         # $dom->at('div');
      my $s = shift;
      return $s->root->find($s->selector)->common;
    } elsif ($_[1] && !ref $_[1] && !$_[2]) {       # $dom->at('div.first')->common('p');
      $s = shift;
      $sel1 = $s->selector;
      $sel2 = $s->root->at(shift)->selector;
    }
  }

  my @t1_path = split / > /, $sel1;
  my @t2_path = split / > /, $sel2;

  my @common_path;
  foreach my $seg (@t1_path) {
    my $seg2 = shift @t2_path;
    last if !$seg2 || $seg ne $seg2;
    push @common_path, $seg2;
  }

  my $common_selector = join ' > ', @common_path;

  return $s->root->at($common_selector);

}

# determine if a tag A comes before or after tag B in the dom
sub compare {
  my ($s, $sel1, $sel2) = _get_selectors(@_);

  my @t1_path = split / > /, $sel1;
  my @t2_path = split / > /, $sel2;

  foreach my $p1 (@t1_path) {
    my $p2 = shift(@t2_path);
    next if $p1 eq $p2;
    my ($p1_tag, $p1_num) = split /:/, $p1;
    my ($p2_tag, $p2_num) = split /:/, $p2;

    next if $p1_num eq $p2_num;
    return $p1_num cmp $p2_num;
  }
}

sub distance {
  my ($s, $sel1, $sel2) = _get_selectors(@_);

  my $common = $s->common($s->root->at($sel1), $s->root->at($sel2));
  my $dist_leg1 = $s->root->at($sel1)->depth - $common->depth;
  my $dist_leg2 = $s->root->at($sel2)->depth - $common->depth;

  return $dist_leg1 + $dist_leg2;
}

sub depth {
  my $s = shift;
  my $sel = $s->selector;
  my @parts = split /\s>\s/, $sel;
  return scalar @parts;
}

sub deepest {
  my $s = shift;
  my $deepest_depth = 0;
  foreach my $c ($s->descendant_nodes->grep(sub { $_->type eq 'tag' })->each) {
    my $depth = $c->depth;
    $deepest_depth = $depth if $depth > $deepest_depth;
  }
  return $deepest_depth;
}

sub element_count {
  my $self = shift;
  return $self->descendant_nodes->grep(sub { $_->type eq 'tag' })->size;
}

# determine if one node is an ancestor to another
sub is_ancestor_to {
  my $s = shift;
  my $arg = shift;
  my $sel1 = $s->selector;
  my $sel2 = $arg->selector;

  return $sel2 =~ /^\Q$sel1\E/ ? 1 : 0;
}

sub _get_selectors {
  my ($s, $sel1, $sel2);
  if (!$_[2]) {
    $s = shift;
    $sel1 = $s->selector;
    if (ref $_[0]) {
      $sel2 = $_[0]->selector;
    } else {
      $sel2 = $s->root->at($_[0])->selector;
    }
  } else {
    $s = $_[0];
    $sel1 = $_[1]->selector;
    $sel2 = $_[2]->selector;
  }
  return ($s, $sel1, $sel2);
}

sub tag_analysis {
  my $s        = shift;
  my $selector = shift;

  carp "A selector argument must be passed to the tag_analysis method"
    unless $selector;

  my $common = $s->find($selector)->common;

  my @sub_enclosing_nodes;
  @sub_enclosing_nodes = $common->_gsec($selector, $common->selector);

  foreach my $sn (@sub_enclosing_nodes) {
    next if $sn->{all_tags_have_same_depth};
    my $n = $s->at($sn->{selector});
    my $ec = $n->find($selector)->common;
    my @enclosing_nodes = $ec->_gsec($selector);
    push @sub_enclosing_nodes, @enclosing_nodes;
  }

  # cleanup any unnecessary nodes at top of the array wrapping the smallest enconpassing dom
#  my $total_tags = $s->find($selector)->size;
#  my $number_of_tags = grep { $_->{size} == $total_tags } @sub_enclosing_nodes;
#  splice @sub_enclosing_nodes, 0, $number_of_tags - 1;
  @sub_enclosing_nodes = sort { $a->{selector} cmp $b->{selector} } @sub_enclosing_nodes;

  return @sub_enclosing_nodes;
}


# get secondary enclosing tags
sub _gsec {
  my $s                     = shift;
  my $selector              = shift;
  my $top_level_selector    = shift;

  carp "A selector argument must be passed to the tag_analysis method"
    unless $selector;

  my @sub_enclosing_nodes;
  foreach my $c ($top_level_selector ? $s->root->find($top_level_selector)->each : $s->children->each) {
    my $size = $c->find($selector)->size;
    next unless $size;

    my $depth_total;
    my $same_depth    = 1;
    my $depth_tracker = undef;

    foreach my $t ($c->find($selector)->each) {
      my $depth = $t->depth;

      if ($depth_tracker && ($depth != $depth_tracker)) {
        $same_depth = 0;
      }

      $depth_tracker = $depth;
      $depth_total  += $depth;
    }
    push @sub_enclosing_nodes, { selector                 => $c->selector,
                                 size                     => $size,
                                 avg_tag_depth            => ($depth_total / $size),
                                 all_tags_have_same_depth => $same_depth };
  }
  return @sub_enclosing_nodes;
}

1; # Magic true value
# ABSTRACT: miscellaneous methods for analyzing a DOM

__END__