From: Tomas Doran Date: Fri, 11 Dec 2009 02:29:11 +0000 (+0000) Subject: Add Trait containing all the real logic X-Git-Tag: 0.80~13 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Action-REST.git;a=commitdiff_plain;h=e623bdf28cc0a79351b055872dedcc1300a5eaca Add Trait containing all the real logic --- diff --git a/lib/Catalyst/Request/REST.pm b/lib/Catalyst/Request/REST.pm index dd45a16..b9b921b 100644 --- a/lib/Catalyst/Request/REST.pm +++ b/lib/Catalyst/Request/REST.pm @@ -2,13 +2,10 @@ package Catalyst::Request::REST; use Moose; use Catalyst::Utils; -use HTTP::Headers::Util qw(split_header_words); - use namespace::autoclean; extends 'Catalyst::Request'; - -has [qw/ data accept_only /] => ( is => 'rw' ); +with 'Catalyst::TraitFor::Request::REST'; sub _insert_self_into { my ($class, $app_class ) = @_; @@ -27,63 +24,6 @@ sub _insert_self_into { } } -sub accepted_content_types { - my $self = shift; - - return $self->{content_types} if $self->{content_types}; - - my %types; - - # First, we use the content type in the HTTP Request. It wins all. - $types{ $self->content_type } = 3 - if $self->content_type; - - if ($self->method eq "GET" && $self->param('content-type')) { - $types{ $self->param('content-type') } = 2; - } - - # Third, we parse the Accept header, and see if the client - # takes a format we understand. - # - # This is taken from chansen's Apache2::UploadProgress. - if ( $self->header('Accept') ) { - $self->accept_only(1) unless keys %types; - - my $accept_header = $self->header('Accept'); - my $counter = 0; - - foreach my $pair ( split_header_words($accept_header) ) { - my ( $type, $qvalue ) = @{$pair}[ 0, 3 ]; - next if $types{$type}; - - # cope with invalid (missing required q parameter) header like: - # application/json; charset="utf-8" - # http://tools.ietf.org/html/rfc2616#section-14.1 - unless ( defined $pair->[2] && lc $pair->[2] eq 'q' ) { - $qvalue = undef; - } - - unless ( defined $qvalue ) { - $qvalue = 1 - ( ++$counter / 1000 ); - } - - $types{$type} = sprintf( '%.3f', $qvalue ); - } - } - - return $self->{content_types} = - [ sort { $types{$b} <=> $types{$a} } keys %types ]; -} - -sub preferred_content_type { $_[0]->accepted_content_types->[0] } - -sub accepts { - my $self = shift; - my $type = shift; - - return grep { $_ eq $type } @{ $self->accepted_content_types }; -} - __PACKAGE__->meta->make_immutable; __END__ diff --git a/lib/Catalyst/TraitFor/Request/REST.pm b/lib/Catalyst/TraitFor/Request/REST.pm new file mode 100644 index 0000000..b881a58 --- /dev/null +++ b/lib/Catalyst/TraitFor/Request/REST.pm @@ -0,0 +1,65 @@ +package Catalyst::TraitFor::Request::REST; +use Moose::Role; +use HTTP::Headers::Util qw(split_header_words); +use namespace::autoclean; + +has [qw/ data accept_only /] => ( is => 'rw' ); + +sub accepted_content_types { + my $self = shift; + + return $self->{content_types} if $self->{content_types}; + + my %types; + + # First, we use the content type in the HTTP Request. It wins all. + $types{ $self->content_type } = 3 + if $self->content_type; + + if ($self->method eq "GET" && $self->param('content-type')) { + $types{ $self->param('content-type') } = 2; + } + + # Third, we parse the Accept header, and see if the client + # takes a format we understand. + # + # This is taken from chansen's Apache2::UploadProgress. + if ( $self->header('Accept') ) { + $self->accept_only(1) unless keys %types; + + my $accept_header = $self->header('Accept'); + my $counter = 0; + + foreach my $pair ( split_header_words($accept_header) ) { + my ( $type, $qvalue ) = @{$pair}[ 0, 3 ]; + next if $types{$type}; + + # cope with invalid (missing required q parameter) header like: + # application/json; charset="utf-8" + # http://tools.ietf.org/html/rfc2616#section-14.1 + unless ( defined $pair->[2] && lc $pair->[2] eq 'q' ) { + $qvalue = undef; + } + + unless ( defined $qvalue ) { + $qvalue = 1 - ( ++$counter / 1000 ); + } + + $types{$type} = sprintf( '%.3f', $qvalue ); + } + } + + return $self->{content_types} = + [ sort { $types{$b} <=> $types{$a} } keys %types ]; +} + +sub preferred_content_type { $_[0]->accepted_content_types->[0] } + +sub accepts { + my $self = shift; + my $type = shift; + + return grep { $_ eq $type } @{ $self->accepted_content_types }; +} + +1;