[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->cookie;
    $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->cookies };
    }

    if ( @_ == 1 ) {

        my $name = shift;

        unless ( exists $self->cookies->{$name} ) {
            return undef;
        }
        
        return $self->cookies->{$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 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;

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