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 server_root_relative { return $_[1]; } sub body_status { return 'Success'; } sub param { my ($self, $name, $val) = @_; $self->_param({}) unless $self->_param; $self->_param->{$name} = $val if (defined($val)); 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;