[catagits/Catalyst-Runtime.git] / lib / Catalyst / Request.pm

package Catalyst::Request;

use strict;
use base 'Class::Accessor::Fast';

use IO::Socket qw[AF_INET inet_aton];

__PACKAGE__->mk_accessors(
    qw/action address arguments body base cookies headers match method 
       parameters path protocol secure snippets uploads user/
);

*args   = \&arguments;
*input  = \&body;
*params = \&parameters;

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


    $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<Catalyst>.

=head1 DESCRIPTION

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.


=head1 METHODS

=over 4

=item $req->action

Contains the requested action.

    print $c->request->action;

=item $req->address

Contains the remote address.

    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];

=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<application/x-www-form-urlencoded> or C<multipart/form-data>.

    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->cookies

Returns a reference to a hash containing the cookies.

    print $c->request->cookies->{mycookie}->value;

=item $req->header

Shortcut to $req->headers->header

=item $req->headers

Returns an L<HTTP::Headers> object containing the headers.

    print $c->request->headers->header('X-Catalyst');

=item $req->hostname

Lookup the current users DNS hostname.

    print $c->request->hostname
    
=cut

sub hostname {
    my $self = shift;

    if ( @_ ) {
        $self->{hostname} = shift;
        return $self->{hostname};
    }

    unless ( $self->{hostname} ) {
         $self->{hostname} = gethostbyaddr( inet_aton( $self->address ), AF_INET );
    }

    return $self->{hostname};
}

=item $req->input

Shortcut for $req->body.

=item $req->match

This contains be the matching part of a regexp action. otherwise it
returns the same as 'action'.

    print $c->request->match;

=item $req->method

Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).

    print $c->request->method;

=item $req->param

Get request parameters with a CGI.pm like param method.

    $value  = $c->request->param('foo');
    @values = $c->request->param('foo');
    @params = $c->request->param;

=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 a arrayref containing scalars.

    print $c->request->parameters->{field};
    print $c->request->parameters->{field}->[0];

=item $req->path

Contains the path.

    print $c->request->path;

=item $req->protocol

Contains the protocol.

=item $req->referer

Shortcut to $req->headers->referer. Referring page.

=item $req->secure

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 };

=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<Catalyst::Request::Upload> 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

Shortcut to $req->headers->user_agent. User Agent version string.

=back

=head1 AUTHOR

Sebastian Riedel, C<sri@cpan.org>
Marcus Ramberg, C<mramberg@cpan.org>

=head1 COPYRIGHT

This program is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;
Commit	Line	Data
fc7ec1d9	1	package Catalyst::Request;
	2
	3	use strict;
	4	use base 'Class::Accessor::Fast';
	5
b4ca0ee8	6	use IO::Socket qw[AF_INET inet_aton];
b4ca0ee8	7
fc7ec1d9	8	__PACKAGE__->mk_accessors(
b4ca0ee8	9	qw/action address arguments body base cookies headers match method
b4ca0ee8	10	parameters path protocol secure snippets uploads user/
fc7ec1d9	11	);
	12
	13	*args = \&arguments;
e060fe05	14	*input = \&body;
fc7ec1d9	15	*params = \&parameters;
fc7ec1d9	16
f7e4e231	17	sub content_encoding { shift->headers->content_encoding(@_) }
	18	sub content_length { shift->headers->content_length(@_) }
	19	sub content_type { shift->headers->content_type(@_) }
	20	sub header { shift->headers->header(@_) }
	21	sub referer { shift->headers->referer(@_) }
	22	sub user_agent { shift->headers->user_agent(@_) }
	23
fc7ec1d9	24	=head1 NAME
	25
	26	Catalyst::Request - Catalyst Request Class
	27
	28	=head1 SYNOPSIS
	29
b22c6668	30
	31	$req = $c->request;
	32	$req->action;
	33	$req->address;
	34	$req->args;
	35	$req->arguments;
	36	$req->base;
06e1b616	37	$req->body;
b5176d9e	38	$req->content_encoding;
	39	$req->content_length;
	40	$req->content_type;
b22c6668	41	$req->cookies;
b5176d9e	42	$req->header;
b22c6668	43	$req->headers;
b22c6668	44	$req->hostname;
61bacdcc	45	$req->input;
b22c6668	46	$req->match;
b22c6668	47	$req->method;
e7c0c583	48	$req->param;
b22c6668	49	$req->params;
e7c0c583	50	$req->parameters;
b22c6668	51	$req->path;
bfde09a2	52	$req->protocol;
b5176d9e	53	$req->referer;
bfde09a2	54	$req->secure;
b22c6668	55	$req->snippets;
e7c0c583	56	$req->upload;
b22c6668	57	$req->uploads;
77d12cae	58	$req->uri;
66294129	59	$req->user;
66294129	60	$req->user_agent;
b22c6668	61
b22c6668	62	See also L<Catalyst>.
fc7ec1d9	63
	64	=head1 DESCRIPTION
	65
b22c6668	66	This is the Catalyst Request class, which provides a set of accessors to the
	67	request data. The request object is prepared by the specialized Catalyst
	68	Engine module thus hiding the details of the particular engine implementation.
	69
	70
	71	=head1 METHODS
fc7ec1d9	72
b22c6668	73	=over 4
fc7ec1d9	74
b22c6668	75	=item $req->action
fc7ec1d9	76
61b1e958	77	Contains the requested action.
fc7ec1d9	78
	79	print $c->request->action;
	80
b22c6668	81	=item $req->address
0556eb49	82
	83	Contains the remote address.
	84
	85	print $c->request->address
	86
b22c6668	87	=item $req->args
b22c6668	88
61b1e958	89	Shortcut for arguments
	90
	91	=item $req->arguments
	92
b22c6668	93	Returns a reference to an array containing the arguments.
fc7ec1d9	94
	95	print $c->request->arguments->[0];
	96
b22c6668	97	=item $req->base
fc7ec1d9	98
61b1e958	99	Contains the url base. This will always have a trailing slash.
fc7ec1d9	100
06e1b616	101	=item $req->body
06e1b616	102
e060fe05	103	Contains the message body of the request unless Content-Type is
	104	C<application/x-www-form-urlencoded> or C<multipart/form-data>.
	105
	106	print $c->request->body
06e1b616	107
b5176d9e	108	=item $req->content_encoding
	109
	110	Shortcut to $req->headers->content_encoding
	111
	112	=item $req->content_length
	113
	114	Shortcut to $req->headers->content_length
	115
	116	=item $req->content_type
	117
	118	Shortcut to $req->headers->content_type
	119
b22c6668	120	=item $req->cookies
fc7ec1d9	121
b22c6668	122	Returns a reference to a hash containing the cookies.
fc7ec1d9	123
	124	print $c->request->cookies->{mycookie}->value;
	125
b5176d9e	126	=item $req->header
	127
	128	Shortcut to $req->headers->header
	129
b22c6668	130	=item $req->headers
fc7ec1d9	131
b22c6668	132	Returns an L<HTTP::Headers> object containing the headers.
fc7ec1d9	133
	134	print $c->request->headers->header('X-Catalyst');
	135
b22c6668	136	=item $req->hostname
0556eb49	137
b4ca0ee8	138	Lookup the current users DNS hostname.
0556eb49	139
0556eb49	140	print $c->request->hostname
b4ca0ee8	141
	142	=cut
	143
	144	sub hostname {
	145	my $self = shift;
	146
	147	if ( @_ ) {
	148	$self->{hostname} = shift;
99386274	149	return $self->{hostname};
b4ca0ee8	150	}
	151
	152	unless ( $self->{hostname} ) {
	153	$self->{hostname} = gethostbyaddr( inet_aton( $self->address ), AF_INET );
	154	}
	155
	156	return $self->{hostname};
	157	}
0556eb49	158
61bacdcc	159	=item $req->input
61bacdcc	160
e060fe05	161	Shortcut for $req->body.
61bacdcc	162
b22c6668	163	=item $req->match
fc7ec1d9	164
e7c0c583	165	This contains be the matching part of a regexp action. otherwise it
61b1e958	166	returns the same as 'action'.
fc7ec1d9	167
	168	print $c->request->match;
	169
b5176d9e	170	=item $req->method
	171
	172	Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
	173
e7c0c583	174	print $c->request->method;
	175
	176	=item $req->param
	177
	178	Get request parameters with a CGI.pm like param method.
	179
	180	$value = $c->request->param('foo');
	181	@values = $c->request->param('foo');
	182	@params = $c->request->param;
	183
	184	=cut
	185
	186	sub param {
	187	my $self = shift;
	188
	189	if ( @_ == 0 ) {
	190	return keys %{ $self->parameters };
	191	}
	192
bfde09a2	193	if ( @_ == 1 ) {
e7c0c583	194
bfde09a2	195	my $param = shift;
6bd2b72c	196
bfde09a2	197	unless ( exists $self->parameters->{$param} ) {
	198	return wantarray ? () : undef;
	199	}
	200
	201	if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
	202	return (wantarray)
	203	? @{ $self->parameters->{$param} }
	204	: $self->parameters->{$param}->[0];
	205	}
	206	else {
	207	return (wantarray)
	208	? ( $self->parameters->{$param} )
	209	: $self->parameters->{$param};
	210	}
d7945f32	211	}
bfde09a2	212
03222156	213	if ( @_ > 1 ) {
bfde09a2	214
bfde09a2	215	while ( my ( $field, $value ) = splice( @_, 0, 2 ) ) {
a4def412	216
a4def412	217	next unless defined $field;
bfde09a2	218
	219	if ( exists $self->parameters->{$field} ) {
	220	for ( $self->parameters->{$field} ) {
	221	$_ = [$_] unless ref($_) eq "ARRAY";
	222	push( @$_, $value );
	223	}
	224	}
	225	else {
	226	$self->parameters->{$field} = $value;
	227	}
	228	}
d7945f32	229	}
e7c0c583	230	}
b5176d9e	231
b22c6668	232	=item $req->params
fc7ec1d9	233
61b1e958	234	Shortcut for $req->parameters.
	235
	236	=item $req->parameters
	237
e7c0c583	238	Returns a reference to a hash containing parameters. Values can
e7c0c583	239	be either a scalar or a arrayref containing scalars.
fc7ec1d9	240
e7c0c583	241	print $c->request->parameters->{field};
e7c0c583	242	print $c->request->parameters->{field}->[0];
fc7ec1d9	243
b22c6668	244	=item $req->path
fc7ec1d9	245
	246	Contains the path.
	247
	248	print $c->request->path;
	249
bfde09a2	250	=item $req->protocol
	251
	252	Contains the protocol.
	253
b5176d9e	254	=item $req->referer
fc7ec1d9	255
61b1e958	256	Shortcut to $req->headers->referer. Referring page.
fc7ec1d9	257
bfde09a2	258	=item $req->secure
	259
	260	Contains a boolean whether the communciation is secure.
	261
b22c6668	262	=item $req->snippets
fc7ec1d9	263
b22c6668	264	Returns a reference to an array containing regex snippets.
fc7ec1d9	265
	266	my @snippets = @{ $c->request->snippets };
	267
e7c0c583	268	=item $req->upload
	269
	270	A convenient method to $req->uploads.
	271
	272	$upload = $c->request->upload('field');
	273	@uploads = $c->request->upload('field');
	274	@fields = $c->request->upload;
bfde09a2	275
e7c0c583	276	for my $upload ( $c->request->upload('field') ) {
146554c5	277	print $upload->filename;
e7c0c583	278	}
	279
	280	=cut
	281
	282	sub upload {
	283	my $self = shift;
	284
	285	if ( @_ == 0 ) {
	286	return keys %{ $self->uploads };
	287	}
	288
bfde09a2	289	if ( @_ == 1 ) {
e7c0c583	290
bfde09a2	291	my $upload = shift;
	292
	293	unless ( exists $self->uploads->{$upload} ) {
	294	return wantarray ? () : undef;
	295	}
6bd2b72c	296
bfde09a2	297	if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
	298	return (wantarray)
	299	? @{ $self->uploads->{$upload} }
	300	: $self->uploads->{$upload}->[0];
	301	}
	302	else {
	303	return (wantarray)
	304	? ( $self->uploads->{$upload} )
	305	: $self->uploads->{$upload};
	306	}
d7945f32	307	}
bfde09a2	308
a4f5c51e	309	if ( @_ > 1 ) {
bfde09a2	310
	311	while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
	312
	313	if ( exists $self->uploads->{$field} ) {
	314	for ( $self->uploads->{$field} ) {
	315	$_ = [$_] unless ref($_) eq "ARRAY";
	316	push( @$_, $upload );
	317	}
	318	}
	319	else {
	320	$self->uploads->{$field} = $upload;
	321	}
	322	}
e7c0c583	323	}
	324	}
	325
b22c6668	326	=item $req->uploads
fc7ec1d9	327
bfde09a2	328	Returns a reference to a hash containing uploads. Values can be either a
146554c5	329	hashref or a arrayref containing C<Catalyst::Request::Upload> objects.
e7c0c583	330
	331	my $upload = $c->request->uploads->{field};
	332	my $upload = $c->request->uploads->{field}->[0];
	333
77d12cae	334	=item $req->uri
	335
	336	Shortcut for C<< $req->base . $req->path >>.
	337
	338	=cut
	339
	340	sub uri {
	341	my $self = shift;
	342	my $path = shift \|\| $self->path \|\| '';
	343	return $self->base . $path;
	344	}
	345
66294129	346	=item $req->user
	347
	348	Contains the user name of user if authentication check was successful.
	349
b5176d9e	350	=item $req->user_agent
b5176d9e	351
61b1e958	352	Shortcut to $req->headers->user_agent. User Agent version string.
b5176d9e	353
b22c6668	354	=back
b22c6668	355
fc7ec1d9	356	=head1 AUTHOR
	357
	358	Sebastian Riedel, C<sri@cpan.org>
61b1e958	359	Marcus Ramberg, C<mramberg@cpan.org>
fc7ec1d9	360
	361	=head1 COPYRIGHT
	362
e7c0c583	363	This program is free software, you can redistribute it and/or modify
61b1e958	364	it under the same terms as Perl itself.
fc7ec1d9	365
	366	=cut
	367
	368	1;