Documentation
¶
Overview ¶
#!perl
use strict; use warnings;
use Web::Machine;
=pod
This test shows that the order of content_types_provided is actually important if you do not specify a media-type.
# JSON is the default ... curl -v http://0:5000/
# you must ask specifically for HTML curl -v http://0:5000/ -H 'Accept: text/html'
# but open in a browser and you get HTML open http://0:5000/
=cut
{
package YAPC::NA::2012::Example001::Resource;
use strict;
use warnings;
use JSON::XS qw[ encode_json ];
use parent 'Web::Machine::Resource';
sub content_types_provided { [
{ 'application/json' => 'to_json' },
{ 'text/html' => 'to_html' },
] }
sub to_json { encode_json( { message => 'Hello World' } ) }
sub to_html { '<html><body><h1>Hello World</h1></body></html>' }
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example001::Resource' )->to_app;
#!perl
use strict; use warnings;
use Web::Machine;
=pod
And showing preference is just as simple as changing the order of items in content_types_provided
# now HTML is the default curl -v http://0:5000/
# and you must ask specifically for JSON curl -v http://0:5000/ -H 'Accept: application/json'
=cut
{
package YAPC::NA::2012::Example002::Resource;
use strict;
use warnings;
use JSON::XS qw[ encode_json ];
use parent 'Web::Machine::Resource';
sub content_types_provided { [
{ 'text/html' => 'to_html' },
{ 'application/json' => 'to_json' },
] }
sub to_json { encode_json( { message => 'Hello World' } ) }
sub to_html { '<html><body><h1>Hello World</h1></body></html>' }
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example002::Resource' )->to_app;
#!perl
use strict; use warnings;
use Web::Machine;
=pod
Curl by default, it accepts anything, as you can see when we run this.
curl -v http://0:5000/
However, web browsers are more sophisticated creatures and have more complicated needs.
open http://0:5000/
You can see that since we only provide JSON, that we end up matching the catchall at the end.
=cut
{
package YAPC::NA::2012::Example010::Resource;
use strict;
use warnings;
use JSON::XS ();
use parent 'Web::Machine::Resource';
sub content_types_provided { [{ 'application/json' => 'to_json' }] }
sub to_json {
my $self = shift;
JSON::XS->new->pretty->encode([
map {
+{ $_->[0] => $_->[1]->type }
} $self->request->header('Accept')->iterable
])
}
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example010::Resource' )->to_app;
#!perl
use strict; use warnings;
use Web::Machine;
=pod
And of course, you don't have to just provide text based results ...
=cut
{
package YAPC::NA::2012::Example012::Resource;
use strict;
use warnings;
use JSON::XS ();
use GD::Simple;
use parent 'Web::Machine::Resource';
sub content_types_provided { [
{ 'image/gif' => 'to_gif' },
{ 'text/html' => 'to_html' },
] }
sub to_html {
my $self = shift;
'<html><body><ul>' .
(join "" => map {
'<li>' . $_->[0] . ' — ' . $_->[1]->type . '</li>'
} $self->request->header('Accept')->iterable)
. '</ul><br/><img src="/hello_world.gif" border="1"/></body></html>'
}
sub to_gif {
my $self = shift;
my $img = GD::Simple->new( 130, 20 );
$img->fgcolor('red');
$img->moveTo(15, 15);
$img->string( $self->request->path_info );
$img->gif;
}
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example012::Resource' )->to_app;
#!perl
use strict; use warnings;
use Web::Machine;
=pod
=cut
{
package YAPC::NA::2012::Example020::Resource;
use strict;
use warnings;
use Web::Machine::Util qw[ create_header ];
use parent 'Web::Machine::Resource';
sub content_types_provided { [ { 'text/html' => 'to_html' } ] }
sub to_html { '<html><body><h1>Hello World</h1></body></html>' }
sub is_authorized {
my ($self, $auth_header) = @_;
if ( $auth_header ) {
return 1 if $auth_header->username eq 'foo' && $auth_header->password eq 'bar';
}
return create_header( 'WWWAuthenticate' => [ 'Basic' => ( realm => 'Webmachine' ) ] );
}
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example020::Resource' )->to_app;
TODO strip away until we're closer to the example
{
package YAPC::NA::2012::Example031::Resource;
use strict;
use warnings;
use JSON::XS ();
use base 'YAPC::NA::2012::Example031::Resource';
sub allowed_methods { [qw[ GET PUT POST ]] }
sub content_types_accepted { [ { 'application/json' => 'from_json' } ] }
sub from_json {
my $self = shift;
$self->save_message( JSON::XS->new->allow_nonref->decode( $self->request->content ) );
}
sub process_post {
my $self = shift;
return \415 unless $self->request->header('Content-Type')->match('application/x-www-form-urlencoded');
$self->SUPER::process_post;
}
}
Source Files