view release on metacpan or  search on metacpan

lib/Apache/SWIT/Test.pm  view on Meta::CPAN

	return $self->mech->get($loc) if $loc =~ /^\w+:\/\//;
	$loc = $self->root_location . "/$loc" unless ($loc =~ /^\//);
	my $url = $ENV{APACHE_SWIT_SERVER_URL};
	$url =~ s/\/$//;
	return $self->mech->get($url . $loc);
}

sub _find_url_to_go {
	my ($self, %args) = @_;
	my $res = $args{base_url};
	if ($args{make_url}) {
		my $rl = $self->root_location;
		confess "Please set root_location" unless defined($rl);
		$res = "$rl/" . $args{url_to_make};
	}
	return $res;
}

sub _mech_render {
	my ($self, $handler_class, %args) = @_;
	my $goto = $self->_find_url_to_go(%args) or goto OUT;
	my $p = $args{param} or goto GET_IT;
	my $r = Apache::SWIT::Test::Request->new;
	$r->set_params($args{param}) if $args{param};
	$goto .= "?" . join("&", map { "$_=" . $r->param($_) } $r->param);
GET_IT:
	$self->mech_get_base($goto);
OUT:
	$self->session->request->uri($goto || $self->root_location)
		if $self->session;
	return $self->mech->content;
}

sub _filter_out_readonly {
	my ($self, $args) = @_;
	return if ref($self->mech) eq 'Mozilla::Mechanize::GUITester';
	my $form = $self->mech->current_form or confess "No form found in\n"
			. $self->mech->content;
	delete $args->{fields}->{$_} for grep { $_ } map { $_->name }
		grep { $_->readonly } $form->inputs;
	
	return if delete $args->{no_submit_check};
	my @sub = grep { $_->type eq 'submit' } $form->inputs;
	confess $self->mech->content . "No submit input type found. "
		. "Use no_submit_check if needed\n" unless @sub;
}

sub _mech_update {
	my ($self, $handler_class, %args) = @_;
	delete $args{url_to_make};
	delete $args{error_ok};
	my $b = delete $args{button};
	$args{button} = $b->[0] if $b;
	$self->_filter_out_readonly(\%args);
	$self->mech->submit_form(%args);
	return $self->mech->content;
}

sub _decode_utf8_arr {
	my $arr = shift;
	return $arr if ref($arr) ne 'ARRAY'; # DateTime for example
	for (my $i = 0; $i < @$arr; $i++) {
		my $r = ref($arr->[$i]);
		$arr->[$i] = $r ? $r eq 'ARRAY' ? _decode_utf8_arr($arr->[$i])
						: _decode_utf8($arr->[$i])
				: Encode::decode_utf8($arr->[$i]);

	}
	return $arr;
}

sub _decode_utf8 {
	my $arg = shift;
	($arg->{$_} = ref($arg->{$_}) ? _decode_utf8_arr($arg->{$_})
			: Encode::decode_utf8($arg->{$_})) for (keys %$arg);
	return $arg;
}

sub _direct_ht_render {
	my ($self, $handler_class, %args) = @_;
	my $res = $self->_direct_render($handler_class, %args);
	my @cs = HTML::Tested::Test->check_stash($handler_class->ht_root_class
		, $res, _decode_utf8($args{ht}));
	push @cs, $res if @cs;
	return @cs;
}

sub _mech_ht_render {
	my ($self, $handler_class, %args) = @_;
	my $content = $self->_mech_render($handler_class, %args);
	return HTML::Tested::Test->check_text(
			$handler_class->ht_root_class, $content, $args{ht});
}

sub _direct_ht_update {
	my ($self, $handler_class, %args) = @_;
	my $r = $self->_make_test_request(\%args);
	my $rc = $handler_class->ht_root_class;
	HTML::Tested::Test->convert_tree_to_param($rc, $r, $args{ht});
	HTML::Tested::Test->convert_tree_to_param($rc, $r, $args{param})
		if $args{param};
	return $self->_do_swit_update($handler_class, $r, %args);
}

sub _mech_ht_update {
	my ($self, $handler_class, %args) = @_;
	my $r = Apache::SWIT::Test::Request->new({ _param => $args{fields} });
	HTML::Tested::Test->convert_tree_to_param(
			$handler_class->ht_root_class, $r, $args{ht});
	$args{fields} = $r->_param;
	delete $args{ht};
	delete $args{param};

	if (my $form_number = $args{'form_number'}) {
		$self->mech->form_number($form_number) or confess "No number";
	} elsif (my $form_name = $args{'form_name'}) {
		$self->mech->form_name($form_name) or confess "No form_name";
	}
	goto OUT unless $r->upload;

	my $form = $self->mech->current_form or confess "No form found!";