use Moose;
+use namespace::clean -except => 'meta';
+
+with 'MooseX::Emulate::Class::Accessor::Fast';
+
has action => (is => 'rw');
has address => (is => 'rw');
has arguments => (is => 'rw', default => sub { [] });
has query_parameters => (is => 'rw', default => sub { {} });
has secure => (is => 'rw', default => 0);
has captures => (is => 'rw', default => sub { [] });
-has uri => (is => 'rw');
+has uri => (is => 'rw', predicate => 'has_uri');
has user => (is => 'rw');
has headers => (
is => 'rw',
lazy => 1,
);
-#Moose ToDo:
-#can we lose the before modifiers which just call prepare_body ?
-#they are wasteful, slow us down and feel cluttery.
+# Moose TODO:
+# - Can we lose the before modifiers which just call prepare_body ?
+# they are wasteful, slow us down and feel cluttery.
# Can we call prepare_body at BUILD time?
-# Can we make _body an attribute and have the rest of these lazy build from there?
+# Can we make _body an attribute, have the rest of
+# these lazy build from there and kill all the direct hash access
+# in Catalyst.pm and Engine.pm?
has _context => (
is => 'rw',
weak_ref => 1,
handles => ['read'],
+ clearer => '_clear_context',
);
has body_parameters => (
has uploads => (
is => 'rw',
required => 1,
- lazy => 1,
default => sub { {} },
);
-# modifier was a noop (groditi)
-# before uploads => sub {
-# my ($self) = @_;
-# #$self->_context->prepare_body;
-# };
-
has parameters => (
is => 'rw',
required => 1,
before parameters => sub {
my ($self, $params) = @_;
- #$self->_context->prepare_body();
if ( $params && !ref $params ) {
$self->_context->log->warn(
"Attempt to retrieve '$params' with req->params(), " .
lazy => 1,
default => sub {
my $self = shift;
- return $self->path if $self->uri;
+ return $self->path if $self->has_uri;
},
);
-has body => (
- is => 'rw'
+has _body => (
+ is => 'rw', clearer => '_clear_body', predicate => '_has_body',
);
-
-before body => sub {
- my ($self) = @_;
+# Eugh, ugly. Should just be able to rename accessor methods to 'body'
+# and provide a custom reader..
+sub body {
+ my $self = shift;
$self->_context->prepare_body();
-};
+ $self->_body(@_) if scalar @_;
+ return blessed $self->_body ? $self->_body->body : $self->_body;
+}
has hostname => (
is => 'rw',
lazy => 1,
default => sub {
my ($self) = @_;
- gethostbyaddr( inet_aton( $self->address ), AF_INET )
+ gethostbyaddr( inet_aton( $self->address ), AF_INET ) || 'localhost'
},
);
-no Moose;
+has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
sub args { shift->arguments(@_) }
sub body_params { shift->body_parameters(@_) }
and the URI for the request was C<http://.../foo/moose/bah>, the string C<bah>
would be the first and only argument.
+Arguments just get passed through and B<don't> get unescaped automatically, so
+you should do that explicitly.
+
=head2 $req->args
Shortcut for arguments.
=head2 $req->path_info
-Alias for path, added for compability with L<CGI>.
+Alias for path, added for compatibility with L<CGI>.
=cut
if (@params) {
$self->uri->path(@params);
- undef $self->{path};
+ $self->_clear_path;
}
- elsif ( defined( my $path = $self->{path} ) ) {
- return $path;
+ elsif ( $self->_has_path ) {
+ return $self->_path;
}
else {
my $path = $self->uri->path;
my $location = $self->base->path;
$path =~ s/^(\Q$location\E)?//;
$path =~ s/^\///;
- $self->{path} = $path;
+ $self->_path($path);
return $path;
}
=head2 $req->captures
-Returns a reference to an array containing regex captures.
+Returns a reference to an array containing captured args from chained
+actions or regex captures.
my @captures = @{ $c->request->captures };
=head2 $req->snippets
-C<captures> used to be called snippets. This is still available for backwoards
+C<captures> used to be called snippets. This is still available for backwards
compatibility, but is considered deprecated.
=head2 $req->upload
=head2 $req->uri_with( { key => 'value' } );
Returns a rewritten URI object for the current request. Key/value pairs
-passed in will override existing parameters. Unmodified pairs will be
+passed in will override existing parameters. You can remove an existing
+parameter by passing in an undef value. Unmodified pairs will be
preserved.
=cut
carp( 'No arguments passed to uri_with()' ) unless $args;
- for my $value ( values %$args ) {
+ foreach my $value ( values %$args ) {
next unless defined $value;
for ( ref $value eq 'ARRAY' ? @$value : $value ) {
$_ = "$_";
}
};
- my $uri = $self->uri->clone;
-
+ my $uri = $self->uri->clone;
+ my %query = ( %{ $uri->query_form_hash }, %$args );
+
$uri->query_form( {
- %{ $uri->query_form_hash },
- %$args
+ # remove undef values
+ map { defined $query{ $_ } ? ( $_ => $query{ $_ } ) : () } keys %query
} );
return $uri;
}
=head1 AUTHORS
-Sebastian Riedel, C<sri@cpan.org>
-
-Marcus Ramberg, C<mramberg@cpan.org>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT