view release on metacpan or  search on metacpan

Wyrd/Input/URLInput.pm  view on Meta::CPAN

=head1 SYNOPSIS

	<BASECLASS::Input::URLInput name="url" size="40" />

=head1 DESCRIPTION

Like any Form::Input Wyrd, but uses LWP::UserAgent to check that the URL
entered is a valid one.  Will call insert_error on the enclosing Form if
an attempt to contact the URL first using the HEAD method and then the GET
method both return 404 Not Found.

=cut

sub _setup {
	my ($self) = @_;
	$self->{'type'} = 'url';
}

sub _smart_type {
	my ($self) = @_;

Wyrd/Input/URLInput.pm  view on Meta::CPAN

		#check for protocol/machine
		$self->_warn("URL error -- Malformed URL");
		$self->{'_error_messages'} = [@{$self->{'_error_messages'}}, "The URL $value is not valid.  Please enter a full URL."];
		$error = 0;
	} else {
		my $ua = LWP::UserAgent->new;
		$ua->timeout(60);
		my $response = $ua->request(HEAD $value);
		my $status = $response->status_line;
		$self->_debug("URL HEAD status is $status");
		if ($status =~ /404/) {
			$response = $ua->request(GET $value);
			$status = $response->status_line;
			$self->_debug("URL GET status is $status");
		}
		if ($status =~ /404/) {
			#warn("URL error -- Status is $status");
			$self->{'_error_messages'} = [@{$self->{'_error_messages'}}, "This URL: $value returned an error: $status.  Please fix it before continuing."];
			$error = 0;
		}
	}
	$self->{'_errors'} ||= [$self->name] unless ($error);
	return $error;
}

=pod