File Coverage

blib/lib/HTML/Tested/Test/Request.pm

Criterion	Covered	Total	%
statement	56	69	81.1
branch	17	32	53.1
condition	6	7	85.7
subroutine	17	20	85.0
pod	1	13	7.6
total	97	141	68.7

use strict;
use warnings FATAL => 'all';

package HTML::Tested::Test::Request::Upload;
use base 'Class::Accessor';
__PACKAGE__->mk_accessors(qw(name filename fh size));

package HTML::Tested::Test::Request;
use base 'Class::Accessor';
use HTML::Tested::Seal;
use Data::Dumper;
use File::Basename qw(basename);

__PACKAGE__->mk_accessors(qw(_param _pnotes _uploads _dir_config uri));

sub hostname { return "some.host"; }
sub server { return shift(); }
sub port { return 80; }

sub server_root_relative {
	return $_[1];
}

sub body_status { return 'Success'; }

sub param {
	my ($self, $name, $val) = @_;
	return $self->_param unless (wantarray || $name);
	$self->_param({}) unless $self->_param;
	$self->_param->{$name} = $val if @_ == 3;
	return $self->_param->{$name} if ($name);
	return keys %{ $self->_param || {} };
}

sub dir_config {
	my ($self, $name, $val) = @_;
	my $dc = $self->_dir_config;
	if (!$dc) {
		$dc = {};
		$self->_dir_config($dc);
	}
	return $dc->{$name} if (@_ < 3);
	$dc->{$name} = $val if defined($val);
	delete $dc->{$name} if !defined($val);
}

=head2 $object->set_params($paramref)

Sets param values according to C<$paramref> hash. Clears old params first.

Parameter names starting with C are encrypted and C
prefix is removed.

=cut
sub set_params {
	my ($self, $p) = @_;
	$self->_param({});
	while (my ($n, $v) = each %$p) {
		$v = HTML::Tested::Seal->instance->encrypt($v)
				if ($n =~ s/^HT_SEALED_//);
		$self->param($n, $v);
	}
}

sub parse_url {
	my ($self, $url) = @_;
	my ($arg_str) = ($url =~ /\?(.+)/);
	return unless $arg_str;
	my @nvs = split('&', $arg_str);
	my %res = map {
		my @a = split('=', $_);
		($a[0], ($a[1] || ''));
	} @nvs;
	$self->_param(\%res);
}

sub pnotes {
	my ($self, $name, $val) = @_;
	$self->_pnotes({}) unless $self->_pnotes;
	return $self->_pnotes->{$name} unless scalar(@_) > 2;
	$self->_pnotes->{$name} = $val;
}

sub add_upload {
	my ($self, $n, $v) = @_;
	$self->_uploads([]) unless $self->_uploads;
	open(my $fh, $v) or die "Unable to open $v";
	push @{ $self->_uploads }, HTML::Tested::Test::Request::Upload->new({
		name => $n, filename => $v , fh => $fh, size => -s $v });
}

sub upload {
	my ($self, $n) = @_;
	my $ups = $self->_uploads || [];
	return $n ? (grep { $_->name eq $n } @$ups)[0] : map { $_->name } @$ups;
}

sub as_string {
	return Dumper(shift());
}

1;