1package CGIMock; 2 3use Moose; 4use namespace::autoclean; 5 6# Core modules 7use Data::Dumper; 8use Carp qw( cluck confess ); 9 10has data => ( 11 is => 'rw', 12 isa => 'HashRef', 13 default => sub{ return {} }, 14); 15 16has url_data => ( 17 is => 'rw', 18 isa => 'HashRef', 19 default => sub{ return {} }, 20); 21 22has content_type => ( 23 is => 'rw', 24 isa => 'Str', 25 default => 'application/x-www-form-urlencoded', 26); 27 28 29sub param { 30 31 my $self = shift; 32 my $name = shift; 33 34 if ($name) { 35 my $val = $self->data()->{$name}; 36 if (ref $val eq 'ARRAY') { 37 cluck "param in list context is deprecated - use multi_param"; # warn 38 return @{$val}; 39 } 40 return $val; 41 } 42 if (wantarray) { 43 return keys %{$self->data()}; 44 } 45 return $self->data(); 46 47} 48 49sub multi_param { 50 51 my $self = shift; 52 my $name = shift; 53 54 if (!wantarray) { 55 confess "multi_param must not be used outside list context"; # die 56 } 57 58 if ($name) { 59 my $val = $self->data()->{$name}; 60 if (!$val) { return (); } 61 if (ref $val ne 'ARRAY') { 62 return ($val); 63 } 64 return @{$val}; 65 } 66 return keys %{$self->data()}; 67} 68 69sub url_param { 70 71 my $self = shift; 72 my $name = shift; 73 74 if ($name) { 75 my $val = $self->url_data()->{$name}; 76 if (ref $val eq 'ARRAY') { 77 return @{$val}; 78 } 79 return $val; 80 } 81 if (wantarray) { 82 return keys %{$self->data()}; 83 } 84 return $self->url_data(); 85 86} 87 88sub request_method { 89 90 # always return POST to allow retrival of the action parameter 91 return 'POST'; 92 93} 94 95sub header {} 96sub cookie {} 97sub http { return 1; } 98 99 100__PACKAGE__->meta->make_immutable; 101