[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->cookie

A convenient method to $req->cookies.

    $cookie  = $c->request->cookie('name');
    @cookies = $c->request->cookie;

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

=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 ( @_ == 0 && not $self->{hostname} ) {
         $self->{hostname} = gethostbyaddr( inet_aton( $self->address ), AF_INET );
    }

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

    return $self->{hostname};
}

=item $req->input

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;

=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-compatible param method. This 
is a method for accessing parameters in $c->req->parameters.

    $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
3ad654e0	120	=item $req->cookie
	121
	122	A convenient method to $req->cookies.
	123
	124	$cookie = $c->request->cookie('name');
	125	@cookies = $c->request->cookie;
	126
	127	=cut
	128
	129	sub cookie {
	130	my $self = shift;
	131
	132	if ( @_ == 0 ) {
	133	return keys %{ $self->cookie };
	134	}
	135
	136	if ( @_ == 1 ) {
	137
	138	my $name = shift;
	139
	140	unless ( exists $self->cookie->{$name} ) {
	141	return undef;
	142	}
	143
	144	return $self->cookie->{$name};
	145	}
	146	}
	147
b22c6668	148	=item $req->cookies
fc7ec1d9	149
b22c6668	150	Returns a reference to a hash containing the cookies.
fc7ec1d9	151
	152	print $c->request->cookies->{mycookie}->value;
	153
b5176d9e	154	=item $req->header
	155
	156	Shortcut to $req->headers->header
	157
b22c6668	158	=item $req->headers
fc7ec1d9	159
b22c6668	160	Returns an L<HTTP::Headers> object containing the headers.
fc7ec1d9	161
	162	print $c->request->headers->header('X-Catalyst');
	163
b22c6668	164	=item $req->hostname
0556eb49	165
b4ca0ee8	166	Lookup the current users DNS hostname.
0556eb49	167
0556eb49	168	print $c->request->hostname
b4ca0ee8	169
	170	=cut
	171
	172	sub hostname {
	173	my $self = shift;
	174
a268a011	175	if ( @_ == 0 && not $self->{hostname} ) {
a268a011	176	$self->{hostname} = gethostbyaddr( inet_aton( $self->address ), AF_INET );
b4ca0ee8	177	}
b4ca0ee8	178
a268a011	179	if ( @_ == 1 ) {
a268a011	180	$self->{hostname} = shift;
b4ca0ee8	181	}
	182
	183	return $self->{hostname};
	184	}
0556eb49	185
61bacdcc	186	=item $req->input
61bacdcc	187
e060fe05	188	Shortcut for $req->body.
61bacdcc	189
b22c6668	190	=item $req->match
fc7ec1d9	191
c1f33816	192	This contains the matching part of a regexp action. Otherwise
c1f33816	193	it returns the same as 'action'.
fc7ec1d9	194
	195	print $c->request->match;
	196
b5176d9e	197	=item $req->method
	198
	199	Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
	200
e7c0c583	201	print $c->request->method;
	202
	203	=item $req->param
	204
2ef2fb0f	205	Get request parameters with a CGI.pm-compatible param method. This
2ef2fb0f	206	is a method for accessing parameters in $c->req->parameters.
e7c0c583	207
	208	$value = $c->request->param('foo');
	209	@values = $c->request->param('foo');
	210	@params = $c->request->param;
	211
	212	=cut
	213
	214	sub param {
	215	my $self = shift;
	216
	217	if ( @_ == 0 ) {
	218	return keys %{ $self->parameters };
	219	}
	220
bfde09a2	221	if ( @_ == 1 ) {
e7c0c583	222
bfde09a2	223	my $param = shift;
6bd2b72c	224
bfde09a2	225	unless ( exists $self->parameters->{$param} ) {
	226	return wantarray ? () : undef;
	227	}
	228
	229	if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
	230	return (wantarray)
	231	? @{ $self->parameters->{$param} }
	232	: $self->parameters->{$param}->[0];
	233	}
	234	else {
	235	return (wantarray)
	236	? ( $self->parameters->{$param} )
	237	: $self->parameters->{$param};
	238	}
d7945f32	239	}
bfde09a2	240
03222156	241	if ( @_ > 1 ) {
bfde09a2	242
bfde09a2	243	while ( my ( $field, $value ) = splice( @_, 0, 2 ) ) {
a4def412	244
a4def412	245	next unless defined $field;
bfde09a2	246
	247	if ( exists $self->parameters->{$field} ) {
	248	for ( $self->parameters->{$field} ) {
	249	$_ = [$_] unless ref($_) eq "ARRAY";
	250	push( @$_, $value );
	251	}
	252	}
	253	else {
	254	$self->parameters->{$field} = $value;
	255	}
	256	}
d7945f32	257	}
e7c0c583	258	}
b5176d9e	259
b22c6668	260	=item $req->params
fc7ec1d9	261
61b1e958	262	Shortcut for $req->parameters.
	263
	264	=item $req->parameters
	265
e7c0c583	266	Returns a reference to a hash containing parameters. Values can
e7c0c583	267	be either a scalar or a arrayref containing scalars.
fc7ec1d9	268
e7c0c583	269	print $c->request->parameters->{field};
e7c0c583	270	print $c->request->parameters->{field}->[0];
fc7ec1d9	271
b22c6668	272	=item $req->path
fc7ec1d9	273
	274	Contains the path.
	275
	276	print $c->request->path;
	277
bfde09a2	278	=item $req->protocol
	279
	280	Contains the protocol.
	281
b5176d9e	282	=item $req->referer
fc7ec1d9	283
61b1e958	284	Shortcut to $req->headers->referer. Referring page.
fc7ec1d9	285
bfde09a2	286	=item $req->secure
	287
	288	Contains a boolean whether the communciation is secure.
	289
b22c6668	290	=item $req->snippets
fc7ec1d9	291
b22c6668	292	Returns a reference to an array containing regex snippets.
fc7ec1d9	293
	294	my @snippets = @{ $c->request->snippets };
	295
e7c0c583	296	=item $req->upload
	297
	298	A convenient method to $req->uploads.
	299
	300	$upload = $c->request->upload('field');
	301	@uploads = $c->request->upload('field');
	302	@fields = $c->request->upload;
bfde09a2	303
e7c0c583	304	for my $upload ( $c->request->upload('field') ) {
146554c5	305	print $upload->filename;
e7c0c583	306	}
	307
	308	=cut
	309
	310	sub upload {
	311	my $self = shift;
	312
	313	if ( @_ == 0 ) {
	314	return keys %{ $self->uploads };
	315	}
	316
bfde09a2	317	if ( @_ == 1 ) {
e7c0c583	318
bfde09a2	319	my $upload = shift;
	320
	321	unless ( exists $self->uploads->{$upload} ) {
	322	return wantarray ? () : undef;
	323	}
6bd2b72c	324
bfde09a2	325	if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
	326	return (wantarray)
	327	? @{ $self->uploads->{$upload} }
	328	: $self->uploads->{$upload}->[0];
	329	}
	330	else {
	331	return (wantarray)
	332	? ( $self->uploads->{$upload} )
	333	: $self->uploads->{$upload};
	334	}
d7945f32	335	}
bfde09a2	336
a4f5c51e	337	if ( @_ > 1 ) {
bfde09a2	338
	339	while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
	340
	341	if ( exists $self->uploads->{$field} ) {
	342	for ( $self->uploads->{$field} ) {
	343	$_ = [$_] unless ref($_) eq "ARRAY";
	344	push( @$_, $upload );
	345	}
	346	}
	347	else {
	348	$self->uploads->{$field} = $upload;
	349	}
	350	}
e7c0c583	351	}
	352	}
	353
b22c6668	354	=item $req->uploads
fc7ec1d9	355
bfde09a2	356	Returns a reference to a hash containing uploads. Values can be either a
146554c5	357	hashref or a arrayref containing C<Catalyst::Request::Upload> objects.
e7c0c583	358
	359	my $upload = $c->request->uploads->{field};
	360	my $upload = $c->request->uploads->{field}->[0];
	361
77d12cae	362	=item $req->uri
	363
	364	Shortcut for C<< $req->base . $req->path >>.
	365
	366	=cut
	367
	368	sub uri {
	369	my $self = shift;
	370	my $path = shift \|\| $self->path \|\| '';
	371	return $self->base . $path;
	372	}
	373
66294129	374	=item $req->user
	375
	376	Contains the user name of user if authentication check was successful.
	377
b5176d9e	378	=item $req->user_agent
b5176d9e	379
61b1e958	380	Shortcut to $req->headers->user_agent. User Agent version string.
b5176d9e	381
b22c6668	382	=back
b22c6668	383
fc7ec1d9	384	=head1 AUTHOR
	385
	386	Sebastian Riedel, C<sri@cpan.org>
61b1e958	387	Marcus Ramberg, C<mramberg@cpan.org>
fc7ec1d9	388
	389	=head1 COPYRIGHT
	390
e7c0c583	391	This program is free software, you can redistribute it and/or modify
61b1e958	392	it under the same terms as Perl itself.
fc7ec1d9	393
	394	=cut
	395
	396	1;