view release on metacpan or  search on metacpan

lib/Alien/Base/ModuleBuild/Repository/HTTP.pm  view on Meta::CPAN

    push @links, $self->find_links_textbalanced($html)
  }

  return @links;
}

sub find_links_preferred {
  my $self = shift;
  my ($html) = @_;

  my @links;

  my $extor = HTML::LinkExtor->new(
    sub {
      my ($tag, %attrs) = @_;
      return unless $tag eq 'a';
      return unless defined $attrs{href};
      push @links, $attrs{href};
    },
  );

  $extor->parse($html);

  return @links;
}

sub find_links_textbalanced {
  my $self = shift;
  my ($html) = @_;
  return Alien::Base::ModuleBuild::Utils::find_anchor_targets($html);
}

sub build_uri {
  my $self = shift;
  my ($protocol, $host, $path, $target) = @_;

  my $uri;
  if (defined $host) {
    my $base = $self->{base_url};
    unless($base)
    {
      $base = URI->new($host);
      unless (defined $base->scheme) {
        $base = URI->new(($protocol || 'http') ."://$host");
      }
      $base->path($path) if defined $path;
    }
    $uri = URI->new_abs($target, $base);
  }
  else {
    $uri = URI->new($target);
  }
  return $uri->canonical;
}

sub check_http_response {
  my ( $self, $res ) = @_;
  if ( blessed $res && $res->isa( 'HTTP::Response' ) ) {
    my %headers = map { lc $_ => $res->header($_) } $res->header_field_names;
    if ( !$res->is_success ) {
      return ( 1, $res->status_line . " " . $res->decoded_content, \%headers, $res->request->uri );
    }
    return ( 0, $res->decoded_content, \%headers, $res->request->uri );
  }
  else {
    if ( !$res->{success} ) {
      my $reason = $res->{status} == 599 ? $res->{content} : "@{[ $res->{status} ]} @{[ $res->{reason} ]}";
      if($res->{status} == 599 && $reason =~ /https support/)
      {
        $reason .= "See https://github.com/PerlAlien/Alien-Base-ModuleBuild/issues/6#issuecomment-417097485";
      }
      return ( 1, $reason, $res->{headers}, $res->{url} );
    }
    return ( 0, $res->{content}, $res->{headers}, $res->{url} );
  }
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Alien::Base::ModuleBuild::Repository::HTTP - HTTP repository handler

=head1 VERSION

version 1.17

=head1 SEE ALSO

=over 4

=item L<Alien>

=item L<Alien::Base>

=back

=head1 AUTHOR

Original author: Joel A Berger E<lt>joel.a.berger@gmail.comE<gt>

Current maintainer: Graham Ollis E<lt>plicease@cpan.orgE<gt>

Contributors:

David Mertens (run4flat)

Mark Nunberg (mordy, mnunberg)

Christian Walde (Mithaldu)

Brian Wightman (MidLifeXis)

Graham Ollis (plicease)

Zaki Mughal (zmughal)