X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FRequest.pm;h=ded852a3dd4e0455b939f3d7e8047151b69424e1;hp=b63e48d3dfb4fc55d870b636eafe1a36fbdb0724;hb=d08ced285005d2a98eb0079b4b4ddad72325e367;hpb=5ddd05a02d9532f0beefedd532e604c6f3bae4c8 diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm index b63e48d..ded852a 100644 --- a/lib/Catalyst/Request.pm +++ b/lib/Catalyst/Request.pm @@ -3,104 +3,393 @@ package Catalyst::Request; use strict; use base 'Class::Accessor::Fast'; +use IO::Socket qw[AF_INET inet_aton]; + __PACKAGE__->mk_accessors( - qw/action arguments base cookies headers match method parameters path - snippets uploads/ + qw/action address arguments body base cookies headers match method + parameters path protocol secure snippets uploads user/ ); *args = \&arguments; +*input = \&body; *params = \¶meters; +sub content_encoding { shift->headers->content_encoding(@_) } +sub content_length { shift->headers->content_length(@_) } +sub content_type { shift->headers->content_type(@_) } +sub header { shift->headers->header(@_) } +sub referer { shift->headers->referer(@_) } +sub user_agent { shift->headers->user_agent(@_) } + =head1 NAME Catalyst::Request - Catalyst Request Class =head1 SYNOPSIS -See L. + + $req = $c->request; + $req->action; + $req->address; + $req->args; + $req->arguments; + $req->base; + $req->body; + $req->content_encoding; + $req->content_length; + $req->content_type; + $req->cookies; + $req->header; + $req->headers; + $req->hostname; + $req->input; + $req->match; + $req->method; + $req->param; + $req->params; + $req->parameters; + $req->path; + $req->protocol; + $req->referer; + $req->secure; + $req->snippets; + $req->upload; + $req->uploads; + $req->uri; + $req->user; + $req->user_agent; + +See also L. =head1 DESCRIPTION -The Catalyst Request. +This is the Catalyst Request class, which provides a set of accessors to the +request data. The request object is prepared by the specialized Catalyst +Engine module thus hiding the details of the particular engine implementation. -=head2 METHODS -=head3 action +=head1 METHODS -Contains the action. +=over 4 + +=item $req->action + +Contains the requested action. print $c->request->action; -=head3 arguments (args) +=item $req->address + +Contains the remote address. -Returns an arrayref containing the arguments. + print $c->request->address + +=item $req->args + +Shortcut for arguments + +=item $req->arguments + +Returns a reference to an array containing the arguments. print $c->request->arguments->[0]; -=head3 base +=item $req->base + +Contains the url base. This will always have a trailing slash. + +=item $req->body + +Contains the message body of the request unless Content-Type is +C or C. + + print $c->request->body + +=item $req->content_encoding + +Shortcut to $req->headers->content_encoding + +=item $req->content_length + +Shortcut to $req->headers->content_length + +=item $req->content_type + +Shortcut to $req->headers->content_type + +=item $req->cookie + +A convenient method to $req->cookies. -Contains the uri base. + $cookie = $c->request->cookie('name'); + @cookies = $c->request->cookie; -=head3 cookies +=cut + +sub cookie { + my $self = shift; + + if ( @_ == 0 ) { + return keys %{ $self->cookie }; + } + + if ( @_ == 1 ) { + + my $name = shift; + + unless ( exists $self->cookie->{$name} ) { + return undef; + } + + return $self->cookie->{$name}; + } +} -Returns a hashref containing the cookies. +=item $req->cookies + +Returns a reference to a hash containing the cookies. print $c->request->cookies->{mycookie}->value; -=head3 headers +=item $req->header + +Shortcut to $req->headers->header + +=item $req->headers -Returns a L object containing the headers. +Returns an L object containing the headers. print $c->request->headers->header('X-Catalyst'); -=head3 match +=item $req->hostname + +Lookup the current users DNS hostname. + + print $c->request->hostname + +=cut + +sub hostname { + my $self = shift; + + if ( @_ == 0 && not $self->{hostname} ) { + $self->{hostname} = gethostbyaddr( inet_aton( $self->address ), AF_INET ); + } + + if ( @_ == 1 ) { + $self->{hostname} = shift; + } + + return $self->{hostname}; +} + +=item $req->input -Contains the match. +Shortcut for $req->body. + +=item $req->match + +This contains the matching part of a regexp action. Otherwise +it returns the same as 'action'. print $c->request->match; -=head3 parameters (params) +=item $req->method + +Contains the request method (C, C, C, etc). + + print $c->request->method; + +=item $req->param -Returns a hashref containing the parameters. +Get request parameters with a CGI.pm-compatible param method. This +is a method for accessing parameters in $c->req->parameters. - print $c->request->parameters->{foo}; + $value = $c->request->param('foo'); + @values = $c->request->param('foo'); + @params = $c->request->param; -=head3 path +=cut + +sub param { + my $self = shift; + + if ( @_ == 0 ) { + return keys %{ $self->parameters }; + } + + if ( @_ == 1 ) { + + my $param = shift; + + unless ( exists $self->parameters->{$param} ) { + return wantarray ? () : undef; + } + + if ( ref $self->parameters->{$param} eq 'ARRAY' ) { + return (wantarray) + ? @{ $self->parameters->{$param} } + : $self->parameters->{$param}->[0]; + } + else { + return (wantarray) + ? ( $self->parameters->{$param} ) + : $self->parameters->{$param}; + } + } + + if ( @_ > 1 ) { + + while ( my ( $field, $value ) = splice( @_, 0, 2 ) ) { + + next unless defined $field; + + if ( exists $self->parameters->{$field} ) { + for ( $self->parameters->{$field} ) { + $_ = [$_] unless ref($_) eq "ARRAY"; + push( @$_, $value ); + } + } + else { + $self->parameters->{$field} = $value; + } + } + } +} + +=item $req->params + +Shortcut for $req->parameters. + +=item $req->parameters + +Returns a reference to a hash containing parameters. Values can +be either a scalar or an arrayref containing scalars. + + print $c->request->parameters->{field}; + print $c->request->parameters->{field}->[0]; + +=item $req->path Contains the path. print $c->request->path; -=head3 method +=item $req->protocol + +Contains the protocol. -Contains the request method. +=item $req->referer - print $c->request->method +Shortcut to $req->headers->referer. Referring page. -=head3 snippets +=item $req->secure -Returns an arrayref containing regex snippets. +Contains a boolean whether the communciation is secure. + +=item $req->snippets + +Returns a reference to an array containing regex snippets. my @snippets = @{ $c->request->snippets }; -=head3 uploads +=item $req->upload + +A convenient method to $req->uploads. + + $upload = $c->request->upload('field'); + @uploads = $c->request->upload('field'); + @fields = $c->request->upload; + + for my $upload ( $c->request->upload('field') ) { + print $upload->filename; + } + +=cut + +sub upload { + my $self = shift; + + if ( @_ == 0 ) { + return keys %{ $self->uploads }; + } + + if ( @_ == 1 ) { + + my $upload = shift; + + unless ( exists $self->uploads->{$upload} ) { + return wantarray ? () : undef; + } + + if ( ref $self->uploads->{$upload} eq 'ARRAY' ) { + return (wantarray) + ? @{ $self->uploads->{$upload} } + : $self->uploads->{$upload}->[0]; + } + else { + return (wantarray) + ? ( $self->uploads->{$upload} ) + : $self->uploads->{$upload}; + } + } + + if ( @_ > 1 ) { + + while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) { + + if ( exists $self->uploads->{$field} ) { + for ( $self->uploads->{$field} ) { + $_ = [$_] unless ref($_) eq "ARRAY"; + push( @$_, $upload ); + } + } + else { + $self->uploads->{$field} = $upload; + } + } + } +} + +=item $req->uploads + +Returns a reference to a hash containing uploads. Values can be either a +hashref or a arrayref containing C objects. + + my $upload = $c->request->uploads->{field}; + my $upload = $c->request->uploads->{field}->[0]; + +=item $req->uri + +Shortcut for C<< $req->base . $req->path >>. + +=cut + +sub uri { + my $self = shift; + my $path = shift || $self->path || ''; + return $self->base . $path; +} + +=item $req->user + +Contains the user name of user if authentication check was successful. + +=item $req->user_agent -Returns a hashref containing the uploads. +Shortcut to $req->headers->user_agent. User Agent version string. - my $filename = $c->req->parameters->{foo}; - print $c->request->uploads->{$filename}->type; - print $c->request->uploads->{$filename}->size; - my $fh = $c->request->uploads->{$filename}->fh; - my $content = do { local $/; <$fh> }; +=back =head1 AUTHOR Sebastian Riedel, C +Marcus Ramberg, C =head1 COPYRIGHT -This program is free software, you can redistribute it and/or modify it under -the same terms as Perl itself. +This program is free software, you can redistribute it and/or modify +it under the same terms as Perl itself. =cut