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