File Coverage

blib/lib/Alien/Build/Plugin/Decode/Mojo.pm

Criterion	Covered	Total	%
statement	26	48	54.1
branch	4	18	22.2
condition	1	3	33.3
subroutine	6	7	85.7
pod	1	1	100.0
total	38	77	49.3

package Alien::Build::Plugin::Decode::Mojo;

use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;

# ABSTRACT: Plugin to extract links from HTML using Mojo::DOM or Mojo::DOM58
our $VERSION = '2.46'; # VERSION


sub _load ($;$)
{
  my($class, $version) = @_;
  my $pm = "$class.pm";
  $pm =~ s/::/\//g;
  eval { require $pm };
  return 0 if $@;
  if(defined $version)
  {
    eval { $class->VERSION($version) };
    return 0 if $@;
  }
  return 1;
}

has _class => sub {
  return 'Mojo::DOM58' if _load 'Mojo::DOM58';
  return 'Mojo::DOM'   if _load 'Mojo::DOM' and _load 'Mojolicious', 7.00;
  return 'Mojo::DOM58';
};

sub init
{
  my($self, $meta) = @_;

  $meta->add_requires('share' => 'URI' => 0);
  $meta->add_requires('share' => 'URI::Escape' => 0);

  my $class = $meta->prop->{plugin_decode_mojo_class} ||= $self->_class;

  if($class eq 'Mojo::DOM58')
  {
    $meta->add_requires('share' => 'Mojo::DOM58' => '1.00');
  }
  elsif($class eq 'Mojo::DOM')
  {
    $meta->add_requires('share' => 'Mojolicious' => '7.00');
    $meta->add_requires('share' => 'Mojo::DOM'   => '0');
  }
  else
  {
    die "bad class";
  }

  $meta->register_hook( decode => sub {
    my(undef, $res) = @_;

    die "do not know how to decode @{[ $res->{type} ]}"
      unless $res->{type} eq 'html';

    my $dom = $class->new($res->{content});

    my $base = URI->new($res->{base});

    if(my $base_element = $dom->find('head base')->first)
    {
      my $href = $base_element->attr('href');
      $base = URI->new($href) if defined $href;
    }

    my @list = map {
                 my $url = URI->new_abs($_, $base);
                 my $path = $url->path;
                 $path =~ s{/$}{}; # work around for Perl 5.8.7- gh#8
                 {
                   filename => URI::Escape::uri_unescape(File::Basename::basename($path)),
                   url      => URI::Escape::uri_unescape($url->as_string),
                 }
               }
               grep !/^\.\.?\/?$/,
               map { $_->attr('href') || () }
               @{ $dom->find('a')->to_array };

    return {
      type => 'list',
      list => \@list,
    };
  })


}

1;

__END__