The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Data::Transpose::Validator::URL;

use strict;
use warnings;
use base 'Data::Transpose::Validator::Base';

=head1 NAME

Data::Transpose::Validator::URL - Validate http(s) urls

=head1 SYNOPSIS

=cut


my $urlre = qr/(https?:\/\/)[\w\-\.]+\.(\w+) # domain
	       (:\d+)* # the port
	       (\/[\w:\.,;\?'\\\+&%\$\#=~\@!\-]+)*
	      /x;


=head2 is_valid($url)

Validate the url or set an error

=cut


sub is_valid {
    my ($self, $url) = @_;
    $self->reset_errors;
    if ($url =~ m/^($urlre)$/s) {
        return $1;
    } else {
        $self->error(
                     ["badurl",
                      "URL is not correct (the protocol is required)"]);
        return undef;
    }
}