Web-Machine-0.17/ 0000775 0001750 0001750 00000000000 12733042512 013361 5 ustar autarch autarch Web-Machine-0.17/lib/ 0000775 0001750 0001750 00000000000 12733042512 014127 5 ustar autarch autarch Web-Machine-0.17/lib/Web/ 0000775 0001750 0001750 00000000000 12733042512 014644 5 ustar autarch autarch Web-Machine-0.17/lib/Web/Machine.pm 0000644 0001750 0001750 00000022025 12733042512 016545 0 ustar autarch autarch package Web::Machine;
# ABSTRACT: A Perl port of Webmachine
use strict;
use warnings;
our $VERSION = '0.17';
use Try::Tiny;
use Carp qw[ confess ];
use Scalar::Util qw[ blessed ];
use Module::Runtime qw[ use_package_optimistically ];
use Plack::Request;
use Plack::Response;
use Web::Machine::Util qw[ inflate_headers ];
use Web::Machine::FSM;
use parent 'Plack::Component';
sub new {
my ($class, %args) = @_;
(exists $args{'resource'}
&& (not blessed $args{'resource'})
&& use_package_optimistically($args{'resource'})->isa('Web::Machine::Resource'))
|| confess 'You must pass in a resource for this Web::Machine';
if (exists $args{'request_class'}) {
use_package_optimistically($args{'request_class'})->isa('Plack::Request')
|| confess 'The request_class class must inherit from Plack::Request';
}
else {
$args{'request_class'} = 'Plack::Request';
}
$class->SUPER::new( \%args );
}
sub inflate_request {
my ($self, $env) = @_;
inflate_headers( $self->{request_class}->new( $env ) );
}
sub create_fsm {
my $self = shift;
Web::Machine::FSM->new( tracing => $self->{'tracing'} )
}
sub create_resource {
my ($self, $request) = @_;
$self->{'resource'}->new(
request => $request,
response => $request->new_response,
@{ $self->{'resource_args'} || [] },
);
}
sub finalize_response {
my ($self, $response) = @_;
$response->finalize;
}
sub call {
my ($self, $env) = @_;
my $request = try { $self->inflate_request($env) };
return $self->finalize_response( Plack::Response->new( 400 ) )
unless defined $request;
my $resource = $self->create_resource( $request );
my $fsm = $self->create_fsm;
if ($self->{'streaming'}) {
return sub {
my $responder = shift;
my $response = $self->finalize_response( $fsm->run( $resource ) );
if (my $cb = $env->{'web.machine.streaming_push'}) {
pop @$response;
my $writer = $responder->($response);
$cb->($writer);
}
else {
$responder->($response);
}
}
}
else {
my $response = $self->finalize_response( $fsm->run( $resource ) );
if ($env->{'web.machine.streaming_push'}) {
die "Can't do a streaming push response "
. "unless the 'streaming' option was set";
}
else {
return $response;
}
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Web::Machine - A Perl port of Webmachine
=head1 VERSION
version 0.17
=head1 SYNOPSIS
use strict;
use warnings;
use Web::Machine;
{
package HelloWorld::Resource;
use strict;
use warnings;
use parent 'Web::Machine::Resource';
sub content_types_provided { [{ 'text/html' => 'to_html' }] }
sub to_html {
q{
Hello World Resource
Hello World
}
}
}
Web::Machine->new( resource => 'HelloWorld::Resource' )->to_app;
=head1 DESCRIPTION
C provides a RESTful web framework modeled as a state
machine. You define one or more resource classes. Each resource represents a
single RESTful URI end point, such as a user, an email, etc. The resource
class can also be the target for C requests to create a new user, email,
etc.
Each resource is a state machine, and each request for a resource is handled
by running the request through that state machine.
C is built on top of L, but it handles the full request
and response cycle.
See L for more details on using C in
general, and how C and L interact.
This is a port of L, actually
it is much closer to L, with a little bit of
L and
even some of L
thrown in for good measure.
You can learn a bit about Web::Machine's history from the slides for my L<2012
YAPC::NA talk|https://speakerdeck.com/stevan_little/rest-from-the-trenches>.
To learn more about Webmachine, take a look at the links in the SEE ALSO
section.
=head1 METHODS
NOTE: This module is a L subclass and so follows the interface
set forward by that module.
=over 4
=item C<< new( resource => $resource_classname, ?resource_args => $arg_list, ?tracing => 1|0, ?streaming => 1|0, ?request_class => $request_class ) >>
The constructor expects to get a C<$resource_classname>, which it will use to
load and create an instance of the resource class. If that class requires any
additional arguments, they can be specified with the C
parameter. The contents of the C parameter will be made
available to the C method of C.
The C method can also take an optional C parameter which it will
pass on to L and an optional C parameter, which
if true will run the request in a L streaming
response. This can be useful if you need to run your content generation
asynchronously.
The optional C parameter accepts the name of a module that will
be used as the request object. The module must be a class that inherits from
L. Use this if you have a subclass of L that
you would like to use in your L.
=item C
This takes a raw PSGI C<$env> and inflates it into a L instance.
By default this also uses L to inflate the headers
of the request to be complex objects.
=item C
This will create the L object to run. It will get passed
the value of the C constructor parameter.
=item C
This will create the L instance using the class specified
in the C constructor parameter. It will pass in the C<$request> object
and call C on the C<$request> object to get a L
instance.
=item C
Given a C<$response> which is a L object, this will finalize
it and return a raw PSGI response.
=item C
This is the C method overridden from the L superclass.
=back
=head1 DEBUGGING
If you set the C environment variable to C<1> we will print
out information about the path taken through the state machine to STDERR.
If you set C to C then debugging information will be printed
using L's C sub instead.
=head1 SEE ALSO
=over 4
=item The diagram - L
=item Original Erlang - L
=item Ruby port - L
=item Node JS port - L
=item Python port - L
=item 2012 YAPC::NA slides - L
=item an elaborate machine is indispensable: a blog post by Justin Sheehy - L
=item Resources, For Real This Time (with Webmachine): a video by Sean Cribbs - L
=back
=head1 SUPPORT
bugs may be submitted through L.
=head1 AUTHORS
=over 4
=item *
Stevan Little
=item *
Dave Rolsky
=back
=head1 CONTRIBUTORS
=for stopwords Andreas Marienborg Andrew Nelson Arthur Axel 'fREW' Schmidt Carlos Fernando Avila Gratz Fayland Lam George Hartzell Gregory Oschwald Jesse Luehrs John SJ Anderson Mike Raynham Nathan Cutler Olaf Alders Stevan Little Thomas Sibley
=over 4
=item *
Andreas Marienborg
=item *
Andrew Nelson
=item *
Arthur Axel 'fREW' Schmidt
=item *
Carlos Fernando Avila Gratz
=item *
Fayland Lam
=item *
George Hartzell
=item *
Gregory Oschwald
=item *
Jesse Luehrs
=item *
John SJ Anderson
=item *
Mike Raynham
=item *
Nathan Cutler
=item *
Olaf Alders
=item *
Stevan Little
=item *
Thomas Sibley
=back
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2016 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
Web-Machine-0.17/lib/Web/Machine/ 0000775 0001750 0001750 00000000000 12733042512 016210 5 ustar autarch autarch Web-Machine-0.17/lib/Web/Machine/Util.pm 0000644 0001750 0001750 00000013120 12733042512 017456 0 ustar autarch autarch package Web::Machine::Util;
# ABSTRACT: General Utility module
use strict;
use warnings;
our $VERSION = '0.17';
use Carp qw[ confess ];
use Scalar::Util qw[ blessed ];
use List::Util qw[ first ];
use HTTP::Headers::ActionPack 0.07;
use Sub::Exporter -setup => {
exports => [qw[
first
pair_key
pair_value
bind_path
create_date
create_header
inflate_headers
]]
};
sub pair_key { ( keys %{ $_[0] } )[0] }
sub pair_value { ( values %{ $_[0] } )[0] }
{
my $ACTION_PACK = HTTP::Headers::ActionPack->new;
sub create_header { $ACTION_PACK->create( @_ ) }
sub create_date { $ACTION_PACK->create( 'DateHeader' => shift ) }
sub inflate_headers { $ACTION_PACK->inflate( @_ ) }
sub get_action_pack { $ACTION_PACK }
}
sub bind_path {
my ($spec, $path) = @_;
my @parts = grep { defined $_ && $_ ne q{} } split /\// => $path;
my @spec = grep { defined $_ && $_ ne q{} } split /\// => $spec;
my @results;
foreach my $i ( 0 .. $#spec ) {
if ( $spec[ $i ] =~ /^\*$/ ) {
push @results => @parts;
@parts = ();
last;
}
elsif ( $spec[ $i ] =~ /^\:/ ) {
return unless defined $parts[ 0 ];
push @results => shift @parts;
}
elsif ( $spec[ $i ] =~ /^\?\:/ ) {
push @results => shift @parts
if defined $parts[ 0 ];
}
else {
return unless defined $parts[ 0 ];
return unless $spec[ $i ] eq $parts[ 0 ];
shift @parts;
}
}
return if @parts;
wantarray
? @results
: (scalar @results == 1)
? $results[0]
: @results;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Web::Machine::Util - General Utility module
=head1 VERSION
version 0.17
=head1 SYNOPSIS
use Web::Machine::Util;
=head1 DESCRIPTION
This is just a basic utility module used internally by
L. There are no real user serviceable parts
in here.
=for Pod::Coverage get_action_pack
=head1 FUNCTIONS
=over 4
=item C
This is imported from L and passed on here
for export.
=item C
=item C
These two functions are used for fetching the key
and value out of a pair in the L internals.
We represent a pair simply as a HASH ref with one key.
=item C
This will call C on an instance of L.
=item C
This will call C on an instance of L.
=item C
Given either a C<$date_string> or an instance of L,
this will inflate it into a L
object, suitable for use in the FSM.
=item C
Given a C<$path_spec> (described below) and a C<$path>, this will
either bind the path to the spec and return and array of bound
values, or it will return nothing. Returning nothing indicates
that no match was found. Additionally, if this function is called
in scalar context, and there is only one match, it will return
that item. Otherwise it will return the array as normal. This all
makes it easy to use the following idiom:
if ( my $id = bind_path( '/:id', $request->path_info ) ) {
# handle the case with an ID here
}
else {
# handle other cases here
}
The C<$path_spec> follows a pretty standard convention. Literal
path parts must match corresponding literal. Variable path parts
are prefixed by a colon and are captured for returning later, if
a question mark (?) prefixes the colon, that element will be
considered optional. And lastly the "splat" operator (C<*>) is
supported and causes all the rest of the path segments to be
returned. Below are a few examples of this:
spec path result
------------------------------------------------------------
/test/:foo/:bar /test/1/2 ( 1, 2 )
/test/:foo/:bar /test/1/ undef #failure-case
/test/* /test/1/2/3 ( 1, 2, 3 )
/user/:id/:action /user/1/edit ( 1, 'edit' )
/?:id /201 ( 201 )
/?:id / ( )
This function is kept deliberately simple and it is expected
that the user will use C in the array form to assign
multiple variables, like this:
my ( $foo, $bar ) = bind_path( '/test/:foo/:bar', $path );
In the future we might add a C function which
captures the variable names as well, but to be honest, if you
feel you need that, you likely want one of the many excellent
path dispatching modules available on CPAN.
B Some care should be taken when using path specs in
which the only things are either optional parameters
(prefixed with C) or the "splat" operator (C<*>)
as they can return empty arrays, which in certain
contexts can look like match failure. In these cases you
can test the match in scalar context to verify, a match
failure will be C whereas a match success (in
which nothing was matched) will return C<0> (indicating
an array with zero size).
=back
=head1 SUPPORT
bugs may be submitted through L.
=head1 AUTHORS
=over 4
=item *
Stevan Little
=item *
Dave Rolsky
=back
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2016 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
Web-Machine-0.17/lib/Web/Machine/Resource.pm 0000644 0001750 0001750 00000041363 12733042512 020342 0 ustar autarch autarch package Web::Machine::Resource;
# ABSTRACT: A base resource class
use strict;
use warnings;
our $VERSION = '0.17';
use Carp qw[ confess ];
use Scalar::Util qw[ blessed ];
sub new {
my ($class, %args) = @_;
(exists $args{'request'} && blessed $args{'request'} && $args{'request'}->isa('Plack::Request'))
|| confess "You must supply a request and it must be a Plack::Request";
(exists $args{'response'} && blessed $args{'response'} && $args{'response'}->isa('Plack::Response'))
|| confess "You must supply a response and it must be a Plack::Response";
my $self = bless {
request => $args{'request'},
response => $args{'response'},
} => $class;
$self->init( \%args );
$self;
}
sub init {}
sub request { (shift)->{'request'} }
sub response { (shift)->{'response'} }
# NOTE:
# this is where we deviate from
# the Erlang/Ruby versions
# - SL
sub create_path_after_handler { 0 }
sub resource_exists { 1 }
sub service_available { 1 }
sub is_authorized { 1 }
sub forbidden { 0 }
sub allow_missing_post { 0 }
sub malformed_request { 0 }
sub uri_too_long { 0 }
sub known_content_type { 1 }
sub valid_content_headers { 1 }
sub valid_entity_length { 1 }
sub options { +{} }
sub allowed_methods { [qw[ GET HEAD ]] }
sub known_methods { [qw[ GET HEAD POST PUT DELETE TRACE CONNECT OPTIONS ]]}
sub delete_resource { 0 }
sub delete_completed { 1 }
sub post_is_create { 0 }
sub create_path { undef }
sub base_uri { undef }
sub process_post { 0 }
sub content_types_provided { [] }
sub content_types_accepted { [] }
sub charsets_provided { [] }
sub default_charset {}
sub languages_provided { [] }
sub encodings_provided { { 'identity' => sub { $_[1] } } }
sub variances { [] }
sub is_conflict { 0 }
sub multiple_choices { 0 }
sub previously_existed { 0 }
sub moved_permanently { 0 }
sub moved_temporarily { 0 }
sub last_modified { undef }
sub expires { undef }
sub generate_etag { undef }
sub finish_request {}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Web::Machine::Resource - A base resource class
=head1 VERSION
version 0.17
=head1 SYNOPSIS
package HelloWorld::Resource;
use strict;
use warnings;
use parent 'Web::Machine::Resource';
sub content_types_provided { [{ 'text/html' => 'to_html' }] }
sub to_html {
q{
Hello World Resource
Hello World
}
}
=head1 DESCRIPTION
This is the core representation of the web resource in
L. It is this object which is interrogated
through the state machine. It is important not to think
of this as an instance of a single object, but as a web
representation of a resource: there is a big difference.
For now I am keeping the documentation short, but much more needs to be
written here. Below you will find a description of each method this object
provides and what is expected of it. Your resource classes should extend the
base L class, overriding its methods as
necessary. Sane defaults are provided for most methods, but you will want to
create a C method, as without this your resource will
not be able to return any useful content.
The documentation was lovingly stolen from the ruby port
of webmachine.
=for Pod::Coverage new
=head1 METHODS
Keep in mind that the methods may be called more than once
per request, so your implementations should be idempotent.
=over 4
=item C
This method is called right after the object is blessed
and it is passed a reference to the original C<%args> that
were given to the constructor. By default, these will
include C (L) and C
(L) arguments.
If your resource is instantiated via L then the
contents of its C parameter will be appended
to the L constructor arguments and
made available to C:
use strict;
use warnings;
use Web::Machine;
{
package HelloWorld::Resource;
use strict;
use warnings;
use JSON::XS qw[ encode_json ];
use parent 'Web::Machine::Resource';
sub init {
my $self = shift;
my $args = shift;
# Plack::Request
# my $request = $args->{request};
# Plack::Response
# my $response = $args->{response};
$self->{json}
= exists $args->{json}
? $args->{json}
: {};
}
sub content_types_provided { [ { 'application/json' => 'to_json' } ] }
sub to_json {
my $self = shift;
encode_json( $self->{json} );
}
}
Web::Machine->new(
resource => 'HelloWorld::Resource',
resource_args => [
json => {
message => 'Hello World!',
},
],
)->to_app;
=item C
Returns the L (or subclass) request object for the current
request.
=item C
Returns the L (or subclass) response object for the current
request.
=item C
Does the resource exist?
Returning a false value will result in a '404 Not Found'
response.
Defaults to true.
=item C
Is the resource available?
Returning a false value will result in a '503 Service Not
Available' response.
Defaults to true.
If the resource is only temporarily not available, add a
'Retry-After' response header in the body of the method.
=item C
Is the client or request authorized?
Parameter C<$authorization_header> is the contents of the
'Authorization' header sent by the client, if present.
Returning anything other than 1 will result in a
'401 Unauthorized' response. If a string is returned, it
will be used as the value in the 'WWW-Authenticate'
response header, which can also be set manually.
Defaults to true.
=item C
Is the request or client forbidden?
Returning a true value will result in a '403 Forbidden' response.
Defaults to false.
=item C
If the resource accepts POST requests to nonexistent resources,
then this should return true.
Defaults to false.
=item C
If the request is malformed, this should return true, which will
result in a '400 Malformed Request' response.
Defaults to false.
=item C
If the URI is too long to be processed, this should return true,
which will result in a '414 Request URI Too Long' response.
Defaults to false.
=item C
If the 'Content-Type' on PUT or POST is unknown, this should
return false, which will result in a '415 Unsupported Media
Type' response.
The value of C<$content_type> is derived from the L object and
will therefore be an instance of the L
class.
Defaults to true.
=item C
Parameter C<$content_header> is a HASH ref of the Request
headers that begin with prefix 'Content-'. It will contain
instances of L,
L and
L based on the
headers included. See L for
details of the mappings.
If the request includes any invalid Content-* headers, this
should return false, which will result in a '501 Not
Implemented' response.
Defaults to true.
=item C
Parameter C<$length> is a number indicating the size of the
request body.
If the entity length on PUT or POST is invalid, this should
return false, which will result in a '413 Request Entity Too
Large' response.
Defaults to true.
=item C
If the OPTIONS method is supported and is used, this method
should return a HASH ref of headers that should appear in the
response.
Defaults to {}.
=item C
HTTP methods that are allowed on this resource. This must return
an ARRAY ref of strings in all capitals.
Defaults to C<['GET','HEAD']>.
=item C
HTTP methods that are known to the resource. Like C,
this must return an ARRAY ref of strings in all capitals. One could
override this callback to allow additional methods, e.g. WebDAV.
Default includes all standard HTTP methods, C<['GET', 'HEAD', 'POST',
'PUT', 'DELETE', 'TRACE', 'CONNECT', 'OPTIONS']>.
=item C
This method is called when a DELETE request should be enacted,
and should return true if the deletion succeeded.
Defaults to false.
=item C
This method is called after a successful call to C
and should return false if the deletion was accepted but cannot yet
be guaranteed to have finished.
Defaults to true.
=item C
If POST requests should be treated as a request to put content
into a (potentially new) resource as opposed to a generic
submission for processing, then this method should return
true. If it does return true, then C will be called
and the rest of the request will be treated much like a PUT to
the path returned by that call.
Default is false.
=item C
This will be called on a POST request if post_is_create? returns
true. The path returned should be a valid URI part following the
dispatcher prefix.
=item C
This changes the behavior of C so that it will fire
I the content handler has processed the request body. This
allows the creation of paths that are more tightly tied to the
newly created entity.
Default is false.
=item C
This will be called after C but before setting the
Location response header, and is used to determine the root
URI of the new resource.
Default is nil, which uses the URI of the request as the base.
=item C
If post_is_create? returns false, then this will be called to
process any POST request. If it succeeds, it should return true.
=item C
This should return an ARRAY of HASH ref pairs where the key is the
name of the media type and the value is a CODE ref (or name of a
method) which can provide a resource representation in that media
type.
For example, if a client request includes an 'Accept' header with
a value that does not appear as a first element in any of the return
pairs, then a '406 Not Acceptable' will be sent.
The order of HASH ref pairs in the ARRAY is important. If no specific content
type is requested (the client does not send an C header) then the
first content type in the ARRAY will be used as the default.
Default is an empty ARRAY ref.
=item C
Similarly to content_types_provided, this should return an ARRAY
of mediatype/handler pairs, except that it is for incoming
resource representations -- for example, PUT requests. Handler
functions usually want to use C<< $request->body >> to access the
incoming entity.
=item C
This specifies the charsets that your resource support. Returning a value from
this method enables content negotiation based on the client's Accept-Charset
header.
The return value from this method must be an ARRAY ref. Each member of that
array can be either a string or a HASH ref pair value. If the member is a
string, it must be a valid character set name for the L
module. Web::Machine will call C on the body using this character
set if you set a body.
sub charsets_provided {
return [ qw( UTF-8 ISO-8859-1 shiftjis ) ];
}
If you return a HASHREF pair, the key must be a character set name and the
value must be a CODE ref. This CODE ref will be called I on the
resource object. It will receive a single parameter, a string to be
encoded. It is expected to return a scalar containing B, not
characters. This will be used to encode the body you provide.
sub charsets_provided {
return [
{
'UTF-8' => sub {
my $self = shift;
my $string = shift;
return make_some_bytes($string),;
},
},
{
'ISO-8859-1' => sub {
my $self = shift;
my $string = shift;
return strip_non_ascii($string),;
},
},
];
}
The character set name will be appended to the Content-Type header returned
the client.
If a client specifies the same preference for two or more character sets that
your resource provides, then Web::Machine chooses the first character set in
the returned ARRAY ref.
B Note that currently C does not support the use of
encodings when the body is returned as a CODE ref. This is a bug to be
remedied in the future.
Default is an empty list.
=item C
If the client does not provide an Accept-Charset header, this sub is called to
provide a default charset. The return value must be either a string or a
hashref consisting of a single pair, where the key is a character set name and
the value is a subroutine.
This works just like the C method, except that you can
only return a single value.
=item C
This should return a list of language tags provided by the
resource. Default is the empty Array, in which the content is
in no specific language.
=item C
This should return a HASH of encodings mapped to encoding
methods for Content-Encodings your resource wants to
provide. The encoding will be applied to the response body
automatically by C.
B Note that currently C does not support the use of
encodings when the body is returned as a CODE ref. This is a bug to be
remedied in the future.
Default includes only the 'identity' encoding.
=item C
If this method is implemented, it should return a list of
strings with header names that should be included in a given
response's Vary header. The standard content negotiation headers (Accept,
Accept-Encoding, Accept-Charset, Accept-Language) do not need to
be specified here as C will add the correct elements of
those automatically depending on resource behavior.
Default is [].
=item C
If this returns true, the client will receive a '409 Conflict'
response. This is only called for PUT requests.
Default is false.
=item C
If this returns true, then it is assumed that multiple
representations of the response are possible and a single one
cannot be automatically chosen, so a 300 Multiple Choices will
be sent instead of a 200.
Default is false.
=item C
If this resource is known to have existed previously, this
method should return true.
Default is false.
=item C
If this resource has moved to a new location permanently, this
method should return the new location as a String or URI.
Default is to return false.
=item C
If this resource has moved to a new location temporarily, this
method should return the new location as a String or URI.
Default is to return false.
=item C
This method should return the last modified date/time of the
resource which will be added as the Last-Modified header in the
response and used in negotiating conditional requests. This
should be in the form of an instance of
L.
Default is undef.
=item C
If the resource expires, this method should return the date/time
it expires. This should be in the form of an instance of
L.
Default is nil.
=item C
If this returns a value, it will be used as the value of the
ETag header and for comparison in conditional requests.
Default is undef.
=item C
This method is called just before the final response is
constructed and sent. It is passed the collected C<$metadata>
from the FSM, which may or may not have information in it.
The return value is ignored, so any effect of this method
must be by modifying the response.
=back
=head1 SUPPORT
bugs may be submitted through L.
=head1 AUTHORS
=over 4
=item *
Stevan Little
=item *
Dave Rolsky
=back
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2016 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
Web-Machine-0.17/lib/Web/Machine/FSM.pm 0000644 0001750 0001750 00000015375 12733042512 017204 0 ustar autarch autarch package Web::Machine::FSM;
# ABSTRACT: The State Machine runner
use strict;
use warnings;
our $VERSION = '0.17';
use IO::Handle::Util 'io_from_getline';
use Plack::Util;
use Try::Tiny;
use HTTP::Status qw[ is_error ];
use Web::Machine::I18N;
use Web::Machine::FSM::States qw[
start_state
is_status_code
is_new_state
get_state_name
get_state_desc
];
sub new {
my ($class, %args) = @_;
bless {
tracing => !!$args{'tracing'},
tracing_header => $args{'tracing_header'} || 'X-Web-Machine-Trace'
} => $class
}
sub tracing { (shift)->{'tracing'} }
sub tracing_header { (shift)->{'tracing_header'} }
sub run {
my ( $self, $resource ) = @_;
my $DEBUG;
if ( $ENV{WM_DEBUG} ) {
$DEBUG
= $ENV{WM_DEBUG} eq 'diag'
? sub { Test::More::diag( $_[0] ) }
: sub { warn "$_[0]\n" };
}
my $request = $resource->request;
my $response = $resource->response;
my $metadata = {};
$request->env->{'web.machine.context'} = $metadata;
my @trace;
my $tracing = $self->tracing;
my $state = start_state;
try {
while (1) {
$DEBUG->( 'entering '
. get_state_name($state) . ' ('
. get_state_desc($state)
. ')' )
if $DEBUG;
push @trace => get_state_name( $state ) if $tracing;
my $result = $state->( $resource, $request, $response, $metadata );
if ( ! ref $result ) {
# TODO:
# We should be I18N this
# specific error
# - SL
$DEBUG->( '! ERROR with ' . ( $result || 'undef' ) )
if $DEBUG;
$response->status( 500 );
$response->header( 'Content-Type' => 'text/plain' );
$response->body( [ "Got bad state: " . ($result || 'undef') ] );
last;
}
elsif ( is_status_code( $result ) ) {
$DEBUG->( '.. terminating with ' . ${$result} ) if $DEBUG;
$response->status( $$result );
if ( is_error( $$result ) && !$response->body ) {
# NOTE:
# this will default to en, however I
# am not really confident that this
# will end up being sufficient.
# - SL
my $lang = Web::Machine::I18N->get_handle( $metadata->{'Language'} || 'en' )
or die "Could not get language handle for " . $metadata->{'Language'};
$response->header( 'Content-Type' => 'text/plain' );
$response->body([ $lang->maketext( $$result ) ]);
}
if ($DEBUG) {
require Data::Dumper;
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Indent = 1;
local $Data::Dumper::Useqq = 1;
local $Data::Dumper::Deparse = 1;
local $Data::Dumper::Quotekeys = 0;
local $Data::Dumper::Sortkeys = 1;
$DEBUG->( Data::Dumper::Dumper( $request->env ) );
$DEBUG->( Data::Dumper::Dumper( $response->finalize ) );
}
last;
}
elsif ( is_new_state( $result ) ) {
$DEBUG->( '-> transitioning to ' . get_state_name($result) )
if $DEBUG;
$state = $result;
}
}
} catch {
# TODO:
# We should be I18N the errors
# - SL
$DEBUG->($_) if $DEBUG;
if ( $request->logger ) {
$request->logger->( { level => 'error', message => $_ } );
}
$response->status( 500 );
# NOTE:
# this way you can handle the
# exception if you like via
# the finish_request call below
# - SL
$metadata->{'exception'} = $_;
};
$self->filter_response( $resource )
unless $request->env->{'web.machine.streaming_push'};
try {
$resource->finish_request( $metadata );
}
catch {
$DEBUG->($_) if $DEBUG;
if ( $request->logger ) {
$request->logger->( { level => 'error', message => $_ } );
}
$response->status( 500 );
};
$response->header( $self->tracing_header, (join ',' => @trace) )
if $tracing;
$response;
}
sub filter_response {
my $self = shift;
my ($resource) = @_;
my $response = $resource->response;
my $filters = $resource->request->env->{'web.machine.content_filters'};
# XXX patch Plack::Response to make _body not private?
my $body = $response->_body;
for my $filter (@$filters) {
if (ref($body) eq 'ARRAY') {
$response->body( [ map { $filter->($_) } @$body ] );
$body = $response->body;
}
else {
my $old_body = $body;
$body = io_from_getline sub { $filter->($old_body->getline) };
$response->body($body);
}
}
if (ref($body) eq 'ARRAY'
&& !Plack::Util::status_with_no_entity_body($response->status)) {
$response->header(
'Content-Length' => Plack::Util::content_length($body)
);
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Web::Machine::FSM - The State Machine runner
=head1 VERSION
version 0.17
=head1 SYNOPSIS
use Web::Machine::FSM;
=head1 DESCRIPTION
This is the heart of the L, this is the thing
which runs the state machine whose states are contained in the
L module.
=for Pod::Coverage filter_response
=head1 METHODS
=over 4
=item C
This accepts two C<%params>, the first is a boolean to
indicate if you should turn on tracing or not, and the second
is optional name of the HTTP header in which to place the
tracing information.
=item C
Are we tracing or not?
=item C
Accessor for the HTTP header name to store tracing data in.
This default to C.
=item C
Given a L instance, this will execute
the state machine.
=back
=head1 SEE ALSO
=over 4
=item L
=back
=head1 SUPPORT
bugs may be submitted through L.
=head1 AUTHORS
=over 4
=item *
Stevan Little
=item *
Dave Rolsky
=back
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2016 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
Web-Machine-0.17/lib/Web/Machine/I18N.pm 0000644 0001750 0001750 00000001672 12733042512 017231 0 ustar autarch autarch package Web::Machine::I18N;
# ABSTRACT: The I18N support for HTTP information
use strict;
use warnings;
use parent 'Locale::Maketext';
our $VERSION = '0.17';
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Web::Machine::I18N - The I18N support for HTTP information
=head1 VERSION
version 0.17
=head1 SYNOPSIS
use Web::Machine::I18N;
=head1 DESCRIPTION
This is basic support for internationalization of HTTP
information. Currently it just provides response bodies
for HTTP errors.
=head1 SUPPORT
bugs may be submitted through L.
=head1 AUTHORS
=over 4
=item *
Stevan Little
=item *
Dave Rolsky
=back
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2016 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
Web-Machine-0.17/lib/Web/Machine/I18N/ 0000775 0001750 0001750 00000000000 12733042512 016667 5 ustar autarch autarch Web-Machine-0.17/lib/Web/Machine/I18N/en.pm 0000644 0001750 0001750 00000004202 12733042512 017623 0 ustar autarch autarch package Web::Machine::I18N::en;
# ABSTRACT: The English support for I18N-ed HTTP information
use strict;
use warnings;
use parent 'Web::Machine::I18N';
our $VERSION = '0.17';
our %Lexicon = (
100 => 'Continue',
101 => 'Switching Protocols',
200 => 'OK',
201 => 'Created',
202 => 'Accepted',
203 => 'Non-Authoritative Information',
204 => 'No Content',
205 => 'Reset Content',
206 => 'Partial Content',
300 => 'Multiple Choices',
301 => 'Moved Permanently',
302 => 'Found',
303 => 'See Other',
304 => 'Not Modified',
305 => 'Use Proxy',
307 => 'Temporary Redirect',
400 => 'Bad Request',
401 => 'Unauthorized',
402 => 'Payment Required',
403 => 'Forbidden',
404 => 'Not Found',
405 => 'Method Not Allowed',
406 => 'Not Acceptable',
407 => 'Proxy Authentication Required',
408 => 'Request Time-out',
409 => 'Conflict',
410 => 'Gone',
411 => 'Length Required',
412 => 'Precondition Failed',
413 => 'Request Entity Too Large',
414 => 'Request-URI Too Large',
415 => 'Unsupported Media Type',
416 => 'Requested range not satisfiable',
417 => 'Expectation Failed',
418 => "I'm a teapot",
500 => 'Internal Server Error',
501 => 'Not Implemented',
502 => 'Bad Gateway',
503 => 'Service Unavailable',
504 => 'Gateway Time-out',
505 => 'HTTP Version not supported',
);
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Web::Machine::I18N::en - The English support for I18N-ed HTTP information
=head1 VERSION
version 0.17
=head1 SYNOPSIS
use Web::Machine::I18N;
my $lang = Web::Machine::I18N->get_handle('en');
=head1 SEE ALSO
L
=head1 SUPPORT
bugs may be submitted through L.
=head1 AUTHORS
=over 4
=item *
Stevan Little
=item *
Dave Rolsky
=back
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2016 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
Web-Machine-0.17/lib/Web/Machine/FSM/ 0000775 0001750 0001750 00000000000 12733042512 016635 5 ustar autarch autarch Web-Machine-0.17/lib/Web/Machine/FSM/States.pm 0000644 0001750 0001750 00000052652 12733042512 020446 0 ustar autarch autarch package Web::Machine::FSM::States;
# ABSTRACT: The States for Web Machine
use strict;
use warnings;
our $VERSION = '0.17';
use B ();
use Hash::MultiValue;
use Carp qw[ confess ];
use Web::Machine::Util qw[
first
pair_key
pair_value
create_header
];
use Web::Machine::Util::BodyEncoding qw[
encode_body_if_set
encode_body
];
use Web::Machine::Util::ContentNegotiation qw[
choose_media_type
match_acceptable_media_type
choose_language
choose_charset
choose_encoding
];
use Sub::Exporter -setup => {
exports => [qw[
start_state
is_status_code
is_new_state
get_state_name
get_state_desc
]]
};
my %STATE_DESC;
# my exports ...
sub start_state { \&b13 }
sub is_status_code { ref $_[0] eq 'SCALAR' }
sub is_new_state { ref $_[0] eq 'CODE' }
sub get_state_name { B::svref_2object( shift )->GV->NAME }
sub get_state_desc { $STATE_DESC{ ref $_[0] ? get_state_name( shift ) : shift } }
# some utilities ...
sub _unquote_header {
my $value = shift;
if ( $value =~ /^"(.*)"$/ ) {
return $1;
}
return $value;
}
sub _ensure_quoted_header {
my $value = shift;
return $value if $value =~ /^"(.*)"$/;
return '"' . $value . '"';
}
sub _get_acceptable_content_type_handler {
my ($resource, $request) = @_;
my $acceptable = match_acceptable_media_type(
($request->header('Content-Type') || 'application/octet-stream'),
$resource->content_types_accepted
);
return \415 unless $acceptable;
return pair_value( $acceptable );
}
sub _add_caching_headers {
my ($resource, $response) = @_;
if ( my $etag = $resource->generate_etag ) {
$response->header( 'Etag' => _ensure_quoted_header( $etag ) );
}
if ( my $expires = $resource->expires ) {
$response->header( 'Expires' => $expires );
}
if ( my $modified = $resource->last_modified ) {
$response->header( 'Last-Modified' => $modified );
}
}
sub _handle_304 {
my ($resource, $response) = @_;
$response->headers->remove_header('Content-Type');
$response->headers->remove_header('Content-Encoding');
$response->headers->remove_header('Content-Language');
_add_caching_headers($resource, $response);
return \304;
}
sub _is_redirect {
my ($response) = @_;
# NOTE:
# this makes a guess that the user has
# told the Plack::Response that they
# want to redirect. We do this based
# on the fact that the ->redirect method
# will set the status, while in almost all
# other cases the status of the response
# will not be set yet.
# - SL
return 1 if $response->status;
return;
}
sub _metadata {
my ($request) = @_;
return $request->env->{'web.machine.context'};
}
## States
$STATE_DESC{'b13'} = 'service_available';
sub b13 {
my ($resource, $request, $response) = @_;
$resource->service_available ? \&b12 : \503;
}
$STATE_DESC{'b12'} = 'known_method';
sub b12 {
my ($resource, $request, $response) = @_;
my $method = $request->method;
(grep { $method eq $_ } @{ $resource->known_methods }) ? \&b11 : \501;
}
$STATE_DESC{'b11'} = 'uri_too_long';
sub b11 {
my ($resource, $request, $response) = @_;
$resource->uri_too_long( $request->uri ) ? \414 : \&b10;
}
$STATE_DESC{'b10'} = 'method_allowed';
sub b10 {
my ($resource, $request, $response) = @_;
my $method = $request->method;
my @allowed_methods = @{ $resource->allowed_methods };
return \&b9 if grep { $method eq $_ } @allowed_methods;
$response->header('Allow' => join ", " => @allowed_methods );
return \405;
}
$STATE_DESC{'b9'} = 'malformed_request';
sub b9 {
my ($resource, $request, $response) = @_;
$resource->malformed_request ? \400 : \&b8;
}
$STATE_DESC{'b8'} = 'is_authorized';
sub b8 {
my ($resource, $request, $response) = @_;
my $result = $resource->is_authorized( $request->header('Authorization') );
# if we get back a status, then use it
if ( is_status_code( $result ) ) {
return $result;
}
# if we just get back true, then
# move onto the next state
elsif ( defined $result && "$result" eq "1" ) {
return \&b7
}
# anything else will either be
# a WWW-Authenticate header or
# a simple false value
else {
if ( $result ) {
$response->header( 'WWW-Authenticate' => $result );
}
return \401;
}
}
$STATE_DESC{'b7'} = 'forbidden';
sub b7 {
my ($resource, $request, $response) = @_;
$resource->forbidden ? \403 : \&b6;
}
$STATE_DESC{'b6'} = 'content_headers_okay';
sub b6 {
my ($resource, $request, $response) = @_;
# FIX-ME
# there is a better way to do this,
# also, HTTP::Headers will usually
# group things into arrays, so we
# can either avoid or better take
# advantage of Hash::MultiValue.
# But we are almost certainly not
# handling that case properly maybe.
my $content_headers = Hash::MultiValue->new;
$request->headers->scan(sub {
my ($name, $value) = @_;
$content_headers->add( $name, $value ) if (lc $name) =~ /^content-/;
});
$resource->valid_content_headers( $content_headers ) ? \&b5 : \501;
}
$STATE_DESC{'b5'} = 'known_content_type';
sub b5 {
my ($resource, $request, $response) = @_;
$resource->known_content_type( $request->header('Content-Type') ) ? \&b4 : \415;
}
$STATE_DESC{'b4'} = 'request_entity_too_large';
sub b4 {
my ($resource, $request, $response) = @_;
$resource->valid_entity_length( $request->content_length ) ? \&b3 : \413;
}
$STATE_DESC{'b3'} = 'method_is_options';
sub b3 {
my ($resource, $request, $response) = @_;
if ( $request->method eq 'OPTIONS' ) {
$response->headers( $resource->options );
return \200;
}
return \&c3
}
$STATE_DESC{'c3'} = 'accept_header_exists';
sub c3 {
my ($resource, $request, $response) = @_;
my $metadata = _metadata($request);
if ( !$request->header('Accept') ) {
$metadata->{'Content-Type'} = create_header( MediaType => (
pair_key( $resource->content_types_provided->[0] )
));
return \&d4
}
return \&c4;
}
$STATE_DESC{'c4'} = 'acceptable_media_type_available';
sub c4 {
my ($resource, $request, $response) = @_;
my $metadata = _metadata($request);
my @types = map { pair_key( $_ ) } @{ $resource->content_types_provided };
if ( my $chosen_type = choose_media_type( \@types, $request->header('Accept') ) ) {
$metadata->{'Content-Type'} = $chosen_type;
return \&d4;
}
return \406;
}
$STATE_DESC{'d4'} = 'accept_language_header_exists';
sub d4 {
my ($resource, $request, $response) = @_;
(not $request->header('Accept-Language')) ? \&e5 : \&d5;
}
$STATE_DESC{'d5'} = 'accept_language_choice_available';
sub d5 {
my ($resource, $request, $response) = @_;
my $metadata = _metadata($request);
if ( my $language = choose_language( $resource->languages_provided, $request->header('Accept-Language') ) ) {
$metadata->{'Language'} = $language;
# handle the short circuit here ...
$response->header( 'Content-Language' => $language ) if "$language" ne "1";
return \&e5;
}
return \406;
}
$STATE_DESC{'e5'} = 'accept_charset_exists';
sub e5 {
my ($resource, $request, $response) = @_;
(not $request->header('Accept-Charset')) ? \&f6 : \&e6;
}
$STATE_DESC{'e6'} = 'accept_charset_choice_available';
sub e6 {
my ($resource, $request, $response) = @_;
my $metadata = _metadata($request);
if ( my $charset = choose_charset( $resource->charsets_provided, $request->header('Accept-Charset') ) ) {
# handle the short circuit here ...
$metadata->{'Charset'} = $charset if "$charset" ne "1";
return \&f6;
}
return \406;
}
$STATE_DESC{'f6'} = 'accept_encoding_exists';
# (also, set content-type header here, now that charset is chosen)
sub f6 {
my ($resource, $request, $response) = @_;
my $metadata = _metadata($request);
# If the client doesn't provide an Accept-Charset header we should just
# encode with the default.
if ( $resource->default_charset && !$request->header('Accept-Charset') ) {
my $default = $resource->default_charset;
$metadata->{'Charset'} = ref $default ? pair_key($default) : $default;
}
if ( my $charset = $metadata->{'Charset'} ) {
# Add the charset to the content type now ...
$metadata->{'Content-Type'}->add_param( 'charset' => $charset );
}
# put the content type in the header now ...
$response->header( 'Content-Type' => $metadata->{'Content-Type'}->as_string );
if ( $request->header('Accept-Encoding') ) {
return \&f7
}
else {
if ( my $encoding = choose_encoding( $resource->encodings_provided, "identity;q=1.0,*;q=0.5" ) ) {
$response->header( 'Content-Encoding' => $encoding ) unless $encoding eq 'identity';
$metadata->{'Content-Encoding'} = $encoding;
return \&g7;
}
else {
return \406;
}
}
}
$STATE_DESC{'f7'} = 'accept_encoding_choice_available';
sub f7 {
my ($resource, $request, $response) = @_;
my $metadata = _metadata($request);
if ( my $encoding = choose_encoding( $resource->encodings_provided, $request->header('Accept-Encoding') ) ) {
$response->header( 'Content-Encoding' => $encoding ) unless $encoding eq 'identity';
$metadata->{'Content-Encoding'} = $encoding;
return \&g7;
}
return \406;
}
$STATE_DESC{'g7'} = 'resource_exists';
sub g7 {
my ($resource, $request, $response) = @_;
# NOTE:
# set Vary header here since we are
# done with content negotiation
# - SL
my @variances = @{ $resource->variances };
push @variances => 'Accept' if scalar @{ $resource->content_types_provided } > 1;
push @variances => 'Accept-Encoding' if scalar keys %{ $resource->encodings_provided } > 1;
push @variances => 'Accept-Charset' if defined $resource->charsets_provided && scalar @{ $resource->charsets_provided } > 1;
push @variances => 'Accept-Language' if scalar @{ $resource->languages_provided } > 1;
$response->header( 'Vary' => join ', ' => @variances ) if @variances;
$resource->resource_exists ? \&g8 : \&h7;
}
$STATE_DESC{'g8'} = 'if_match_exists';
sub g8 {
my ($resource, $request, $response) = @_;
$request->header('If-Match') ? \&g9 : \&h10;
}
$STATE_DESC{'g9'} = 'if_match_is_wildcard';
sub g9 {
my ($resource, $request, $response) = @_;
_unquote_header( $request->header('If-Match') ) eq "*" ? \&h10 : \&g11;
}
$STATE_DESC{'g11'} = 'etag_in_if_match_list';
sub g11 {
my ($resource, $request, $response) = @_;
my @etags = map { _unquote_header( $_ ) } split /\s*\,\s*/ => $request->header('If-Match');
my $etag = $resource->generate_etag;
(grep { $etag eq $_ } @etags) ? \&h10 : \412;
}
$STATE_DESC{'h7'} = 'if_match_exists_and_if_match_is_wildcard';
sub h7 {
my ($resource, $request, $response) = @_;
($request->header('If-Match') && _unquote_header( $request->header('If-Match') ) eq "*") ? \412 : \&i7;
}
$STATE_DESC{'h10'} = 'if_unmodified_since_exists';
sub h10 {
my ($resource, $request, $response) = @_;
$request->header('If-Unmodified-Since') ? \&h11 : \&i12;
}
$STATE_DESC{'h11'} = 'if_unmodified_since_is_valid_date';
sub h11 {
my ($resource, $request, $response) = @_;
my $metadata = _metadata($request);
if ( my $date = $request->header('If-Unmodified-Since') ) {
$metadata->{'If-Unmodified-Since'} = $date;
return \&h12;
}
return \&i12;
}
$STATE_DESC{'h12'} = 'last_modified_is_greater_than_if_unmodified_since';
sub h12 {
my ($resource, $request, $response) = @_;
my $metadata = _metadata($request);
defined $resource->last_modified
&&
($resource->last_modified->epoch > $metadata->{'If-Unmodified-Since'}->epoch)
? \412 : \&i12;
}
$STATE_DESC{'i4'} = 'moved_permanently';
sub i4 {
my ($resource, $request, $response) = @_;
if ( my $uri = $resource->moved_permanently ) {
if ( is_status_code( $uri ) ) {
return $uri;
}
$response->header('Location' => $uri );
return \301;
}
return \&p3;
}
$STATE_DESC{'i7'} = 'method_is_put';
sub i7 {
my ($resource, $request, $response) = @_;
$request->method eq 'PUT' ? \&i4 : \&k7
}
$STATE_DESC{'i12'} = 'if_none_match_exists';
sub i12 {
my ($resource, $request, $response) = @_;
$request->header('If-None-Match') ? \&i13 : \&l13
}
$STATE_DESC{'i13'} = 'if_none_match_is_wildcard';
sub i13 {
my ($resource, $request, $response) = @_;
$request->header('If-None-Match') eq "*" ? \&j18 : \&k13
}
$STATE_DESC{'j18'} = 'method_is_get_or_head';
sub j18 {
my ($resource, $request, $response) = @_;
$request->method eq 'GET' || $request->method eq 'HEAD'
? _handle_304( $resource, $response )
: \412
}
$STATE_DESC{'k5'} = 'moved_permanently';
sub k5 {
my ($resource, $request, $response) = @_;
if ( my $uri = $resource->moved_permanently ) {
if ( is_status_code( $uri ) ) {
return $uri;
}
$response->header('Location' => $uri );
return \301;
}
return \&l5;
}
$STATE_DESC{'k7'} = 'previously_existed';
sub k7 {
my ($resource, $request, $response) = @_;
$resource->previously_existed ? \&k5 : \&l7;
}
$STATE_DESC{'k13'} = 'etag_in_if_none_match';
sub k13 {
my ($resource, $request, $response) = @_;
my @etags = map { _unquote_header( $_ ) } split /\s*\,\s*/ => $request->header('If-None-Match');
my $etag = $resource->generate_etag;
$etag && (grep { $etag eq $_ } @etags) ? \&j18 : \&l13;
}
$STATE_DESC{'l5'} = 'moved_temporarily';
sub l5 {
my ($resource, $request, $response) = @_;
if ( my $uri = $resource->moved_temporarily ) {
if ( is_status_code( $uri ) ) {
return $uri;
}
$response->header('Location' => $uri );
return \307;
}
return \&m5;
}
$STATE_DESC{'l7'} = 'method_is_post';
sub l7 {
my ($resource, $request, $response) = @_;
$request->method eq 'POST' ? \&m7 : \404
}
$STATE_DESC{'l13'} = 'if_modified_since_exists';
sub l13 {
my ($resource, $request, $response) = @_;
$request->header('If-Modified-Since') ? \&l14 : \&m16
}
$STATE_DESC{'l14'} = 'if_modified_since_is_valid_date';
sub l14 {
my ($resource, $request, $response) = @_;
my $metadata = _metadata($request);
if ( my $date = $request->header('If-Modified-Since') ) {
$metadata->{'If-Modified-Since'} = $date;
return \&l15;
}
return \&m16;
}
$STATE_DESC{'l15'} = 'if_modified_since_greater_than_now';
sub l15 {
my ($resource, $request, $response) = @_;
my $metadata = _metadata($request);
($metadata->{'If-Modified-Since'}->epoch > (scalar time)) ? \&m16 : \&l17;
}
$STATE_DESC{'l17'} = 'last_modified_is_greater_than_if_modified_since';
sub l17 {
my ($resource, $request, $response) = @_;
my $metadata = _metadata($request);
defined $resource->last_modified
&&
($resource->last_modified->epoch > $metadata->{'If-Modified-Since'}->epoch)
? \&m16 : _handle_304( $resource, $response );
}
$STATE_DESC{'m5'} = 'method_is_post';
sub m5 {
my ($resource, $request, $response) = @_;
$request->method eq 'POST' ? \&n5 : \410
}
$STATE_DESC{'m7'} = 'allow_post_to_missing_resource';
sub m7 {
my ($resource, $request, $response) = @_;
$resource->allow_missing_post ? \&n11 : \404
}
$STATE_DESC{'m16'} = 'method_is_delete';
sub m16 {
my ($resource, $request, $response) = @_;
$request->method eq 'DELETE' ? \&m20 : \&n16
}
$STATE_DESC{'m20'} = 'delete_enacted_immediately';
sub m20 {
my ($resource, $request, $response) = @_;
$resource->delete_resource ? \&m20b : \500
}
$STATE_DESC{'m20b'} = 'did_delete_complete';
sub m20b {
my ($resource, $request, $response) = @_;
$resource->delete_completed ? \&o20 : \202
}
$STATE_DESC{'n5'} = 'allow_post_to_missing_resource';
sub n5 {
my ($resource, $request, $response) = @_;
$resource->allow_missing_post ? \&n11 : \410
}
sub _n11_create_path {
my ($resource, $request, $response) = @_;
my $uri = $resource->create_path;
confess "Create Path Nil" unless $uri;
my $base_uri = $resource->base_uri || $request->base;
# do a little cleanup
$base_uri =~ s!/$!! if $uri =~ m!^/!;
$base_uri .= '/' if $uri !~ m!^/! && $base_uri !~ m!/$!;
my $new_uri = URI->new( $base_uri . $uri )->canonical;
# NOTE:
# the ruby and JS versions will set the path_info
# for the request object here, but since our requests
# are immutable, we don't allow that. I don't see
# where this ends up being useful so I am going to
# skip it and not bother.
# - SL
$response->header( 'Location' => $new_uri->path_query );
}
$STATE_DESC{'n11'} = 'redirect';
sub n11 {
my ($resource, $request, $response) = @_;
if ( $resource->post_is_create ) {
# the default behavior as specified by
# the Erlang/Ruby versions, however this
# is a very unpopular "feature" so we are
# allowing it to be bypassed here.
_n11_create_path( $resource, $request, $response )
if not $resource->create_path_after_handler;
my $handler = _get_acceptable_content_type_handler( $resource, $request );
return $handler if is_status_code( $handler );
my $result = $resource->$handler();
return $result if is_status_code( $result );
_n11_create_path( $resource, $request, $response )
if $resource->create_path_after_handler;
}
else {
my $result = $resource->process_post;
if ( $result ) {
return $result if is_status_code( $result );
encode_body_if_set( $resource, $response );
}
else {
confess "Process Post Invalid";
}
}
if ( _is_redirect( $response ) ) {
if ( $response->location ) {
return \303;
}
else {
confess "Bad Redirect"
}
}
return \&p11;
}
$STATE_DESC{'n16'} = 'method_is_post';
sub n16 {
my ($resource, $request, $response) = @_;
$request->method eq 'POST' ? \&n11 : \&o16
}
$STATE_DESC{'o14'} = 'in_conflict';
sub o14 {
my ($resource, $request, $response) = @_;
return \409 if $resource->is_conflict;
my $handler = _get_acceptable_content_type_handler( $resource, $request );
return $handler if is_status_code( $handler );
my $result = $resource->$handler();
return $result if is_status_code( $result );
return \&p11;
}
$STATE_DESC{'o16'} = 'method_is_put';
sub o16 {
my ($resource, $request, $response) = @_;
$request->method eq 'PUT' ? \&o14 : \&o18;
}
$STATE_DESC{'o18'} = 'multiple_representations';
sub o18 {
my ($resource, $request, $response) = @_;
my $metadata = _metadata($request);
if ( $request->method eq 'GET' || $request->method eq 'HEAD' ) {
_add_caching_headers( $resource, $response );
my $content_type = $metadata->{'Content-Type'};
my $match = first {
my $ct = create_header( MediaType => pair_key( $_ ) );
$content_type->match( $ct )
} @{ $resource->content_types_provided };
my $handler = pair_value( $match );
my $result = $resource->$handler();
return $result if is_status_code( $result );
unless($request->method eq 'HEAD') {
if (ref($result) eq 'CODE') {
$request->env->{'web.machine.streaming_push'} = $result;
}
else {
$response->body( $result );
}
encode_body( $resource, $response );
}
return \&o18b;
}
else {
return \&o18b;
}
}
$STATE_DESC{'o18b'} = 'multiple_choices';
sub o18b {
my ($resource, $request, $response) = @_;
$resource->multiple_choices ? \300 : \200;
}
$STATE_DESC{'o20'} = 'response_body_includes_entity';
sub o20 {
my ($resource, $request, $response) = @_;
$response->body ? \&o18 : \204;
}
$STATE_DESC{'p3'} = 'in_conflict';
sub p3 {
my ($resource, $request, $response) = @_;
return \409 if $resource->is_conflict;
my $handler = _get_acceptable_content_type_handler( $resource, $request );
return $handler if is_status_code( $handler );
my $result = $resource->$handler();
return $result if is_status_code( $result );
return \&p11;
}
$STATE_DESC{'p11'} = 'new_resource';
sub p11 {
my ($resource, $request, $response) = @_;
(not $response->header('Location')) ? \&o20 : \201
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Web::Machine::FSM::States - The States for Web Machine
=head1 VERSION
version 0.17
=head1 SYNOPSIS
use Web::Machine::FSM::States;
=head1 DESCRIPTION
For now I am going to say that there is nothing to see here and that
if you really want to know what is going on, you should read the
source (and consult the diagram linked to below). Eventually I might
try and document this, but for now the task is simply too daunting.
=head1 SEE ALSO
=over 4
=item L
=back
=head1 SUPPORT
bugs may be submitted through L.
=head1 AUTHORS
=over 4
=item *
Stevan Little
=item *
Dave Rolsky
=back
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2016 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
Web-Machine-0.17/lib/Web/Machine/Util/ 0000775 0001750 0001750 00000000000 12733042512 017125 5 ustar autarch autarch Web-Machine-0.17/lib/Web/Machine/Util/BodyEncoding.pm 0000644 0001750 0001750 00000006000 12733042512 022021 0 ustar autarch autarch package Web::Machine::Util::BodyEncoding;
# ABSTRACT: Module to handle body encoding
use strict;
use warnings;
our $VERSION = '0.17';
use Scalar::Util qw/ weaken isweak /;
use Encode ();
use Web::Machine::Util qw[ first pair_key pair_value ];
use Sub::Exporter -setup => {
exports => [qw[
encode_body_if_set
encode_body
]]
};
sub encode_body_if_set {
my ($resource, $response) = @_;
encode_body( $resource, $response ) if $response->body;
}
sub encode_body {
my ($resource, $response) = @_;
my $metadata = $resource->request->env->{'web.machine.context'};
my $chosen_encoding = $metadata->{'Content-Encoding'};
my $encoder = $resource->encodings_provided->{ $chosen_encoding };
my $chosen_charset = $metadata->{'Charset'};
my $charsetter;
if ( $chosen_charset && $resource->charsets_provided ) {
my $match = first {
my $name = $_ && ref $_ ? pair_key($_) : $_;
$name && $name eq $chosen_charset;
}
@{ $resource->charsets_provided };
$charsetter
= ref $match
? pair_value($match)
: sub { Encode::encode( $match, $_[1] ) };
}
$charsetter ||= sub { $_[1] };
push @{ $resource->request->env->{'web.machine.content_filters'} ||= [] },
sub {
my $chunk = shift;
weaken $resource unless isweak $resource;
return unless defined $chunk;
return $resource->$encoder($resource->$charsetter($chunk));
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Web::Machine::Util::BodyEncoding - Module to handle body encoding
=head1 VERSION
version 0.17
=head1 SYNOPSIS
use Web::Machine::Util::BodyEncoding;
=head1 DESCRIPTION
This handles the body encoding.
=head1 FUNCTIONS
=over 4
=item C
If the C<$response> has a body, this will call C.
=item C
This will find the right encoding (from the 'Content-Encoding' entry
in the C<$metadata> HASH ref) and the right charset (from the 'Charset'
entry in the C<$metadata> HASH ref), then find the right transformers
in the C<$resource>. After that it will attempt to convert the charset
and encode the body of the C<$response>. Once completed it will set
the C header in the response as well.
B Note that currently this subroutine doesn't do anything when the
body is returned as a CODE ref. This is a bug to be remedied in the future.
=back
=head1 SUPPORT
bugs may be submitted through L.
=head1 AUTHORS
=over 4
=item *
Stevan Little
=item *
Dave Rolsky
=back
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2016 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
Web-Machine-0.17/lib/Web/Machine/Util/ContentNegotiation.pm 0000644 0001750 0001750 00000006045 12733042512 023301 0 ustar autarch autarch package Web::Machine::Util::ContentNegotiation;
# ABSTRACT: Module to handle content negotiation
use strict;
use warnings;
our $VERSION = '0.17';
use Scalar::Util qw[ blessed ];
use Web::Machine::Util qw[
first
pair_key
];
use Sub::Exporter -setup => {
exports => [qw[
choose_media_type
match_acceptable_media_type
choose_language
choose_charset
choose_encoding
]]
};
my $ACTIONPACK = Web::Machine::Util::get_action_pack;
my $NEGOTIATOR = $ACTIONPACK->get_content_negotiator;
sub choose_media_type {
my ($provided, $header) = @_;
$NEGOTIATOR->choose_media_type( $provided, $header );
}
sub match_acceptable_media_type {
my ($to_match, $accepted) = @_;
my $content_type = blessed $to_match ? $to_match : $ACTIONPACK->create( 'MediaType' => $to_match );
if ( my $acceptable = first { $content_type->match( pair_key( $_ ) ) } @$accepted ) {
return $acceptable;
}
return;
}
sub choose_language {
my ($provided, $header) = @_;
return 1 if scalar @$provided == 0;
$NEGOTIATOR->choose_language( $provided, $header );
}
sub choose_charset {
my ($provided, $header) = @_;
return 1 if scalar @$provided == 0;
$NEGOTIATOR->choose_charset( [ map { ref $_ ? pair_key( $_ ) : $_ } @$provided ], $header );
}
sub choose_encoding {
my ($provided, $header) = @_;
$NEGOTIATOR->choose_encoding( [ keys %$provided ], $header );
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Web::Machine::Util::ContentNegotiation - Module to handle content negotiation
=head1 VERSION
version 0.17
=head1 SYNOPSIS
use Web::Machine::Util::ContentNegotiation;
=head1 DESCRIPTION
This module provides a set of functions used in content negotiation.
=head1 FUNCTIONS
=over 4
=item C
Given an ARRAY ref of media type strings and an HTTP header, this will
return the matching L instance.
=item C
Given a media type string to match and an ARRAY ref of media type objects,
this will return the first matching one.
=item C
Given a list of language codes and an HTTP header value, this will attempt
to negotiate the best language match.
=item C
Given a list of charset name and an HTTP header value, this will attempt
to negotiate the best charset match.
=item C
Given a list of encoding name and an HTTP header value, this will attempt
to negotiate the best encoding match.
=back
=head1 SUPPORT
bugs may be submitted through L.
=head1 AUTHORS
=over 4
=item *
Stevan Little
=item *
Dave Rolsky
=back
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2016 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
Web-Machine-0.17/lib/Web/Machine/Manual.pod 0000644 0001750 0001750 00000007434 12733042512 020137 0 ustar autarch autarch package Web::Machine::Manual;
#ABSTRACT: Learn how to use Web::Machine
__END__
=pod
=encoding UTF-8
=head1 NAME
Web::Machine::Manual - Learn how to use Web::Machine
=head1 VERSION
version 0.17
=head1 Web::Machine IN A NUTSHELL
The basic idea behind C is that the handling of a web request
is implemented as a state machine. If you're not familiar with state machines,
think of a flowchart. We look at the request and the resource we provide and
ask questions about them. Is our service available? Is this a GET, POST, PUT,
etc.? Does the request ask for a content type our resource provides?
The result of each question leads us to the next state (or flowchart
box). Eventually we reach a point where we have a response for the
client. Since this is all built on top of L and
L, the response consists of a status code, some
headers, and an optional body.
The best way to understand the full request/response cycle is to look at the
original L. Each diamond in that
diagram corresponds to a method that your L subclass
can implement. The return value from your method determines what method to call
next.
However, unlike on that diagram, we often support return values beyond simple
true/false values for methods. The L documentation
describes what each method can return.
=head1 Web::Machine and Plack
C is built on top of Plack and follows the
L spec. You can mix C applications
with other Plack applications using standard Plack tools like L.
=head2 Web::Machine and Plack Middleware
Since C implements the complete request and response
cycle, some L middleware is not really needed with C. For
example, it wouldn't make sense to use something like
C with C. C implements
the full content negotiation process, so if you want to handle requests for
C it probably makes more sense to do this in your resources. The
benefit of doing so is that with C you can easily ensure that
you return a proper C<406 Not Acceptable> status for content types you
I handle.
There are still many pieces of L middleware that are useful with
C, such as logging middleware, debugging/linting middleware,
etc.
That all said, C won't break if you use an inappropriate
middleware; you'll just lose some of the benefits you get from implementing
things the C way.
=head2 Bodies Must be Bytes
The PSGI spec requires that the body you return contain bytes, not Perl
characters. In other words, strings you return must be passed through
C so that Perl interprets their contents as bytes.
If your data is not binary or ASCII, your resource should make sure to provide
C and C methods. This will make sure
that C knows how to turn your response bodies into bytes.
B Note that currently C does not provide full charset
or encoding support when the body is returned as a CODE ref. This is a bug to
be remedied in the future, but currently you are responsible for making sure
this code ref returns bytes.
=head1 SUPPORT
bugs may be submitted through L.
=head1 AUTHORS
=over 4
=item *
Stevan Little
=item *
Dave Rolsky
=back
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2016 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
Web-Machine-0.17/cpanfile 0000644 0001750 0001750 00000004533 12733042512 015070 0 ustar autarch autarch requires "B" => "0";
requires "Carp" => "0";
requires "Data::Dumper" => "0";
requires "Encode" => "0";
requires "HTTP::Headers::ActionPack" => "0.07";
requires "HTTP::Status" => "0";
requires "Hash::MultiValue" => "0";
requires "IO::Handle::Util" => "0";
requires "List::Util" => "0";
requires "Locale::Maketext" => "0";
requires "Module::Runtime" => "0";
requires "Plack::Component" => "0";
requires "Plack::Request" => "0";
requires "Plack::Response" => "0";
requires "Plack::Util" => "0";
requires "Scalar::Util" => "0";
requires "Sub::Exporter" => "0";
requires "Try::Tiny" => "0";
requires "parent" => "0";
requires "strict" => "0";
requires "warnings" => "0";
on 'test' => sub {
requires "ExtUtils::MakeMaker" => "0";
requires "File::Spec" => "0";
requires "FindBin" => "0";
requires "HTTP::Message::PSGI" => "0";
requires "HTTP::Request" => "0";
requires "HTTP::Request::Common" => "0";
requires "HTTP::Response" => "0";
requires "MIME::Base64" => "0";
requires "Net::HTTP" => "0";
requires "Plack::Runner" => "0";
requires "Plack::Test" => "0";
requires "Test::FailWarnings" => "0";
requires "Test::Fatal" => "0";
requires "Test::More" => "0.96";
requires "base" => "0";
requires "lib" => "0";
requires "utf8" => "0";
};
on 'test' => sub {
recommends "CPAN::Meta" => "2.120900";
};
on 'configure' => sub {
requires "ExtUtils::MakeMaker" => "0";
};
on 'develop' => sub {
requires "Code::TidyAll::Plugin::Test::Vars" => "0.02";
requires "File::Spec" => "0";
requires "IO::Handle" => "0";
requires "IPC::Open3" => "0";
requires "JSON::XS" => "0";
requires "Path::Class" => "0";
requires "Perl::Critic" => "1.126";
requires "Perl::Tidy" => "20160302";
requires "Pod::Coverage::TrustPod" => "0";
requires "Pod::Wordlist" => "0";
requires "Test::CPAN::Changes" => "0.19";
requires "Test::CPAN::Meta::JSON" => "0.16";
requires "Test::EOL" => "0";
requires "Test::Mojibake" => "0";
requires "Test::More" => "0.96";
requires "Test::NoTabs" => "0";
requires "Test::Pod" => "1.41";
requires "Test::Pod::Coverage" => "1.08";
requires "Test::Pod::LinkCheck" => "0";
requires "Test::Portability::Files" => "0";
requires "Test::Spelling" => "0.12";
requires "Test::Synopsis" => "0";
requires "Test::Vars" => "0.009";
requires "Test::Version" => "1";
requires "blib" => "1.01";
requires "perl" => "5.006";
};
Web-Machine-0.17/perlcriticrc 0000644 0001750 0001750 00000003471 12733042512 015774 0 ustar autarch autarch severity = 3
verbose = 11
theme = core + pbp + bugs + maintenance + cosmetic + complexity + security + tests + moose
program-extensions = pl psgi t
exclude = Subroutines::ProhibitCallsToUndeclaredSubs
[BuiltinFunctions::ProhibitStringySplit]
severity = 3
[CodeLayout::RequireTrailingCommas]
severity = 3
[ControlStructures::ProhibitCStyleForLoops]
severity = 3
[InputOutput::RequireCheckedSyscalls]
functions = :builtins
exclude_functions = sleep
severity = 3
[RegularExpressions::ProhibitComplexRegexes]
max_characters = 200
[RegularExpressions::ProhibitUnusualDelimiters]
severity = 3
[Subroutines::ProhibitUnusedPrivateSubroutines]
private_name_regex = _(?!build)\w+
[TestingAndDebugging::ProhibitNoWarnings]
allow = redefine
[ValuesAndExpressions::ProhibitEmptyQuotes]
severity = 3
[ValuesAndExpressions::ProhibitInterpolationOfLiterals]
severity = 3
[ValuesAndExpressions::RequireUpperCaseHeredocTerminator]
severity = 3
[Variables::ProhibitPackageVars]
add_packages = Carp Test::Builder
[-Subroutines::RequireFinalReturn]
# This incorrectly thinks signatures are prototypes.
[-Subroutines::ProhibitSubroutinePrototypes]
[-ErrorHandling::RequireCarping]
# No need for /xsm everywhere
[-RegularExpressions::RequireDotMatchAnything]
[-RegularExpressions::RequireExtendedFormatting]
[-RegularExpressions::RequireLineBoundaryMatching]
# http://stackoverflow.com/questions/2275317/why-does-perlcritic-dislike-using-shift-to-populate-subroutine-variables
[-Subroutines::RequireArgUnpacking]
# "use v5.14" is more readable than "use 5.014"
[-ValuesAndExpressions::ProhibitVersionStrings]
# Explicitly returning undef is a _good_ thing in many cases, since it
# prevents very common errors when using a sub in list context to construct a
# hash and ending up with a missing value or key.
[-Subroutines::ProhibitExplicitReturnUndef]
Web-Machine-0.17/INSTALL 0000644 0001750 0001750 00000002172 12733042512 014412 0 ustar autarch autarch This is the Perl distribution Web-Machine.
Installing Web-Machine is straightforward.
## Installation with cpanm
If you have cpanm, you only need one line:
% cpanm Web::Machine
If it does not have permission to install modules to the current perl, cpanm
will automatically set up and install to a local::lib in your home directory.
See the local::lib documentation (https://metacpan.org/pod/local::lib) for
details on enabling it in your environment.
## Installing with the CPAN shell
Alternatively, if your CPAN shell is set up, you should just be able to do:
% cpan Web::Machine
## Manual installation
As a last resort, you can manually install it. Download the tarball, untar it,
then build it:
% perl Makefile.PL
% make && make test
Then install it:
% make install
If your perl is system-managed, you can create a local::lib in your home
directory to install modules to. For details, see the local::lib documentation:
https://metacpan.org/pod/local::lib
## Documentation
Web-Machine documentation is available as POD.
You can run perldoc from a shell to read the documentation:
% perldoc Web::Machine
Web-Machine-0.17/LICENSE 0000644 0001750 0001750 00000043724 12733042512 014376 0 ustar autarch autarch This software is copyright (c) 2016 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
Terms of the Perl programming language system itself
a) the GNU General Public License as published by the Free
Software Foundation; either version 1, or (at your option) any
later version, or
b) the "Artistic License"
--- The GNU General Public License, Version 1, February 1989 ---
This software is Copyright (c) 2016 by Infinity Interactive, Inc.
This is free software, licensed under:
The GNU General Public License, Version 1, February 1989
GNU GENERAL PUBLIC LICENSE
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The license agreements of most software companies try to keep users
at the mercy of those companies. By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.
When we speak of free software, we are referring to freedom, not
price. Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, that you receive source code or can get it if you want it,
that you can change the software or use pieces of it in new free
programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of a such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must tell them their rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License. The
"Program", below, refers to any such program or work, and a "work based
on the Program" means either the Program or any work containing the
Program or a portion of it, either verbatim or with modifications. Each
licensee is addressed as "you".
1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program. You may charge a fee for the physical act of
transferring a copy.
2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:
a) cause the modified files to carry prominent notices stating that
you changed the files and the date of any change; and
b) cause the whole of any work that you distribute or publish, that
in whole or in part contains the Program or any part thereof, either
with or without modifications, to be licensed at no charge to all
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
d) You may charge a fee for the physical act of transferring a
copy, and you may at your option offer warranty protection in
exchange for a fee.
Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.
3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:
a) accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of
Paragraphs 1 and 2 above; or,
b) accompany it with a written offer, valid for at least three
years, to give any third party free (except for a nominal charge
for the cost of distribution) a complete machine-readable copy of the
corresponding source code, to be distributed under the terms of
Paragraphs 1 and 2 above; or,
c) accompany it with the information you received as to where the
corresponding source code may be obtained. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form alone.)
Source code for a work means the preferred form of the work for making
modifications to it. For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of the license which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
the license, you may choose any version ever published by the Free Software
Foundation.
8. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
Copyright (C) 19yy
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
program `Gnomovision' (a program to direct compilers to make passes
at assemblers) written by James Hacker.
, 1 April 1989
Ty Coon, President of Vice
That's all there is to it!
--- The Artistic License 1.0 ---
This software is Copyright (c) 2016 by Infinity Interactive, Inc.
This is free software, licensed under:
The Artistic License 1.0
The Artistic License
Preamble
The intent of this document is to state the conditions under which a Package
may be copied, such that the Copyright Holder maintains some semblance of
artistic control over the development of the package, while giving the users of
the package the right to use and distribute the Package in a more-or-less
customary fashion, plus the right to make reasonable modifications.
Definitions:
- "Package" refers to the collection of files distributed by the Copyright
Holder, and derivatives of that collection of files created through
textual modification.
- "Standard Version" refers to such a Package if it has not been modified,
or has been modified in accordance with the wishes of the Copyright
Holder.
- "Copyright Holder" is whoever is named in the copyright or copyrights for
the package.
- "You" is you, if you're thinking about copying or distributing this Package.
- "Reasonable copying fee" is whatever you can justify on the basis of media
cost, duplication charges, time of people involved, and so on. (You will
not be required to justify it to the Copyright Holder, but only to the
computing community at large as a market that must bear the fee.)
- "Freely Available" means that no fee is charged for the item itself, though
there may be fees involved in handling the item. It also means that
recipients of the item may redistribute it under the same conditions they
received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications derived
from the Public Domain or from the Copyright Holder. A Package modified in such
a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided that
you insert a prominent notice in each changed file stating how and when you
changed that file, and provided that you do at least ONE of the following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or an
equivalent medium, or placing the modifications on a major archive site
such as ftp.uu.net, or by allowing the Copyright Holder to include your
modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict with
standard executables, which must also be provided, and provide a separate
manual page for each non-standard executable that clearly documents how it
differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or executable
form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where to
get the Standard Version.
b) accompany the distribution with the machine-readable source of the Package
with your modifications.
c) accompany any non-standard executables with their corresponding Standard
Version executables, giving the non-standard executables non-standard
names, and clearly documenting the differences in manual pages (or
equivalent), together with instructions on where to get the Standard
Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this Package. You
may not charge a fee for this Package itself. However, you may distribute this
Package in aggregate with other (possibly commercial) programs as part of a
larger (possibly commercial) software distribution provided that you do not
advertise this Package as a product of your own.
6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.
7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.
8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
Web-Machine-0.17/examples/ 0000775 0001750 0001750 00000000000 12733042512 015177 5 ustar autarch autarch Web-Machine-0.17/examples/hello-world/ 0000775 0001750 0001750 00000000000 12733042512 017427 5 ustar autarch autarch Web-Machine-0.17/examples/hello-world/app.psgi 0000644 0001750 0001750 00000001066 12733042512 021074 0 ustar autarch autarch #!perl
use strict;
use warnings;
use Web::Machine;
{
package HelloWorld::Resource;
use strict;
use warnings;
use parent 'Web::Machine::Resource';
sub content_types_provided { [{ 'text/html' => 'to_html' }] }
sub to_html {
join "" =>
'',
'',
'Hello World Resource',
'',
'',
'Hello World
',
'',
''
}
}
Web::Machine->new( resource => 'HelloWorld::Resource' )->to_app;
Web-Machine-0.17/examples/env-resource/ 0000775 0001750 0001750 00000000000 12733042512 017614 5 ustar autarch autarch Web-Machine-0.17/examples/env-resource/app.psgi 0000644 0001750 0001750 00000003216 12733042512 021260 0 ustar autarch autarch #!perl
use strict;
use warnings;
use Web::Machine;
=pod
Partial port of the webmachine example from here:
https://bitbucket.org/bryan/wmexamples/src/fa8104e75550/src/env_resource.erl
=cut
{
package Env::Resource;
use strict;
use warnings;
use JSON::XS ();
use Web::Machine::Util qw[ bind_path ];
use parent 'Web::Machine::Resource';
my $JSON = JSON::XS->new->allow_nonref->pretty;
sub context {
my $self = shift;
$self->{'context'} = shift if @_;
$self->{'context'}
}
sub content_types_provided { [{ 'application/json' => 'to_json' }] }
sub content_types_accepted { [{ 'application/json' => 'from_json' }] }
sub allowed_methods {
return [
qw[ GET HEAD PUT ],
((shift)->request->path_info eq '/' ? () : 'DELETE')
];
}
sub resource_exists {
my $self = shift;
if ( my $var = bind_path( '/:id', $self->request->path_info ) ) {
$self->context( $ENV{ $var } ) if exists $ENV{ $var };
}
else {
$self->context( { map { $_ => $ENV{ $_ } } keys %ENV } );
}
}
sub to_json { $JSON->encode( (shift)->context ) }
sub from_json {
my $self = shift;
my $data = $JSON->decode( $self->request->content );
if ( my $var = bind_path( '/:id', $self->request->path_info ) ) {
$ENV{ $var } = $data;
}
else {
map { $ENV{ $_ } = $data->{ $_ } } keys %$data;
}
}
sub delete_resource { delete $ENV{ bind_path( '/:id', (shift)->request->path_info ) } }
}
Web::Machine->new( resource => 'Env::Resource' )->to_app
Web-Machine-0.17/examples/yapc-talk-examples/ 0000775 0001750 0001750 00000000000 12733042512 020700 5 ustar autarch autarch Web-Machine-0.17/examples/yapc-talk-examples/001-basic.psgi 0000644 0001750 0001750 00000001576 12733042512 023152 0 ustar autarch autarch #!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 { 'Hello World
' }
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example001::Resource' )->to_app;
Web-Machine-0.17/examples/yapc-talk-examples/033-postback-w-hateoas.psgi 0000644 0001750 0001750 00000002032 12733042512 025556 0 ustar autarch autarch #!perl
use strict;
use warnings;
use FindBin;
use Web::Machine;
BEGIN {
eval {
require( "$FindBin::Bin/030-postback.psgi" ) &&
require( "$FindBin::Bin/031-postback-w-json.psgi" ) &&
require( "$FindBin::Bin/032-postback-w-auth.psgi" )
}
}
{
package YAPC::NA::2012::Example033::Resource;
use strict;
use warnings;
use JSON::XS qw[ encode_json ];
use Web::Machine::Util qw[ create_header ];
use base 'YAPC::NA::2012::Example032::Resource';
sub content_types_provided {
my $self = shift;
my $types = $self->SUPER::content_types_provided;
push @$types => { 'application/json' => 'to_json' };
$types;
}
sub to_json {
my $self = shift;
$self->response->header(
'Link' => create_header(
'LinkHeader' => [ '/', ('content-type' => 'text/html') ]
)
);
encode_json([ $self->get_messages ]);
}
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example033::Resource' )->to_app;
Web-Machine-0.17/examples/yapc-talk-examples/020-auth.psgi 0000644 0001750 0001750 00000001373 12733042512 023026 0 ustar autarch autarch #!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 { 'Hello World
' }
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;
Web-Machine-0.17/examples/yapc-talk-examples/031-postback-w-json.psgi 0000644 0001750 0001750 00000001536 12733042512 025111 0 ustar autarch autarch #!perl
use strict;
use warnings;
use FindBin;
use Web::Machine;
BEGIN { eval { require( "$FindBin::Bin/030-postback.psgi" ) } }
{
package YAPC::NA::2012::Example031::Resource;
use strict;
use warnings;
use JSON::XS ();
use base 'YAPC::NA::2012::Example030::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;
}
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example031::Resource' )->to_app;
Web-Machine-0.17/examples/yapc-talk-examples/100-add-caching.psgi 0000644 0001750 0001750 00000001331 12733042512 024200 0 ustar autarch autarch #!perl
use strict;
use warnings;
use Web::Machine;
=pod
curl -v http://0:5000/ -H 'If-Modified-Since: Sun, 27 May 2012 21:34:59 GMT'
curl -v http://0:5000/ -H 'If-Modified-Since: Sun, 27 May 2012 21:35:00 GMT'
=cut
{
package YAPC::NA::2012::Example100::Resource;
use strict;
use warnings;
use Web::Machine::Util qw[ create_date ];
use parent 'Web::Machine::Resource';
sub content_types_provided { [{ 'text/html' => 'to_html' }] }
sub last_modified { create_date('Sun, 27 May 2012 21:35:00 GMT') }
sub generate_etag { '0xDEADBEEF' }
sub to_html { 'Hello World
' }
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example100::Resource' )->to_app;
Web-Machine-0.17/examples/yapc-talk-examples/030-postback.psgi 0000644 0001750 0001750 00000001723 12733042512 023673 0 ustar autarch autarch #!perl
use strict;
use warnings;
use Web::Machine;
{
package YAPC::NA::2012::Example030::Resource;
use strict;
use warnings;
use parent 'Web::Machine::Resource';
our @MESSAGES = ();
sub save_message { push @MESSAGES => $_[1] }
sub get_messages { @MESSAGES }
sub allowed_methods { [qw[ GET POST ]] }
sub content_types_provided { [ { 'text/html' => 'to_html' } ] }
sub to_html {
my $self = shift;
'
'
. (join '' => map { '- ' . $_ . '
' } $self->get_messages)
. '
'
}
sub process_post {
my $self = shift;
$self->save_message( $self->request->param('message') );
$self->response->header('Location' => '/');
return \301;
}
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example030::Resource' )->to_app;
Web-Machine-0.17/examples/yapc-talk-examples/000-basic.psgi 0000644 0001750 0001750 00000001040 12733042512 023133 0 ustar autarch autarch #!perl
use strict;
use warnings;
use Web::Machine;
=pod
curl -v http://0:5000/
# fails with a 406
curl -v http://0:5000/ -H 'Accept: image/jpeg'
=cut
{
package YAPC::NA::2012::Example000::Resource;
use strict;
use warnings;
use JSON::XS qw[ encode_json ];
use parent 'Web::Machine::Resource';
sub content_types_provided { [{ 'application/json' => 'to_json' }] }
sub to_json { encode_json( { message => 'Hello World' } ) }
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example000::Resource' )->to_app;
Web-Machine-0.17/examples/yapc-talk-examples/010-browser.psgi 0000644 0001750 0001750 00000001574 12733042512 023552 0 ustar autarch autarch #!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 */* 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;
Web-Machine-0.17/examples/yapc-talk-examples/110-service-unavailable.psgi 0000644 0001750 0001750 00000001435 12733042512 026005 0 ustar autarch autarch #!perl
use strict;
use warnings;
use Web::Machine;
=pod
This demostrates how you can easily handle situations
like the site being down in a reasonably elegant way.
touch site_down
rm site_down
=cut
{
package YAPC::NA::2012::Example110::Resource;
use strict;
use warnings;
use parent 'Web::Machine::Resource';
sub content_types_provided { [
{ 'text/html' => 'to_html' },
] }
sub to_html { 'Hello World
' }
sub service_available {
my $self = shift;
return 1 unless -e './site_down';
$self->response->body(['Service Unavailable
Please come back later.']);
0;
}
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example110::Resource' )->to_app;
Web-Machine-0.17/examples/yapc-talk-examples/012-browser.psgi 0000644 0001750 0001750 00000002036 12733042512 023546 0 ustar autarch autarch #!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;
'' .
(join "" => map {
'- ' . $_->[0] . ' — ' . $_->[1]->type . '
'
} $self->request->header('Accept')->iterable)
. '
'
}
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;
Web-Machine-0.17/examples/yapc-talk-examples/032-postback-w-auth.psgi 0000644 0001750 0001750 00000001502 12733042512 025073 0 ustar autarch autarch #!perl
use strict;
use warnings;
use FindBin;
use Web::Machine;
BEGIN {
eval {
require( "$FindBin::Bin/030-postback.psgi" ) &&
require( "$FindBin::Bin/031-postback-w-json.psgi" )
}
}
{
package YAPC::NA::2012::Example032::Resource;
use strict;
use warnings;
use Web::Machine::Util qw[ create_header ];
use base 'YAPC::NA::2012::Example031::Resource';
sub is_authorized {
my ($self, $auth_header) = @_;
return 1 if $self->request->method ne 'PUT';
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::Example032::Resource' )->to_app;
Web-Machine-0.17/examples/yapc-talk-examples/120-bind-path.psgi 0000644 0001750 0001750 00000001335 12733042512 023732 0 ustar autarch autarch #!perl
use strict;
use warnings;
use Web::Machine;
=pod
curl -v http://0:5000/
curl -v http://0:5000/edit/100
=cut
{
package YAPC::NA::2012::Example120::Resource;
use strict;
use warnings;
use Web::Machine::Util qw[ bind_path ];
use parent 'Web::Machine::Resource';
sub content_types_provided { [{ 'text/html' => 'to_html' }] }
sub to_html {
my $self = shift;
if ( my ($action, $id) = bind_path( '/:action/:id', $self->request->path_info ) ) {
return "action('$action') id('$id')
";
}
else {
return \404;
}
}
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example120::Resource' )->to_app;
Web-Machine-0.17/examples/yapc-talk-examples/011-browser.psgi 0000644 0001750 0001750 00000002162 12733042512 023545 0 ustar autarch autarch #!perl
use strict;
use warnings;
use Web::Machine;
=pod
So what happens then if we provide HTML as well?
open http://0:5000/
Now we prefer HTML over JSON, even though JSON is
the default here.
If you call curl, you get the expected JSON.
curl -v http://0:5000/
=cut
{
package YAPC::NA::2012::Example011::Resource;
use strict;
use warnings;
use JSON::XS ();
use parent 'Web::Machine::Resource';
sub content_types_provided { [
{ 'application/json' => 'to_json' },
{ 'text/html' => 'to_html' }
] }
sub to_json {
my $self = shift;
JSON::XS->new->pretty->encode([
map {
+{ $_->[0] => $_->[1]->type }
} $self->request->header('Accept')->iterable
])
}
sub to_html {
my $self = shift;
'' .
(join "" => map {
'- ' . $_->[0] . ' — ' . $_->[1]->type . '
'
} $self->request->header('Accept')->iterable)
. '
'
}
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example011::Resource' )->to_app;
Web-Machine-0.17/examples/yapc-talk-examples/130-tracing-header.psgi 0000644 0001750 0001750 00000000670 12733042512 024743 0 ustar autarch autarch #!perl
use strict;
use warnings;
use Web::Machine;
=pod
=cut
{
package YAPC::NA::2012::Example130::Resource;
use strict;
use warnings;
use parent 'Web::Machine::Resource';
sub content_types_provided { [ { 'text/html' => 'to_html' } ] }
sub to_html { 'Hello World
' }
}
Web::Machine->new(
resource => 'YAPC::NA::2012::Example130::Resource',
tracing => 1
)->to_app;
Web-Machine-0.17/examples/yapc-talk-examples/002-basic.psgi 0000644 0001750 0001750 00000001472 12733042512 023146 0 ustar autarch autarch #!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 { 'Hello World
' }
}
Web::Machine->new( resource => 'YAPC::NA::2012::Example002::Resource' )->to_app;
Web-Machine-0.17/tidyall.ini 0000644 0001750 0001750 00000000665 12733042512 015531 0 ustar autarch autarch [PerlCritic]
select = **/*.{pl,pm,t,psgi}
ignore = .build/**/*
ignore = Web-Machine-*/**/*
ignore = blib/**/*
ignore = t/00-*
ignore = t/author-*
ignore = t/release-*
ignore = xt/**/*
argv = --profile=$ROOT/perlcriticrc
[PerlTidy]
select = **/*.{pl,pm,t,psgi}
ignore = .build/**/*
ignore = Web-Machine-*/**/*
ignore = blib/**/*
ignore = t/00-*
ignore = t/author-*
ignore = t/release-*
ignore = xt/**/*
argv = --profile=$ROOT/perltidyrc
Web-Machine-0.17/CONTRIBUTING.md 0000644 0001750 0001750 00000010072 12733042512 015610 0 ustar autarch autarch # CONTRIBUTING
Thank you for considering contributing to this distribution. This file
contains instructions that will help you work with the source code.
Please note that if you have any questions or difficulties, you can reach the
maintainer(s) through the bug queue described later in this document
(preferred), or by emailing the releaser directly. You are not required to
follow any of the steps in this document to submit a patch or bug report;
these are just recommendations, intended to help you (and help us help you
faster).
The distribution is managed with
[Dist::Zilla](https://metacpan.org/release/Dist-Zilla).
However, you can still compile and test the code with the `Makefile.PL` or
`Build.PL` in the repository:
perl Makefile.PL
make
make test
or
perl Build.PL
./Build
./Build test
As well as:
$ prove -bvr t
or
$ perl -Mblib t/some_test_file.t
You may need to satisfy some dependencies. The easiest way to satisfy
dependencies is to install the last release. This is available at
https://metacpan.org/release/Web-Machine
If you use cpanminus, you can do it without downloading the tarball first:
$ cpanm --reinstall --installdeps --with-recommends Web::Machine
Dist::Zilla is a very powerful authoring tool, but requires a number of
author-specific plugins. If you would like to use it for contributing, install
it from CPAN, then run one of the following commands, depending on your CPAN
client:
$ cpan `dzil authordeps --missing`
or
$ dzil authordeps --missing | cpanm
They may also be additional requirements not needed by the dzil build which
are needed for tests or other development:
$ cpan `dzil listdeps --author --missing`
or
$ dzil listdeps --author --missing | cpanm
Or, you can use the 'dzil stale' command to install all requirements at once:
$ cpan Dist::Zilla::App::Command::stale
$ cpan `dzil stale --all`
or
$ cpanm Dist::Zilla::App::Command::stale
$ dzil stale --all | cpanm
You can also do this via cpanm directly:
$ cpanm --reinstall --installdeps --with-develop --with-recommends Web::Machine
Once installed, here are some dzil commands you might try:
$ dzil build
$ dzil test
$ dzil test --release
$ dzil xtest
$ dzil listdeps --json
$ dzil build --notgz
You can learn more about Dist::Zilla at http://dzil.org/.
The code for this distribution is [hosted at GitHub](https://github.com/houseabsolute/webmachine-perl).
You can submit code changes by forking the repository, pushing your code
changes to your clone, and then submitting a pull request. Detailed
instructions for doing that is available here:
https://help.github.com/articles/creating-a-pull-request
If you have found a bug, but do not have an accompanying patch to fix it, you
can submit an issue report [via the web](https://github.com/houseabsolute/webmachine-perl/issues)
).
This is a good place to send your questions about the usage of this distribution.
## Travis
All pull requests for this distribution will be automatically tested by
[Travis](https://travis-ci.org/) and the build status will be reported on the
pull request page. If your build fails, please take a look at the output.
## Tidyall
This distribution uses
[Code::TidyAll](https://metacpan.org/release/Code-TidyAll) to enforce a
uniform coding style. This is tested as part of the author testing suite. You
can install and run tidyall by running the following commands:
$ cpanm Code::TidyAll
$ tidyall -a
Please run this before committing your changes and address any issues it
brings up.
## Contributor Names
If you send me a patch or pull request, your name and email address will be
included in the documentation as a contributor (using the attribution on the
commit or patch), unless you specifically request for it not to be. If you
wish to be listed under a different name or address, you should submit a pull
request to the .mailmap file to contain the correct mapping.
This file was generated via Dist::Zilla::Plugin::GenerateFile::FromShareDir 0.012 from a
template file originating in Dist-Zilla-PluginBundle-DROLSKY-0.63.
Web-Machine-0.17/Changes 0000644 0001750 0001750 00000012062 12733042512 014653 0 ustar autarch autarch 0.17 2016-06-23
* Fixed bind_path() from Web::Machine::Util to handle path parts which
evaluated to false, like "/user/0". Patch by Stevan Little. GH #34.
0.16 2015-07-05
[MISC]
* Made the state machine only called allowed_methods() on your resource class
once. RT #101203. Implemented by Nathan Cutler.
* Noted in the docs that resource methods may be called more than once and
that they should therefore by idempotent. RT #101219. Implemented by Nathan
Cutler.
* Removed the CAVEAT section of the docs warning people not to use this
module. RT #97534. Implemented by Nathan Cutler.
* Setting the WM_DEBUG environtment variable to "diag" now sends debugging
output to Test::More::diag() instead of printing directly to STDERR.
* Resource classes were being passed a string for known_content_type() instead
of an HTTP::Headers::ActionPack::MediaType object. Reported by Robert
Rothenberg. GH #27.
[BUG FIXES]
* Fixed the docs for the valid_content_headers() method. This defaults to
true, not false, as the docs previously said. Fixed by Nathan Cutler.
0.15 2014-06-26
[MISC]
* The Web::Machine class now accepts an addition parameter,
request_class. This allows you to use a custom subclass of
Plack::Request. (Mike Raynham)
* Documented the request and response methods in
Web::Machine::Resource. Requested by Olaf Alders.
0.14 2014-04-14
[MISC]
* Automatically load resources (Arthur Axel fREW Schmidt)
* Ensure closed-over $resource variable is weak in
Web::Machine::Util::BodyEncoding::encode_body (Carlos Fernando Avila Gratz)
* The n11 state was not taking into account any query parameters that might
have been passed back from `create_path`, this is fixed now (Stevan Little)
* Errors from $resource->finish_request are now logged (Greg Oschwald)
0.12 2013-08-01
[BUG FIX]
* Calculate Content-Length of the filtered body (Thomas Sibley)
[MISC]
* Link state machine diagram (Andreas Marienborg)
* Fix a POD link to PSGI (Andreas Marienborg)
0.11 2013-05-01
[NEW FEATURES]
* A resource class can now provide a default_charset() sub. This is called if
the client does not pass an Accept-Charset header, allowing you to ensure
that responses are always encoded as bytes. (Dave Rolsky)
* Both charsets_provided and default_charset can return string, rather that
key/value hashref pairs. These strings are assumed to be character set
names, and Web::Machine will use Encode::encode() to turn the body into
bytes with that string. (Dave Rolsky)
* Started working on a new Web::Machine::Manual document, and tweaked some of
the other docs in the distro. (Dave Rolsky)
[MISC]
* Fix test failures on 5.17.x. (Dave Rolsky)
* Tests on older Perls would fail when trying to parse a date in
2112. Reported by Bernhard Graf. (Dave Rolsky)
0.10 2013-04-15
[MISC]
* Requests with an If-None-Match error caused an undef warning if your
resource did not return a value from the generate_etag() sub (Dave Rolsky)
* Content negotiation is generally smarter. If a client asks for "utf8" and
your resources provides "UTF-8", this will be considered a match. This is
all implemented in HTTP::Headers::ActionPack 0.05 but it affects
Web::Machine. (Dave Rolsky)
* If you actually implemented charsets_provided in a resource this would cause
Web::Machine to die with an error like 'Can't locate object method
"HASH(0x2f613f8)" via package My::Resource'. (Dave Rolsky)
* None of the body filtering code for applying encodings or charset encoding
actually work when the body was returned as an arrayref. (Dave Rolsky)
0.09 2013-03-27
[MISC]
* Malformed headers no longer cause a 500 error (Greg Oschwald)
0.08 2013-02-12
[NEW FEATURES]
* It is now possible to have the create_path resource method fire *after* the
entity is processed. This resolves RT #78631, which also has an excellent
description of the problem in it.
0.07 2013-01-24
[MISC]
* Fixing some broken test dependencies
0.06 2013-01-23
[COMPATABILITY BREAKAGE]
* Removed the $metadata variable in the FSM and moved this into the PSGI $env
instead (blame Jesse Luehrs if this is a problem)
* Content-Type is a required header (Jesse Luehrs)
[NEW FEATURES]
* Implement PSGI style streaming responses (Jesse Luehrs)
* Allow IO handle responses (Jesse Luehrs)
[MISC]
* Fix some tests (Jesse Luehrs)
* When a resource throws an error, log this to the logger defined in the
Plack::Request object if one is available (Dave Rolsky)
0.05 2012-10-29
* If a resource returned undef from is_authorized this caused an uninitialized
value warning (Dave Rolsky)
0.04 2012-09-09
* Move all the content negotation code to HTTP::Headers::ActionPack
* Improve the bind_path function in Util
* Improve existing and add more tests for this
* Improve the docs on this too
0.03 2012-06-19
* Fix a missing semicolon (thanks to bricas)
* Fix missing $VERSION numbers (also thanks to bricas)
* Allow the resource to choose how to handle exceptions instead of always
writing them to the body
0.02 2012-06-17
* Add missing dependencies
0.01 2012-06-12
* First release
Web-Machine-0.17/META.json 0000644 0001750 0001750 00000104761 12733042512 015011 0 ustar autarch autarch {
"abstract" : "A Perl port of Webmachine",
"author" : [
"Stevan Little ",
"Dave Rolsky "
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.005, CPAN::Meta::Converter version 2.150005",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Web-Machine",
"prereqs" : {
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"develop" : {
"requires" : {
"Code::TidyAll::Plugin::Test::Vars" : "0.02",
"File::Spec" : "0",
"IO::Handle" : "0",
"IPC::Open3" : "0",
"JSON::XS" : "0",
"Path::Class" : "0",
"Perl::Critic" : "1.126",
"Perl::Tidy" : "20160302",
"Pod::Coverage::TrustPod" : "0",
"Pod::Wordlist" : "0",
"Test::CPAN::Changes" : "0.19",
"Test::CPAN::Meta::JSON" : "0.16",
"Test::EOL" : "0",
"Test::Mojibake" : "0",
"Test::More" : "0.96",
"Test::NoTabs" : "0",
"Test::Pod" : "1.41",
"Test::Pod::Coverage" : "1.08",
"Test::Pod::LinkCheck" : "0",
"Test::Portability::Files" : "0",
"Test::Spelling" : "0.12",
"Test::Synopsis" : "0",
"Test::Vars" : "0.009",
"Test::Version" : "1",
"blib" : "1.01",
"perl" : "5.006"
}
},
"runtime" : {
"requires" : {
"B" : "0",
"Carp" : "0",
"Data::Dumper" : "0",
"Encode" : "0",
"HTTP::Headers::ActionPack" : "0.07",
"HTTP::Status" : "0",
"Hash::MultiValue" : "0",
"IO::Handle::Util" : "0",
"List::Util" : "0",
"Locale::Maketext" : "0",
"Module::Runtime" : "0",
"Plack::Component" : "0",
"Plack::Request" : "0",
"Plack::Response" : "0",
"Plack::Util" : "0",
"Scalar::Util" : "0",
"Sub::Exporter" : "0",
"Try::Tiny" : "0",
"parent" : "0",
"strict" : "0",
"warnings" : "0"
}
},
"test" : {
"recommends" : {
"CPAN::Meta" : "2.120900"
},
"requires" : {
"ExtUtils::MakeMaker" : "0",
"File::Spec" : "0",
"FindBin" : "0",
"HTTP::Message::PSGI" : "0",
"HTTP::Request" : "0",
"HTTP::Request::Common" : "0",
"HTTP::Response" : "0",
"MIME::Base64" : "0",
"Net::HTTP" : "0",
"Plack::Runner" : "0",
"Plack::Test" : "0",
"Test::FailWarnings" : "0",
"Test::Fatal" : "0",
"Test::More" : "0.96",
"base" : "0",
"lib" : "0",
"utf8" : "0"
}
}
},
"provides" : {
"Web::Machine" : {
"file" : "lib/Web/Machine.pm",
"version" : "0.17"
},
"Web::Machine::FSM" : {
"file" : "lib/Web/Machine/FSM.pm",
"version" : "0.17"
},
"Web::Machine::FSM::States" : {
"file" : "lib/Web/Machine/FSM/States.pm",
"version" : "0.17"
},
"Web::Machine::I18N" : {
"file" : "lib/Web/Machine/I18N.pm",
"version" : "0.17"
},
"Web::Machine::I18N::en" : {
"file" : "lib/Web/Machine/I18N/en.pm",
"version" : "0.17"
},
"Web::Machine::Resource" : {
"file" : "lib/Web/Machine/Resource.pm",
"version" : "0.17"
},
"Web::Machine::Util" : {
"file" : "lib/Web/Machine/Util.pm",
"version" : "0.17"
},
"Web::Machine::Util::BodyEncoding" : {
"file" : "lib/Web/Machine/Util/BodyEncoding.pm",
"version" : "0.17"
},
"Web::Machine::Util::ContentNegotiation" : {
"file" : "lib/Web/Machine/Util/ContentNegotiation.pm",
"version" : "0.17"
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/houseabsolute/webmachine-perl/issues"
},
"homepage" : "http://metacpan.org/release/Web-Machine",
"repository" : {
"type" : "git",
"url" : "git://github.com/houseabsolute/webmachine-perl.git",
"web" : "https://github.com/houseabsolute/webmachine-perl"
}
},
"version" : "0.17",
"x_Dist_Zilla" : {
"perl" : {
"version" : "5.022001"
},
"plugins" : [
{
"class" : "Dist::Zilla::Plugin::MakeMaker",
"config" : {
"Dist::Zilla::Role::TestRunner" : {
"default_jobs" : 1
}
},
"name" : "@DROLSKY/MakeMaker",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::Git::GatherDir",
"config" : {
"Dist::Zilla::Plugin::GatherDir" : {
"exclude_filename" : [
"Build.PL",
"CONTRIBUTING.md",
"LICENSE",
"Makefile.PL",
"README.md",
"cpanfile",
"ppport.h"
],
"exclude_match" : [],
"follow_symlinks" : 0,
"include_dotfiles" : 0,
"prefix" : "",
"prune_directory" : [],
"root" : "."
},
"Dist::Zilla::Plugin::Git::GatherDir" : {
"include_untracked" : 0
}
},
"name" : "@DROLSKY/Git::GatherDir",
"version" : "2.039"
},
{
"class" : "Dist::Zilla::Plugin::ManifestSkip",
"name" : "@DROLSKY/ManifestSkip",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::License",
"name" : "@DROLSKY/License",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::ExecDir",
"name" : "@DROLSKY/ExecDir",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::ShareDir",
"name" : "@DROLSKY/ShareDir",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::Manifest",
"name" : "@DROLSKY/Manifest",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::CheckVersionIncrement",
"name" : "@DROLSKY/CheckVersionIncrement",
"version" : "0.121750"
},
{
"class" : "Dist::Zilla::Plugin::TestRelease",
"name" : "@DROLSKY/TestRelease",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::ConfirmRelease",
"name" : "@DROLSKY/ConfirmRelease",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::UploadToCPAN",
"name" : "@DROLSKY/UploadToCPAN",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::DROLSKY::VersionProvider",
"name" : "@DROLSKY/DROLSKY::VersionProvider",
"version" : "0.63"
},
{
"class" : "Dist::Zilla::Plugin::Authority",
"name" : "@DROLSKY/Authority",
"version" : "1.009"
},
{
"class" : "Dist::Zilla::Plugin::AutoPrereqs",
"name" : "@DROLSKY/AutoPrereqs",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::CopyFilesFromBuild",
"name" : "@DROLSKY/CopyFilesFromBuild",
"version" : "0.161350"
},
{
"class" : "Dist::Zilla::Plugin::GitHub::Meta",
"name" : "@DROLSKY/GitHub::Meta",
"version" : "0.42"
},
{
"class" : "Dist::Zilla::Plugin::GitHub::Update",
"config" : {
"Dist::Zilla::Plugin::GitHub::Update" : {
"metacpan" : 1
}
},
"name" : "@DROLSKY/GitHub::Update",
"version" : "0.42"
},
{
"class" : "Dist::Zilla::Plugin::MetaResources",
"name" : "@DROLSKY/MetaResources",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::MetaProvides::Package",
"config" : {
"Dist::Zilla::Plugin::MetaProvides::Package" : {
"finder_objects" : [
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : "@DROLSKY/MetaProvides::Package/AUTOVIV/:InstallModulesPM",
"version" : "6.005"
}
]
},
"Dist::Zilla::Role::MetaProvider::Provider" : {
"inherit_missing" : "1",
"inherit_version" : "1",
"meta_noindex" : "1"
}
},
"name" : "@DROLSKY/MetaProvides::Package",
"version" : "2.003002"
},
{
"class" : "Dist::Zilla::Plugin::MetaYAML",
"name" : "@DROLSKY/MetaYAML",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::Meta::Contributors",
"name" : "@DROLSKY/Meta::Contributors",
"version" : "0.003"
},
{
"class" : "Dist::Zilla::Plugin::MetaConfig",
"name" : "@DROLSKY/MetaConfig",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::MetaJSON",
"name" : "@DROLSKY/MetaJSON",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::NextRelease",
"name" : "@DROLSKY/NextRelease",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::Prereqs",
"config" : {
"Dist::Zilla::Plugin::Prereqs" : {
"phase" : "test",
"type" : "requires"
}
},
"name" : "@DROLSKY/Test::More with subtest",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::Prereqs",
"config" : {
"Dist::Zilla::Plugin::Prereqs" : {
"phase" : "develop",
"type" : "requires"
}
},
"name" : "@DROLSKY/Modules for use with tidyall",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::PromptIfStale",
"config" : {
"Dist::Zilla::Plugin::PromptIfStale" : {
"check_all_plugins" : 0,
"check_all_prereqs" : 0,
"modules" : [
"Dist::Zilla::PluginBundle::DROLSKY"
],
"phase" : "build",
"run_under_travis" : 0,
"skip" : []
}
},
"name" : "@DROLSKY/Dist::Zilla::PluginBundle::DROLSKY",
"version" : "0.051"
},
{
"class" : "Dist::Zilla::Plugin::PromptIfStale",
"config" : {
"Dist::Zilla::Plugin::PromptIfStale" : {
"check_all_plugins" : 1,
"check_all_prereqs" : 1,
"modules" : [],
"phase" : "release",
"run_under_travis" : 0,
"skip" : [
"Dist::Zilla::Plugin::DROLSKY::CheckChangesHasContent",
"Dist::Zilla::Plugin::DROLSKY::Contributors",
"Dist::Zilla::Plugin::DROLSKY::Git::CheckFor::CorrectBranch",
"Dist::Zilla::Plugin::DROLSKY::License",
"Dist::Zilla::Plugin::DROLSKY::TidyAll",
"Dist::Zilla::Plugin::DROLSKY::VersionProvider",
"Pod::Weaver::PluginBundle::DROLSKY"
]
}
},
"name" : "@DROLSKY/PromptIfStale",
"version" : "0.051"
},
{
"class" : "Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable",
"name" : "@DROLSKY/Test::Pod::Coverage::Configurable",
"version" : "0.06"
},
{
"class" : "Dist::Zilla::Plugin::Test::PodSpelling",
"config" : {
"Dist::Zilla::Plugin::Test::PodSpelling" : {
"directories" : [],
"spell_cmd" : "",
"stopwords" : [
"Andreas",
"Axel",
"Charset",
"Cribbs",
"DROLSKY",
"DROLSKY's",
"ETag",
"Encodings",
"Erlang",
"Fayland",
"Gratz",
"Hartzell",
"JS",
"JavaScript",
"Luehrs",
"Marienborg",
"Oschwald",
"PayPal",
"RESTful",
"Raynham",
"Rolsky",
"Rolsky",
"Rolsky's",
"Sheehy",
"Sibley",
"Stevan",
"WebDAV",
"Webmachine",
"arity",
"charsets",
"drolsky",
"fREW",
"webmachine"
],
"wordlist" : "Pod::Wordlist"
}
},
"name" : "@DROLSKY/Test::PodSpelling",
"version" : "2.007002"
},
{
"class" : "Dist::Zilla::Plugin::PodSyntaxTests",
"name" : "@DROLSKY/PodSyntaxTests",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::Test::Pod::LinkCheck",
"name" : "@DROLSKY/Test::Pod::LinkCheck",
"version" : "1.002"
},
{
"class" : "Dist::Zilla::Plugin::RunExtraTests",
"config" : {
"Dist::Zilla::Role::TestRunner" : {
"default_jobs" : 1
}
},
"name" : "@DROLSKY/RunExtraTests",
"version" : "0.029"
},
{
"class" : "Dist::Zilla::Plugin::MojibakeTests",
"name" : "@DROLSKY/MojibakeTests",
"version" : "0.8"
},
{
"class" : "Dist::Zilla::Plugin::Test::CPAN::Changes",
"config" : {
"Dist::Zilla::Plugin::Test::CPAN::Changes" : {
"changelog" : "Changes"
}
},
"name" : "@DROLSKY/Test::CPAN::Changes",
"version" : "0.012"
},
{
"class" : "Dist::Zilla::Plugin::Test::CPAN::Meta::JSON",
"name" : "@DROLSKY/Test::CPAN::Meta::JSON",
"version" : "0.004"
},
{
"class" : "Dist::Zilla::Plugin::Test::EOL",
"config" : {
"Dist::Zilla::Plugin::Test::EOL" : {
"filename" : "xt/author/eol.t",
"finder" : [
":InstallModules",
":ExecFiles",
":TestFiles"
],
"trailing_whitespace" : "1"
}
},
"name" : "@DROLSKY/Test::EOL",
"version" : "0.18"
},
{
"class" : "Dist::Zilla::Plugin::Test::NoTabs",
"config" : {
"Dist::Zilla::Plugin::Test::NoTabs" : {
"filename" : "xt/author/no-tabs.t",
"finder" : [
":InstallModules",
":ExecFiles",
":TestFiles"
]
}
},
"name" : "@DROLSKY/Test::NoTabs",
"version" : "0.15"
},
{
"class" : "Dist::Zilla::Plugin::Test::Portability",
"name" : "@DROLSKY/Test::Portability",
"version" : "2.000007"
},
{
"class" : "Dist::Zilla::Plugin::Test::Synopsis",
"name" : "@DROLSKY/Test::Synopsis",
"version" : "2.000007"
},
{
"class" : "Dist::Zilla::Plugin::Test::Compile",
"config" : {
"Dist::Zilla::Plugin::Test::Compile" : {
"bail_out_on_fail" : "0",
"fail_on_warning" : "author",
"fake_home" : 0,
"filename" : "xt/author/00-compile.t",
"module_finder" : [
":InstallModules"
],
"needs_display" : 0,
"phase" : "develop",
"script_finder" : [
":PerlExecFiles"
],
"skips" : []
}
},
"name" : "@DROLSKY/Test::Compile",
"version" : "2.054"
},
{
"class" : "Dist::Zilla::Plugin::Test::ReportPrereqs",
"name" : "@DROLSKY/Test::ReportPrereqs",
"version" : "0.025"
},
{
"class" : "Dist::Zilla::Plugin::Test::Version",
"name" : "@DROLSKY/Test::Version",
"version" : "1.09"
},
{
"class" : "Dist::Zilla::Plugin::DROLSKY::Contributors",
"name" : "@DROLSKY/DROLSKY::Contributors",
"version" : "0.63"
},
{
"class" : "Dist::Zilla::Plugin::Git::Contributors",
"config" : {
"Dist::Zilla::Plugin::Git::Contributors" : {
"include_authors" : 0,
"include_releaser" : 1,
"order_by" : "name",
"paths" : [
"."
]
}
},
"name" : "@DROLSKY/Git::Contributors",
"version" : "0.023"
},
{
"class" : "Dist::Zilla::Plugin::SurgicalPodWeaver",
"config" : {
"Dist::Zilla::Plugin::PodWeaver" : {
"config_plugins" : [
"@DROLSKY"
],
"finder" : [
":InstallModules",
":ExecFiles"
],
"plugins" : [
{
"class" : "Pod::Weaver::Plugin::EnsurePod5",
"name" : "@CorePrep/EnsurePod5",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Plugin::H1Nester",
"name" : "@CorePrep/H1Nester",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Plugin::SingleEncoding",
"name" : "@DROLSKY/SingleEncoding",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Plugin::Transformer",
"name" : "@DROLSKY/List",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Plugin::Transformer",
"name" : "@DROLSKY/Verbatim",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Region",
"name" : "@DROLSKY/header",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Name",
"name" : "@DROLSKY/Name",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Version",
"name" : "@DROLSKY/Version",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Region",
"name" : "@DROLSKY/prelude",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Generic",
"name" : "SYNOPSIS",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Generic",
"name" : "DESCRIPTION",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Generic",
"name" : "OVERVIEW",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Collect",
"name" : "ATTRIBUTES",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Collect",
"name" : "METHODS",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Collect",
"name" : "FUNCTIONS",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Collect",
"name" : "TYPES",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Leftovers",
"name" : "@DROLSKY/Leftovers",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Region",
"name" : "@DROLSKY/postlude",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::GenerateSection",
"name" : "@DROLSKY/generate SUPPORT",
"version" : "1.01"
},
{
"class" : "Pod::Weaver::Section::AllowOverride",
"name" : "@DROLSKY/allow override SUPPORT",
"version" : "0.05"
},
{
"class" : "Pod::Weaver::Section::Authors",
"name" : "@DROLSKY/Authors",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Contributors",
"name" : "@DROLSKY/Contributors",
"version" : "0.009"
},
{
"class" : "Pod::Weaver::Section::Legal",
"name" : "@DROLSKY/Legal",
"version" : "4.012"
},
{
"class" : "Pod::Weaver::Section::Region",
"name" : "@DROLSKY/footer",
"version" : "4.012"
}
]
}
},
"name" : "@DROLSKY/SurgicalPodWeaver",
"version" : "0.0023"
},
{
"class" : "Dist::Zilla::Plugin::ReadmeAnyFromPod",
"config" : {
"Dist::Zilla::Role::FileWatcher" : {
"version" : "0.006"
}
},
"name" : "@DROLSKY/README.md in build",
"version" : "0.161170"
},
{
"class" : "Dist::Zilla::Plugin::GenerateFile::FromShareDir",
"config" : {
"Dist::Zilla::Plugin::GenerateFile::FromShareDir" : {
"destination_filename" : "CONTRIBUTING.md",
"dist" : "Dist-Zilla-PluginBundle-DROLSKY",
"encoding" : "UTF-8",
"has_xs" : "0",
"location" : "build",
"source_filename" : "CONTRIBUTING.md"
},
"Dist::Zilla::Role::RepoFileInjector" : {
"allow_overwrite" : 1,
"repo_root" : ".",
"version" : "0.007"
}
},
"name" : "@DROLSKY/generate CONTRIBUTING",
"version" : "0.012"
},
{
"class" : "Dist::Zilla::Plugin::InstallGuide",
"name" : "@DROLSKY/InstallGuide",
"version" : "1.200007"
},
{
"class" : "Dist::Zilla::Plugin::CPANFile",
"name" : "@DROLSKY/CPANFile",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::DROLSKY::License",
"name" : "@DROLSKY/DROLSKY::License",
"version" : "0.63"
},
{
"class" : "Dist::Zilla::Plugin::CheckPrereqsIndexed",
"name" : "@DROLSKY/CheckPrereqsIndexed",
"version" : "0.018"
},
{
"class" : "Dist::Zilla::Plugin::DROLSKY::CheckChangesHasContent",
"name" : "@DROLSKY/DROLSKY::CheckChangesHasContent",
"version" : "0.63"
},
{
"class" : "Dist::Zilla::Plugin::DROLSKY::Git::CheckFor::CorrectBranch",
"config" : {
"Dist::Zilla::Role::Git::Repo" : {
"repo_root" : "."
}
},
"name" : "@DROLSKY/DROLSKY::Git::CheckFor::CorrectBranch",
"version" : "0.63"
},
{
"class" : "Dist::Zilla::Plugin::Git::CheckFor::MergeConflicts",
"config" : {
"Dist::Zilla::Role::Git::Repo" : {
"repo_root" : "."
}
},
"name" : "@DROLSKY/Git::CheckFor::MergeConflicts",
"version" : "0.013"
},
{
"class" : "Dist::Zilla::Plugin::DROLSKY::TidyAll",
"name" : "@DROLSKY/DROLSKY::TidyAll",
"version" : "0.63"
},
{
"class" : "Dist::Zilla::Plugin::Git::Check",
"config" : {
"Dist::Zilla::Plugin::Git::Check" : {
"untracked_files" : "die"
},
"Dist::Zilla::Role::Git::DirtyFiles" : {
"allow_dirty" : [
"Build.PL",
"CONTRIBUTING.md",
"Changes",
"LICENSE",
"Makefile.PL",
"README.md",
"cpanfile",
"ppport.h",
"tidyall.ini"
],
"allow_dirty_match" : [],
"changelog" : "Changes"
},
"Dist::Zilla::Role::Git::Repo" : {
"repo_root" : "."
}
},
"name" : "@DROLSKY/Git::Check",
"version" : "2.039"
},
{
"class" : "Dist::Zilla::Plugin::Git::Commit",
"config" : {
"Dist::Zilla::Plugin::Git::Commit" : {
"add_files_in" : [],
"commit_msg" : "v%v%n%n%c"
},
"Dist::Zilla::Role::Git::DirtyFiles" : {
"allow_dirty" : [
"Build.PL",
"CONTRIBUTING.md",
"Changes",
"LICENSE",
"Makefile.PL",
"README.md",
"cpanfile",
"ppport.h",
"tidyall.ini"
],
"allow_dirty_match" : [],
"changelog" : "Changes"
},
"Dist::Zilla::Role::Git::Repo" : {
"repo_root" : "."
},
"Dist::Zilla::Role::Git::StringFormatter" : {
"time_zone" : "local"
}
},
"name" : "@DROLSKY/commit generated files",
"version" : "2.039"
},
{
"class" : "Dist::Zilla::Plugin::Git::Tag",
"config" : {
"Dist::Zilla::Plugin::Git::Tag" : {
"branch" : null,
"changelog" : "Changes",
"signed" : 0,
"tag" : "v0.17",
"tag_format" : "v%v",
"tag_message" : "v%v"
},
"Dist::Zilla::Role::Git::Repo" : {
"repo_root" : "."
},
"Dist::Zilla::Role::Git::StringFormatter" : {
"time_zone" : "local"
}
},
"name" : "@DROLSKY/Git::Tag",
"version" : "2.039"
},
{
"class" : "Dist::Zilla::Plugin::Git::Push",
"config" : {
"Dist::Zilla::Plugin::Git::Push" : {
"push_to" : [
"origin"
],
"remotes_must_exist" : 1
},
"Dist::Zilla::Role::Git::Repo" : {
"repo_root" : "."
}
},
"name" : "@DROLSKY/Git::Push",
"version" : "2.039"
},
{
"class" : "Dist::Zilla::Plugin::BumpVersionAfterRelease",
"config" : {
"Dist::Zilla::Plugin::BumpVersionAfterRelease" : {
"finders" : [
":ExecFiles",
":InstallModules"
],
"global" : 0,
"munge_makefile_pl" : 1
}
},
"name" : "@DROLSKY/BumpVersionAfterRelease",
"version" : "0.015"
},
{
"class" : "Dist::Zilla::Plugin::Git::Commit",
"config" : {
"Dist::Zilla::Plugin::Git::Commit" : {
"add_files_in" : [],
"commit_msg" : "Bump version after release"
},
"Dist::Zilla::Role::Git::DirtyFiles" : {
"allow_dirty" : [
"Changes",
"dist.ini"
],
"allow_dirty_match" : [
"(?^:.+)"
],
"changelog" : "Changes"
},
"Dist::Zilla::Role::Git::Repo" : {
"repo_root" : "."
},
"Dist::Zilla::Role::Git::StringFormatter" : {
"time_zone" : "local"
}
},
"name" : "@DROLSKY/commit version bump",
"version" : "2.039"
},
{
"class" : "Dist::Zilla::Plugin::Git::Push",
"config" : {
"Dist::Zilla::Plugin::Git::Push" : {
"push_to" : [
"origin"
],
"remotes_must_exist" : 1
},
"Dist::Zilla::Role::Git::Repo" : {
"repo_root" : "."
}
},
"name" : "@DROLSKY/push version bump",
"version" : "2.039"
},
{
"class" : "Dist::Zilla::Plugin::Prereqs",
"config" : {
"Dist::Zilla::Plugin::Prereqs" : {
"phase" : "develop",
"type" : "requires"
}
},
"name" : "DevelopRequires",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":InstallModules",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":IncModules",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":TestFiles",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":ExtraTestFiles",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":ExecFiles",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":PerlExecFiles",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":ShareFiles",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":MainModule",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":AllFiles",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":NoFiles",
"version" : "6.005"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : "@DROLSKY/MetaProvides::Package/AUTOVIV/:InstallModulesPM",
"version" : "6.005"
}
],
"zilla" : {
"class" : "Dist::Zilla::Dist::Builder",
"config" : {
"is_trial" : "0"
},
"version" : "6.005"
}
},
"x_authority" : "cpan:STEVAN",
"x_contributors" : [
"Andreas Marienborg ",
"Andrew Nelson ",
"Arthur Axel 'fREW' Schmidt ",
"Carlos Fernando Avila Gratz