Prancer
view release on metacpan or search on metacpan
Revision history for Perl extension Prancer
0.01 Mon Mar 31 04:27:36 UTC 2014
- Initial release.
0.03 Wed Apr 2 03:02:51 UTC 2014
- Screwed up 0.02, releasing again compatible with CPAN
0.04 Sun Apr 6 05:52:15 UTC 2014
- Fixing warnings when paths do not exist
- Allow default values on session/config gets
- Fixing bug in getting all parameters
0.05 Mon Apr 21 06:12:13 UTC 2014
- make Plack::Middleware::Session a required module to make tests work, among other things
- fix bug that would prevent cookies from being sent with responses
- adding headers and cookies to the template
- allow setting PLUGIN_BASE on TT plugin
- fix TT plugin extension
- doc updates
0.06 Sun Apr 27 07:30:27 UTC 2014
- removing template code
- adding sqlite/mysql connectors
0.07 Thu May 1 21:15:25 UTC 2014
- Documentation updates
- Moving this out of "test" to make it fully available on CPAN
0.08 Wed May 14 06:18:03 UTC 2014
- Fixing bug that would load too many uploads
0.09 Tue May 20 05:23:53 UTC 2014
- Removing dumb tests
1.00 Fri Dec 12 06:56:57 UTC 2014
- Completely rewriting to use Web::Simple for routing.
- Removing a lot of extra components and stripping down to just config management, routing, and session management.
1.01 Fri Dec 12 15:11:36 UTC 2014
- Changing status so that this actually gets indexed by CPAN
1.04 Sat Dec 13 04:35:58 UTC 2014
- Don't remove configuration options on loading things.
- 1.02 and 1.03 were screwed up releases
1.05 Wed Dec 9 05:12:15 UTC 2015
- Changing HTTP::Headers uage to HTTP::Headers::Fast to fix compatibility with Plack 1.0038.
Artistic License 2.0
Copyright (c) 2000-2006, The Perl Foundation.
Everyone is permitted to copy and distribute verbatim copies of this license
document, but changing it is not allowed.
PREAMBLE
This license establishes the terms under which a given free software Package
may be copied, modified, distributed, and/or redistributed. The intent is that
the Copyright Holder maintains some artistic control over the development of
that Package while still keeping the Package available as open source and free
software.
You are always permitted to make arrangements wholly outside of this license
directly with the Copyright Holder of a given Package. If the terms of this
license do not permit the full use that you propose to make of the Package,
you should contact the Copyright Holder and seek a different licensing
arrangement.
DEFINITIONS
"Copyright Holder" means the individual(s) or organization(s) named in the
copyright notice for the entire Package.
"Contributor" means any party that has contributed code or other material to
the Package, in accordance with the Copyright Holder's procedures.
"You" and "your" means any person who would like to copy, distribute, or
modify the Package.
"Package" means the collection of files distributed by the Copyright Holder,
and derivatives of that collection and/or of those files. A given Package may
consist of either the Standard Version, or a Modified Version.
"Distribute" means providing a copy of the Package or making it accessible to
anyone else, or in the case of a company or organization, to others outside of
your company or organization.
"Distributor Fee" means any fee that you charge for Distributing this Package
or providing support for this Package to another party. It does not mean
licensing fees.
"Standard Version" refers to the Package if it has not been modified, or has
been modified only in ways explicitly requested by the Copyright Holder.
"Modified Version" means the Package, if it has been changed, and such changes
were not explicitly requested by the Copyright Holder.
"Original License" means this Artistic License as Distributed with the
Standard Version of the Package, in its current version or as it may be
modified by The Perl Foundation in the future.
"Source" form means the source code, documentation source, and configuration
files for the Package.
"Compiled" form means the compiled bytecode, object code, binary, or any other
form resulting from mechanical transformation or translation of the Source form.
PERMISSION FOR USE AND MODIFICATION WITHOUT DISTRIBUTION
(1) You are permitted to use the Standard Version and create and use Modified
Versions for any purpose without restriction, provided that you do not
Distribute the Modified Version.
PERMISSIONS FOR REDISTRIBUTION OF THE STANDARD VERSION
(2) You may Distribute verbatim copies of the Source form of the Standard
Version of this Package in any medium without restriction, either gratis
or for a Distributor Fee, provided that you duplicate all of the original
copyright notices and associated disclaimers. At your discretion, such
verbatim copies may or may not include a Compiled form of the Package.
(3) You may apply any bug fixes, portability changes, and other
modifications made available from the Copyright Holder. The resulting Package
will still be considered the Standard Version, and as such will be subject to
the Original License.
DISTRIBUTION OF MODIFIED VERSIONS OF THE PACKAGE AS SOURCE
(4) You may Distribute your Modified Version as Source (either gratis or for a
Distributor Fee, and with or without a Compiled form of the Modified Version)
provided that you clearly document how it differs from the Standard Version,
including, but not limited to, documenting any non-standard features,
executables, or modules, and provided that you do at least ONE of the following:
(a) make the Modified Version available to the Copyright Holder of the Standard
Version, under the Original License, so that the Copyright Holder may include
your modifications in the Standard Version.
(b) ensure that installation of your Modified Version does not prevent the user
installing or running the Standard Version. In addition, the Modified Version
must bear a name that is different from the name of the Standard Version.
(c) allow anyone who receives a copy of the Modified Version to make the Source
form of the Modified Version available to others under
(i) the Original License or
(ii) a license that permits the licensee to freely copy, modify and
redistribute the Modified Version using the same licensing terms that apply to
the copy that the licensee received, and requires that the Source form of the
Modified Version, and of any works derived from it, be made freely available in
that license fees are prohibited but Distributor Fees are allowed.
DISTRIBUTION OF COMPILED FORMS OF THE STANDARD VERSION OR MODIFIED VERSIONS WITHOUT THE SOURCE
(5) You may Distribute Compiled forms of the Standard Version without the
Source, provided that you include complete instructions on how to get the
Source of the Standard Version. Such instructions must be valid at the time of
your distribution. If these instructions, at any time while you are carrying
out such distribution, become invalid, you must provide new instructions on
demand or cease further distribution. If you provide valid instructions or
cease distribution within thirty days after you become aware that the
instructions are invalid, then you do not forfeit any of your rights under
this license.
(6) You may Distribute a Modified Version in Compiled form without the Source,
provided that you comply with Section 4 with respect to the Source of the
Modified Version.
AGGREGATING OR LINKING THE PACKAGE
(7) You may aggregate the Package (either the Standard Version or Modified
Version) with other packages and Distribute the resulting aggregation provided
that you do not charge a licensing fee for the Package. Distributor Fees are
permitted, and licensing fees for other components in the aggregation are
permitted. The terms of this license apply to the use and Distribution of the
Standard or Modified Versions as included in the aggregation.
(8) You are permitted to link Modified and Standard Versions with other works,
to embed the Package in a larger work of your own, or to build stand-alone
binary or bytecode versions of applications that include the Package, and
Distribute the result without restriction, provided the result does not expose
a direct interface to the Package.
ITEMS THAT ARE NOT CONSIDERED PART OF A MODIFIED VERSION
(9) Works (including, but not limited to, modules and scripts) that merely
extend or make use of the Package, do not, by themselves, cause the Package to
be a Modified Version. In addition, such works are not considered parts of
the Package itself, and are not subject to the terms of this license.
GENERAL PROVISIONS
(10) Any use, modification, and distribution of the Standard or Modified
Versions is governed by this Artistic License. By using, modifying or
distributing the Package, you accept this license. Do not use, modify, or
distribute the Package, if you do not accept this license.
(11) If your Modified Version has been derived from a Modified Version made by
someone other than you, you are nevertheless required to ensure that your
Modified Version complies with the requirements of this license.
(12) This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.
(13) This license includes the non-exclusive, worldwide, free-of-charge patent
license to make, have made, use, offer to sell, sell, import and otherwise
transfer the Package with respect to any patent claims licensable by the
Copyright Holder that are necessarily infringed by the Package. If you
institute patent litigation (including a cross-claim or counterclaim) against
any party alleging that the Package constitutes direct or contributory patent
infringement, then this Artistic License to you shall terminate on the date
that such litigation is filed.
(14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE
IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW.
UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY
OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
{
"abstract" : "A lightweight PSGI framework",
"author" : [
"Paul Lockaby <plockaby AT cpan DOT org>"
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "Prancer",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Plack" : "0.9968",
"Plack::Middleware::Session" : "0.23",
"Web::Simple" : "0.020",
"HTTP::Message" : "0",
"Try::Tiny" : "0",
"Config::Any" : "0",
"YAML" : "0",
"Hash::MultiValue" : "0",
"URI" : "0",
"warnings::illegalproto" : "0"
}
}
},
"release_status" : "stable",
"version" : "1.05"
}
Makefile.PL view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings FATAL => 'all';
use ExtUtils::MakeMaker;
WriteMakefile(
'NAME' => 'Prancer',
'AUTHOR' => 'Paul Lockaby <plockaby AT cpan DOT org>',
'VERSION_FROM' => 'lib/Prancer.pm',
'PREREQ_PM' => {
'Plack' => '0.9968', # same version required by Web::Simple
'Plack::Middleware::Session' => '0.23',
'Web::Simple' => '0.020',
'HTTP::Message' => '0',
'HTTP::Headers::Fast' => '0',
'Try::Tiny' => '0',
'Config::Any' => '0',
'YAML' => '0',
'Hash::MultiValue' => '0',
'URI' => '0',
'warnings::illegalproto' => '0',
},
'INSTALLDIRS' => (($] < 5.011) ? 'perl' : 'site'),
((ExtUtils::MakeMaker->VERSION() lt '6.25') ?
('PL_FILES' => { }) : ()),
((ExtUtils::MakeMaker->VERSION() gt '6.30') ?
('LICENSE' => 'perl') : ()),
);
# NAME
Prancer
# SYNOPSIS
When using as part of a web application:
===> foobar.yml
session:
state:
driver: Prancer::Session::State::Cookie
options:
session_key: PSESSION
store:
driver: Prancer::Session::Store::Storable
options:
dir: /tmp/prancer/sessions
static:
path: /static
dir: /srv/www/resources
===> myapp.psgi
#!/usr/bin/env perl
use strict;
use warnings;
use Plack::Runner;
# this just returns a PSGI application. $x can be wrapped with additional
# middleware before sending it along to Plack::Runner.
my $x = MyApp->new("/path/to/foobar.yml")->to_psgi_app();
# run the psgi app through Plack and send it everything from @ARGV. this
# way Plack::Runner will get options like what listening port to use and
# application server to use -- Starman, Twiggy, etc.
my $runner = Plack::Runner->new();
$runner->parse_options(@ARGV);
$runner->run($x);
===> MyApp.pm
package MyApp;
use strict;
use warnings;
use Prancer qw(config);
sub initialize {
my $self = shift;
# in here we can initialize things like plugins
# but this method is not required to be implemented
return;
}
sub handler {
my ($self, $env, $request, $response, $session) = @_;
sub (GET + /) {
$response->header("Content-Type" => "text/plain");
$response->body("Hello, world!");
return $response->finalize(200);
}, sub (GET + /foo) {
$response->header("Content-Type" => "text/plain");
$response->body(sub {
my $writer = shift;
$writer->write("Hello, world!");
$writer->close();
return;
});
}
}
1;
If you save the above snippet as `myapp.psgi` and run it like this:
plackup myapp.psgi
You will get "Hello, world!" in your browser. Or you can use Prancer as part of
a standalone command line application:
#!/usr/bin/env perl
use strict;
use warnings;
use Prancer::Core qw(config);
# the advantage to using Prancer in a standalone application is the ability
# to use a standard configuration and to load plugins for things like
# loggers and database connectors and template engines.
my $x = Prancer::Core->new("/path/to/foobar.yml");
print "Hello, world!;
# DESCRIPTION
Prancer is yet another PSGI framework that provides routing and session
management as well as plugins for logging, database access, and template
engines. It does this by wrapping
[Web::Simple](https://metacpan.org/pod/Web::Simple) to handle routing and by
wrapping other libraries to bring easy access to things that need to be done in
web applications.
There are two parts to using Prancer for a web application: a package to
contain your application and a script to call your application. Both are
necessary.
The package containing your application should contain a line like this:
use Prancer;
This modifies your application package such that it inherits from Prancer. It
also means that your package must implement the `handler` method and
optionally implement the `initialize` method. As Prancer inherits from
Web::Simple it will also automatically enable the `strict` and `warnings`
pragmas.
As mentioned, putting `use Prancer;` at the top of your package will require
you to implement the `handler` method, like this:
sub handler {
my ($self, $env, $request, $response, $session) = @_;
# routing goes in here.
# see Web::Simple for documentation on writing routing rules.
sub (GET + /) {
$response->header("Content-Type" => "text/plain");
$response->body("Hello, world!");
return $response->finalize(200);
}
}
The `$request` variable is a
[Prancer::Request](https://metacpan.org/pod/Prancer::Request) object. The
`$response` variable is a
[Prancer::Response](https://metacpan.org/pod/Prancer::Response) object. The
`$session` variable is a
[Prancer::Session](https://metacpan.org/pod/Prancer::Session) object. If there
is no configuration for sessions in any of your configuration files then
`$session` will be `undef`.
You may implement your own `new` method in your application but you **MUST**
call `$class->SUPER::new(@_);` to get the configuration file loaded and
any methods exported. As an alternative to implemeting `new` and remembering
to call `SUPER::new`, Prancer will make a call to `->initialize` at the
end of its own implementation of `new` so things that you might put in `new`
can instead be put into `initialize`, like this:
sub initialize {
my $self = shift;
# this is where you can initialize things when your package is created
return;
}
By default, Prancer does not export anything into your package's namespace.
However, that doesn't mean that there is not anything that it _could_ export
were one to ask:
use Prancer qw(config);
Importing `config` will make the keyword `config` available which gives
access to any configuration options loaded by Prancer.
The second part of the Prancer equation is the script that creates and calls
your package. This can be a pretty small and standard little script, like this:
my $myapp = MyApp->new("/path/to/foobar.yml")
my $psgi = $myapp->to_psgi_app();
`$myapp` is just an instance of your package. You can pass to `new` either
one specific configuration file or a directory containing lots of configuration
files. The functionality is documented in `Prancer::Config`.
`$psgi` is just a PSGI app that you can send to
[Plack::Runner](https://metacpan.org/pod/Plack::Runner) or whatever you use to
run PSGI apps. You can also wrap middleware around `$app`.
my $psgi = $myapp->to_psgi_app();
$psgi = Plack::Middleware::Runtime->wrap($psgi);
# CONFIGURATION
Prancer needs a configuration file. Ok, it doesn't _need_ a configuration file
file. By default, Prancer does not require any configuration. But it is less
useful without one. You _could_ always create your application like this:
my $app = MyApp->new->to_psgi_app();
How Prancer loads configuration files is documented in
[Prancer::Config](https://metacpan.org/pod/Prancer::Config). Anything you put
into your configuration file is available to your application.
There are two special configuration keys reserved by Prancer. The key
`session` will configure Prancer's session as documented in
[Prancer::Session](https://metacpan.org/pod/Prancer::Session). The key `static`
will configure static file loading through
[Plack::Middleware::Static](https://metacpan.org/pod/Plack::Middleware::Static).
To configure static file loading you can add this to your configuration file:
static:
path: /static
dir: /path/to/my/resources
The `dir` option is required to indicate the root directory for your static
resources. The `path` option indicates the web path to link to your static
resources. If no path is not provided then static files can be accessed under
`/static` by default.
# CREDITS
This module could have been written except on the shoulders of the following
giants:
- The name "Prancer" is a riff on the popular PSGI framework [Dancer](https://metacpan.org/pod/Dancer) and [Dancer2](https://metacpan.org/pod/Dancer2). [Prancer::Config](https://metacpan.org/pod/Prancer::Config) is derived directly from [Dancer2::Cor...
- [Prancer::Database](https://metacpan.org/pod/Prancer::Database) is derived from [Dancer::Plugin::Database](https://metacpan.org/pod/Dancer::Plugin::Database). Thank you to David Precious.
- [Prancer::Request](https://metacpan.org/pod/Prancer::Request), [Prancer::Request::Upload](https://metacpan.org/pod/Prancer::Request::Upload), [Prancer::Response](https://metacpan.org/pod/Prancer::Response), [Prancer::Session](https://metacpan.org/p...
- The entire routing functionality of this module is offloaded to [Web::Simple](https://metacpan.org/pod/Web::Simple). Thank you to Matt Trout for some great code that I am able to easily leverage.
# COPYRIGHT
Copyright 2013, 2014 Paul Lockaby. All rights reserved.
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
# SEE ALSO
- [Plack](https://metacpan.org/pod/Plack)
- [Web::Simple](https://metacpan.org/pod/Web::Simple)
examples/bin/cliapp.pl view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings FATAL => 'all';
use Prancer::Core qw(config);
sub main {
# figure out where exist to make finding config files possible
my (undef, $root, undef) = File::Basename::fileparse($0);
# load config.yml and <environment>.yml out of the config path
my $app = Prancer::Core->new("${root}/../conf");
print "hello, world.\n";
print "what is foo? foo is " . config->get('foo') . "\n";
return;
}
main(@ARGV) unless caller;
1;
examples/bin/webapp.pl view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings FATAL => 'all';
use File::Basename ();
use Plack::Runner;
use MyApp;
sub main {
# figure out where exist to make finding config files possible
my (undef, $root, undef) = File::Basename::fileparse($0);
# load configurations out of /conf
my $myapp = MyApp->new("${root}/../conf");
$myapp->config->set('static', { 'dir' => "${root}/../static" });
# this just returns a PSGI application. $psgi can be wrapped with
# additional middleware before sending it along to Plack::Runner.
my $psgi = $myapp->to_psgi_app();
# run the psgi app through Plack and send it everything from @ARGV. this
# way Plack::Runner will get options like what listening port to use and
# application server to use -- Starman, Twiggy, etc.
my $runner = Plack::Runner->new();
$runner->parse_options(@_);
$runner->run($psgi);
return;
}
main(@ARGV) unless caller;
1;
examples/conf/config.yml view on Meta::CPAN
session:
state:
driver: Prancer::Session::State::Cookie
options:
session_key: PSESSION
store:
driver: Prancer::Session::Store::Storable
options:
dir: /tmp/prancer/sessions
static:
dir: /srv/www/resources
# here are MyApp configuration options
foo: bar
examples/conf/development.yml view on Meta::CPAN
session:
store:
# use the memory driver in dev
driver: Prancer::Session::Store::Memory
static:
# use the development resources directory in dev
dir: /home/paul/myapp-dev/resources
examples/lib/MyApp.pm view on Meta::CPAN
package MyApp;
use strict;
use warnings FATAL => 'all';
use Prancer qw(config);
sub initialize {
my $self = shift;
# in here we get to initialize things!
return;
}
sub handler {
my ($self, $env, $request, $response, $session) = @_;
# increment this counter every time the user requests a page
my $counter = $session->get('counter');
$counter ||= 0;
++$counter;
$session->set('counter', $counter);
sub (GET + /) {
$response->header('Location' => '/hello');
$response->finalize(301);
}, sub (GET + /hello) {
$response->header('Content-Type' => 'text/plain');
$response->body(sub {
my $writer = shift;
$writer->write("hello, world\n");
$writer->write("what is foo? foo is " . config->get('foo') . "\n");
$writer->write("what are we counting to? let's count to " . $counter . "\n");
$writer->close();
return;
});
return $response->finalize(200);
}, sub (GET + /goodbye) {
$response->header('Content-Type' => 'text/plain');
$response->body("Goodbye!");
return $response->finalize(200);
}
}
1;
examples/static/foo.txt view on Meta::CPAN
foo
lib/Prancer.pm view on Meta::CPAN
package Prancer;
use strict;
use warnings FATAL => 'all';
use version;
our $VERSION = '1.05';
# using Web::Simple in this context will implicitly make Prancer a subclass of
# Web::Simple::Application. that will cause a number of things to be imported
# into the Prancer namespace. see ->import below for more details.
use Web::Simple 'Prancer';
use Cwd ();
use Module::Load ();
use Try::Tiny;
use Carp;
use Prancer::Core;
use Prancer::Request;
use Prancer::Response;
use Prancer::Session;
# even though this *should* work automatically, it was not
our @CARP_NOT = qw(Prancer Try::Tiny);
# the list of methods that will be created on the fly, linked to private
# methods of the same name, and exported to the caller. this makes things like
# the bareword call to "config" work. this list is populated in ->import
our @TO_EXPORT = ();
# a super private method
my $enable_static = sub {
my ($self, $app) = @_;
return $app unless defined($self->{'_core'}->config());
my $config = $self->{'_core'}->config->get('static');
return $app unless defined($config);
try {
# this intercepts requests for documents under the configured URL
# and checks to see if the requested file exists in the configured
# file system path. if it does exist then it is served up. if it
# doesn't exist then the request will pass through to the handler.
die "no directory is configured for the static file loader\n" unless defined($config->{'dir'});
my $dir = Cwd::realpath($config->{'dir'});
die "${\$config->{'dir'}} does not exist\n" unless defined($dir);
die "${\$config->{'dir'}} is not readable\n" unless (-r $dir);
# this is the url under which static files will be stored
my $path = $config->{'path'} || '/static';
require Plack::Middleware::Static;
$app = Plack::Middleware::Static->wrap($app,
'path' => sub { s/^$path//x },
'root' => $dir,
'pass_through' => 1,
);
} catch {
my $error = (defined($_) ? $_ : "unknown");
carp "initialization warning generated while trying to load the static file loader: ${error}";
};
return $app;
};
# a super private method
my $enable_sessions = sub {
my ($self, $app) = @_;
return $app unless defined($self->{'_core'}->config());
my $config = $self->{'_core'}->config->get('session');
return $app unless defined($config);
try {
# load the session state package first
# this will probably be a cookie
my $state_package = undef;
my $state_options = undef;
if (ref($config->{'state'}) && ref($config->{'state'}) eq "HASH") {
$state_package = $config->{'state'}->{'driver'};
$state_options = $config->{'state'}->{'options'};
}
# make sure state options are legit
if (defined($state_options) && (!ref($state_options) || ref($state_options) ne "HASH")) {
die "session state configuration options are invalid -- expected a HASH\n";
}
# set defaults and then load the state package
$state_package ||= "Prancer::Session::State::Cookie";
$state_options ||= {};
Module::Load::load($state_package);
# set the default for the cookie name because the plack default is dumb
$state_options->{'session_key'} ||= (delete($state_options->{'key'}) || "PSESSION");
# now load the store package
my $store_package = undef;
my $store_options = undef;
if (ref($config->{'store'}) && ref($config->{'store'}) eq "HASH") {
$store_package = $config->{'store'}->{'driver'};
$store_options = $config->{'store'}->{'options'};
}
# make sure store options are legit
if (defined($store_options) && (!ref($store_options) || ref($store_options) ne "HASH")) {
die "session store configuration options are invalid -- expected a HASH\n";
}
# set defaults and then load the store package
$store_package ||= "Prancer::Session::Store::Memory";
$store_options ||= {};
Module::Load::load($store_package);
require Plack::Middleware::Session;
$app = Plack::Middleware::Session->wrap($app,
'state' => $state_package->new(%{$state_options}),
'store' => $store_package->new(%{$store_options}),
);
} catch {
my $error = (defined($_) ? $_ : "unknown");
carp "initialization warning generated while trying to load the session handler: ${error}";
};
return $app;
};
sub new {
my ($class, $configuration_file) = @_;
my $self = bless({}, $class);
# the core is where our methods *really* live
# we mostly just proxy through to that
$self->{'_core'} = Prancer::Core->new($configuration_file);
# @TO_EXPORT is an array of arrayrefs representing methods that we want to
# make available in our caller's namespace. each arrayref has two values:
#
# 0 = namespace into which we'll import the method
# 1 = the method that will be imported (must be implemented in Prancer::Core)
#
# this makes "namespace::method" resolve to "$self->{'_core'}->method()".
for my $method (@TO_EXPORT) {
# don't import things that can't be resolved
croak "Prancer::Core does not implement ${\$method->[1]}" unless $self->{'_core'}->can($method->[1]);
no strict 'refs';
no warnings 'redefine';
*{"${\$method->[0]}::${\$method->[1]}"} = sub {
my $internal = "${\$method->[1]}";
return $self->{'_core'}->$internal(@_);
};
}
# here are things that will always be exported into the Prancer namespace.
# this DOES NOT export things things into our children's namespace, only
# into the Prancer namespace. this makes things like "$app->config()" work.
for my $method (qw(config)) {
# don't export things that can't be resolved
croak "Prancer::Core does not implement ${\$method->[1]}" unless $self->{'_core'}->can($method);
no strict 'refs';
no warnings 'redefine';
*{"${\__PACKAGE__}::${method}"} = sub {
return $self->{'_core'}->$method(@_);
};
}
$self->initialize();
return $self;
}
sub import {
my ($class, @options) = @_;
# store what namespace are importing things to
my $namespace = caller(0);
{
# this block makes our caller a child class of this class
no strict 'refs';
unshift(@{"${namespace}::ISA"}, __PACKAGE__);
}
# this is used by Web::Simple to not complain about keywords in prototypes
# like HEAD and GET. but we need to extend it to classes that implement us
# so it is being adding it here, too.
warnings::illegalproto->unimport();
# keep track of what has been loaded so someone doesn't put the same thing
# into the import list in twice.
my $loaded = {};
my @actions = ();
for my $option (@options) {
next if exists($loaded->{$option});
$loaded->{$option} = 1;
# these options will be exported as proxies to real methods
if ($option =~ /^(config)$/x) {
no strict 'refs';
# need to predefine the exported method so that barewords work
*{"${\__PACKAGE__}::${1}"} = *{"${namespace}::${1}"} = sub { return; };
# this will tell ->new() to create the actual method
push(@TO_EXPORT, [ $namespace, $1 ]);
next;
}
croak "${option} is not exported by the ${\__PACKAGE__} package";
}
return;
}
sub to_psgi_app {
my $self = shift;
croak "cannot call ->to_psgi_app before calling ->new" unless (ref($self) && $self->isa(__PACKAGE__));
# get the PSGI app from Web::Simple and wrap middleware around it
my $app = $self->SUPER::to_psgi_app();
# enable static document loading
$app = $enable_static->($self, $app);
# enable sessions
$app = $enable_sessions->($self, $app);
return $app;
}
# NOTE: your program can definitely implement ->dispatch_request instead of
# ->handler but ->handler will give you easier access to request and response
# data using Prancer::Request and Prancer::Response.
sub dispatch_request {
my ($self, $env) = @_;
my $request = Prancer::Request->new($env);
my $response = Prancer::Response->new();
my $session = Prancer::Session->new($env);
return $self->handler($env, $request, $response, $session);
}
sub handler {
croak "->handler must be implemented in child class";
}
sub initialize {
return;
}
1;
=head1 NAME
Prancer
=head1 SYNOPSIS
When using as part of a web application:
===> foobar.yml
session:
state:
driver: Prancer::Session::State::Cookie
options:
session_key: PSESSION
store:
driver: Prancer::Session::Store::Storable
options:
dir: /tmp/prancer/sessions
static:
path: /static
dir: /srv/www/resources
===> myapp.psgi
#!/usr/bin/env perl
use strict;
use warnings;
use Plack::Runner;
# this just returns a PSGI application. $x can be wrapped with additional
# middleware before sending it along to Plack::Runner.
my $x = MyApp->new("/path/to/foobar.yml")->to_psgi_app();
# run the psgi app through Plack and send it everything from @ARGV. this
# way Plack::Runner will get options like what listening port to use and
# application server to use -- Starman, Twiggy, etc.
my $runner = Plack::Runner->new();
$runner->parse_options(@ARGV);
$runner->run($x);
===> MyApp.pm
package MyApp;
use strict;
use warnings;
use Prancer qw(config);
sub initialize {
my $self = shift;
# in here we can initialize things like plugins
# but this method is not required to be implemented
return;
}
sub handler {
my ($self, $env, $request, $response, $session) = @_;
sub (GET + /) {
$response->header("Content-Type" => "text/plain");
$response->body("Hello, world!");
return $response->finalize(200);
}, sub (GET + /foo) {
$response->header("Content-Type" => "text/plain");
$response->body(sub {
my $writer = shift;
$writer->write("Hello, world!");
$writer->close();
return;
});
}
}
1;
If you save the above snippet as C<myapp.psgi> and run it like this:
plackup myapp.psgi
You will get "Hello, world!" in your browser. Or you can use Prancer as part of
a standalone command line application:
#!/usr/bin/env perl
use strict;
use warnings;
use Prancer::Core qw(config);
# the advantage to using Prancer in a standalone application is the ability
# to use a standard configuration and to load plugins for things like
# loggers and database connectors and template engines.
my $x = Prancer::Core->new("/path/to/foobar.yml");
print "Hello, world!;
=head1 DESCRIPTION
Prancer is yet another PSGI framework that provides routing and session
management as well as plugins for logging, database access, and template
engines. It does this by wrapping L<Web::Simple> to handle routing and by
wrapping other libraries to bring easy access to things that need to be done in
web applications.
There are two parts to using Prancer for a web application: a package to
contain your application and a script to call your application. Both are
necessary.
The package containing your application should contain a line like this:
use Prancer;
This modifies your application package such that it inherits from Prancer. It
also means that your package must implement the C<handler> method and
optionally implement the C<initialize> method. As Prancer inherits from
Web::Simple it will also automatically enable the C<strict> and C<warnings>
pragmas.
As mentioned, putting C<use Prancer;> at the top of your package will require
you to implement the C<handler> method, like this:
sub handler {
my ($self, $env, $request, $response, $session) = @_;
# routing goes in here.
# see Web::Simple for documentation on writing routing rules.
sub (GET + /) {
$response->header("Content-Type" => "text/plain");
$response->body("Hello, world!");
return $response->finalize(200);
}
}
The C<$request> variable is a L<Prancer::Request> object. The C<$response>
variable is a L<Prancer::Response> object. The C<$session> variable is a
L<Prancer::Session> object. If there is no configuration for sessions in any of
your configuration files then C<$session> will be C<undef>.
You may implement your own C<new> method in your application but you B<MUST>
call C<$class-E<gt>SUPER::new(@_);> to get the configuration file loaded and
any methods exported. As an alternative to implemeting C<new> and remembering
to call C<SUPER::new>, Prancer will make a call to C<-E<gt>initialize> at the
end of its own implementation of C<new> so things that you might put in C<new>
can instead be put into C<initialize>, like this:
sub initialize {
my $self = shift;
# this is where you can initialize things when your package is created
return;
}
By default, Prancer does not export anything into your package's namespace.
However, that doesn't mean that there is not anything that it I<could> export
were one to ask:
use Prancer qw(config);
Importing C<config> will make the keyword C<config> available which gives
access to any configuration options loaded by Prancer.
The second part of the Prancer equation is the script that creates and calls
your package. This can be a pretty small and standard little script, like this:
my $myapp = MyApp->new("/path/to/foobar.yml")
my $psgi = $myapp->to_psgi_app();
C<$myapp> is just an instance of your package. You can pass to C<new> either
one specific configuration file or a directory containing lots of configuration
files. The functionality is documented in C<Prancer::Config>.
C<$psgi> is just a PSGI app that you can send to L<Plack::Runner> or whatever
you use to run PSGI apps. You can also wrap middleware around C<$app>.
my $psgi = $myapp->to_psgi_app();
$psgi = Plack::Middleware::Runtime->wrap($psgi);
=head1 CONFIGURATION
Prancer needs a configuration file. Ok, it doesn't I<need> a configuration
file. By default, Prancer does not require any configuration. But it is less
useful without one. You I<could> always create your application like this:
my $app = MyApp->new->to_psgi_app();
How Prancer loads configuration files is documented in L<Prancer::Config>.
Anything you put into your configuration file is available to your application.
There are two special configuration keys reserved by Prancer. The key
C<session> will configure Prancer's session as documented in
L<Prancer::Session>. The key C<static> will configure static file loading
through L<Plack::Middleware::Static>.
To configure static file loading you can add this to your configuration file:
static:
path: /static
dir: /path/to/my/resources
The C<dir> option is required to indicate the root directory for your static
resources. The C<path> option indicates the web path to link to your static
resources. If no path is not provided then static files can be accessed under
C</static> by default.
=head1 CREDITS
This module could have been written except on the shoulders of the following
giants:
=over
=item
The name "Prancer" is a riff on the popular PSGI framework L<Dancer> and
L<Dancer2>. L<Prancer::Config> is derived directly from
L<Dancer2::Core::Role::Config>. Thank you to the Dancer/Dancer2 teams.
=item
L<Prancer::Database> is derived from L<Dancer::Plugin::Database>. Thank you to
David Precious.
=item
L<Prancer::Request>, L<Prancer::Request::Upload>, L<Prancer::Response>,
L<Prancer::Session> and the session packages are but thin wrappers with minor
modifications to L<Plack::Request>, L<Plack::Request::Upload>,
L<Plack::Response>, and L<Plack::Middleware::Session>. Thank you to Tatsuhiko
Miyagawa.
=item
The entire routing functionality of this module is offloaded to L<Web::Simple>.
Thank you to Matt Trout for some great code that I am able to easily leverage.
=back
=head1 COPYRIGHT
Copyright 2013, 2014 Paul Lockaby. All rights reserved.
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=head1 SEE ALSO
=over
=item
L<Plack>
=item
L<Web::Simple>
=back
=cut
lib/Prancer/Config.pm view on Meta::CPAN
package Prancer::Config;
use strict;
use warnings FATAL => 'all';
use version;
our $VERSION = '1.05';
use File::Spec;
use Config::Any;
use Storable qw(dclone);
use Try::Tiny;
use Carp;
# even though this *should* work automatically, it was not
our @CARP_NOT = qw(Prancer Try::Tiny);
sub load {
my ($class, $path) = @_;
my $self = bless({}, $class);
# find config files, load them
my $files = $self->_build_file_list($path);
$self->{'_config'} = $self->_load_config_files($files);
return $self;
}
sub has {
my ($self, $key) = @_;
return exists($self->{'_config'}->{$key});
}
sub get {
my ($self, $key, $default) = @_;
# only return things if the are running in a non-void context
if (defined(wantarray())) {
my $value = undef;
# if ->get is called without any arguments then this will return all
# config values as either a hash or a hashref. used by template engines
# to merge config values into the template vars.
if (!defined($key)) {
return wantarray ? %{$self->{'_config'}} : $self->{'_config'};
}
if (exists($self->{'_config'}->{$key})) {
$value = $self->{'_config'}->{$key};
} else {
$value = $default;
}
# nothing to return
return unless defined($value);
# make a clone to avoid changing things
# through inadvertent references.
$value = dclone($value) if ref($value);
if (wantarray() && ref($value)) {
# return a value rather than a reference
if (ref($value) eq "HASH") {
return %{$value};
}
if (ref($value) eq "ARRAY") {
return @{$value};
}
}
# return a reference
return $value;
}
return;
}
sub set {
my ($self, $key, $value) = @_;
my $old = undef;
$old = $self->get($key) if defined(wantarray());
if (ref($value)) {
# make a copy of the original value to avoid inadvertently changing
# things through inadvertent references
$self->{'_config'}->{$key} = dclone($value);
} else {
# can't clone non-references
$self->{'_config'}->{$key} = $value;
}
if (wantarray() && ref($old)) {
# return a value rather than a reference
if (ref($old) eq "HASH") {
return %{$old};
}
if (ref($old) eq "ARRAY") {
return @{$old};
}
}
return $old;
}
sub remove {
my ($self, $key) = @_;
my $old = undef;
$old = $self->get($key) if defined(wantarray());
delete($self->{'_config'}->{$key});
if (wantarray() && ref($old)) {
# return a value rather than a reference
if (ref($old) eq "HASH") {
return %{$old};
}
if (ref($old) eq "ARRAY") {
return @{$old};
}
}
return $old;
}
sub _build_file_list {
my ($self, $path) = @_;
# an undef location means no config files for the caller
return [] unless defined($path);
# if the path is a file or a link then there is only one config file
return [ $path ] if (-e $path && (-f $path || -l $path));
# since we already handled files/symlinks then if the path is not a
# directory then there is very little we can do
return [] unless (-d $path);
# figure out what environment we are operating in by looking in several
# well known (to the PSGI world) environment variables. if none of them
# exist then we are probably in dev.
my $env = $ENV{'ENVIRONMENT'} || $ENV{'PLACK_ENV'} || "development";
my @files = ();
for my $ext (Config::Any->extensions()) {
for my $file (
[ $path, "config.${ext}" ],
[ $path, "${env}.${ext}" ]
) {
my $file_path = _normalize_file_path(@{$file});
push(@files, $file_path) if (-r $file_path);
}
}
return \@files;
}
sub _load_config_files {
my ($self, $files) = @_;
return _merge(
map { $self->_load_config_file($_) } @{$files}
);
}
sub _load_config_file {
my ($self, $file) = @_;
my $config = {};
try {
my @files = ($file);
my $tmp = Config::Any->load_files({
'files' => \@files,
'use_ext' => 1,
})->[0];
($file, $config) = %{$tmp} if defined($tmp);
} catch {
my $error = (defined($_) ? $_ : "unknown");
croak "unable to parse ${file}: ${error}";
};
return $config;
}
sub _normalize_file_path {
my $path = File::Spec->catfile(@_);
# this is a revised version of what is described in
# http://www.linuxjournal.com/content/normalizing-path-names-bash
# by Mitch Frazier
my $seqregex = qr{
[^/]* # anything without a slash
/\.\.(/|\z) # that is accompanied by two dots as such
}x;
$path =~ s{/\./}{/}gx;
$path =~ s{$seqregex}{}gx;
$path =~ s{$seqregex}{}x;
# see https://rt.cpan.org/Public/Bug/Display.html?id=80077
$path =~ s{^//}{/}x;
return $path;
}
# stolen from Hash::Merge::Simple
sub _merge {
my ($left, @right) = @_;
return $left unless @right;
return _merge($left, _merge(@right)) if @right > 1;
my ($right) = @right;
my %merged = %{$left};
for my $key (keys %{$right}) {
my ($hr, $hl) = map { ref($_->{$key}) eq "HASH" } $right, $left;
if ($hr and $hl) {
$merged{$key} = _merge($left->{$key}, $right->{$key});
} else {
$merged{$key} = $right->{$key};
}
}
return \%merged;
}
1;
=head1 NAME
Prancer::Config
=head1 SYNOPSIS
# load a configuration file when creating a PSGI application
# this loads only one configuration file
my $psgi = Foo->new("/path/to/foobar.yml")->to_psgi_app();
# just load the configuration and use it wherever
# this loads all configuration files from the given path using logic
# described below to figure out which configuration files take precedence
my $app = Prancer::Core->new("/path/to/mysite/conf");
# the configuration can be accessed as either a global method or as an
# instance method, depending on how you loaded Prancer
print $app->config->get('foo');
print config->get('bar');
=head1 DESCRIPTION
Prancer uses L<Config::Any> to process configuration files. Anything supported
by that will be supported by this. It will load configuration files from the
configuration file or from configuration files in a path based on what you set
when you create your application.
To find configuration files from given directory, Prancer::Config follows this
logic. First, it will look for a file named C<config.ext> where C<ext> is
something like C<yml> or C<ini>. Then it will look for a file named after the
currently defined environment like C<develoment.ext> or C<production.ext>. The
environment is determined by looking first for an environment variable called
C<ENVIRONMENT> and then for an environment variable called C<PLACK_ENV>. If
neither of those exist then the default is C<development>.
Configuration files will be merged such that configuration values pulled out of
the environment configuration file will take precedence over values from the
global configuration file. For example, if you have two configuration files:
config.ini
==========
foo = bar
baz = bat
development.ini
===============
foo = bazbat
After loading these configuration files the value for C<foo> will be C<bazbat>
and the value for C<baz> will be C<bat>.
If you just have one configuration file and have no desire to load multiple
configuration files based on environments you can specify a file rather than a
directory when your application is created.
Arbitrary configuration directives can be put into your configuration files
and they can be accessed like this:
$config->get('foo');
The configuration accessors will only give you the configuration directives
found at the root of the configuration file. So if you use any data structures
you will have to decode them yourself. For example, if you create a YAML file
like this:
foo:
bar1: asdf
bar2: fdsa
Then you will only be able to get the value to C<bar1> like this:
my $foo = config->get('foo')->{'bar1'};
=head2 Reserved Configuration Options
To support the components of Prancer, some keys are otherwise "reserved" in
that you aren't able to use them. For example, trying to use the config key
C<session> will only result in sessions being enabled and you not able to see
your configuration values. These reserved keys are: C<session> and C<static>.
=head1 METHODS
=over
=item has I<key>
This will return true if the named key exists in the configuration:
if ($config->has('foo')) {
print "I see you've set foo already.\n";
}
It will return false otherwise.
=item get I<key> [I<default>]
The get method takes two arguments: a key and a default value. If the key does
not exist then the default value will be returned instead. If the value in the
configuration is a reference then a clone of the value will be returned to
avoid modifying the configuration in a strange way. Additionally, this method
is context sensitive.
my $foo = $config->get('foo');
my %bar = $config->get('bar');
my @baz = $config->get('baz');
=item set I<key> I<value>
The set method takes two arguments: a key and a value. If the key already
exists in the configuration then it will be overwritten and the old value will
be returned in a context sensitive way. If the value is a reference then it
will be cloned before being saved into the configuration to avoid any
strangeness.
my $old_foo = $config->set('foo', 'bar');
my %old_bar = $config->set('bar', { 'baz' => 'bat' });
my @old_baz = $config->set('baz', [ 'foo', 'bar', 'baz' ]);
$config->set('whatever', 'do not care');
=item remove I<key>
The remove method takes one argument: the key to remove. The value that was
removed will be returned in a context sensitive way.
=back
=head1 SEE ALSO
=over
=item L<Config::Any>
=back
=cut
lib/Prancer/Core.pm view on Meta::CPAN
package Prancer::Core;
use strict;
use warnings FATAL => 'all';
use version;
our $VERSION = '1.05';
use Try::Tiny;
use Carp;
use Prancer::Config;
use parent qw(Exporter);
our @EXPORT_OK = qw(config);
# even though this *should* work automatically, it was not
our @CARP_NOT = qw(Prancer Try::Tiny);
sub new {
my ($class, $configuration_file) = @_;
# already got an object
return $class if ref($class);
# this is a singleton
my $instance = undef;
{
no strict 'refs';
$instance = \${"${class}::_instance"};
return $$instance if defined($$instance);
}
# ok so the singleton doesn't exist so create an instance
my $self = bless({}, $class);
# load configuration options if we were given a config file
if (defined($configuration_file)) {
$self->{'_config'} = Prancer::Config->load($configuration_file);
}
$$instance = $self;
return $self;
}
sub initialized {
my $class = shift;
no strict 'refs';
return (${"${class}::_instance"} ? 1 : 0);
}
sub config {
die "core has not been initialized\n" unless Prancer::Core->initialized();
# because this method takes no arguments we don't spend any effort trying
# to figure out if the first argument is an instance of the package or the
# name of the package or anything like that. and because the previous
# statement guarantees that we've already been initialized then we'll just
# get an instance of ourselves and use that. no muss, no fuss.
my $self = Prancer::Core->new();
return $self->{'_config'};
}
1;
=head1 NAME
Prancer::Core
=head1 SYNOPSIS
use Prancer::Core qw(config);
my $core = Prancer::Core->new('/path/to/config.yml');
my $foo = $core->config->get('foo');
my $bar = Prancer::Core->new->config->get('bar');
my $baz = config->get('baz');
=head1 DESCRIPTION
This class is a singleton that contains some core methods for L<Prancer> to
more easily function. This package can be initialized and used on its own if
you want to use L<Prancer> outside of a PSGI application.
=head1 METHODS
=over
=item initialized
Since this package is a singleton, it might happen that you have a place in
your code where you try to use a method from this package before you are able
to initialize it with the necessary arguments to C<new>. This will tell you if
this package has been initialized.
die "core has not been initialized" unless Prancer::Core->initialized();
print Prancer::Core->new->config->get('foo');
=item config
Returns the configuration options parsed when this package was initialized. See
L<Prancer::Config> for more details on how to load and use the configuration
data.
=back
=cut
lib/Prancer/Plugin.pm view on Meta::CPAN
package Prancer::Plugin;
use strict;
use warnings FATAL => 'all';
use version;
our $VERSION = '1.05';
use Prancer::Core;
sub config {
die "core has not been initialized\n" unless Prancer::Core->initialized();
return Prancer::Core->new->config();
}
1;
=head1 NAME
Prancer::Plugin
=head1 SYNOPSIS
This should be the base class for all plugins used with Prancer. It provides
the convenience methods shown below to plugins that inherit from it.
=head1 METHODS
=over
=item config
Returns the application's current configuration. See L<Prancer::Config> for
more details on how to use this method. This method be called statically or
as an instance method. This method will C<die> if L<Prancer::Core> has not
been initialized.
=back
=cut
lib/Prancer/Request.pm view on Meta::CPAN
package Prancer::Request;
use strict;
use warnings FATAL => 'all';
use version;
our $VERSION = '1.05';
use Plack::Request;
use Hash::MultiValue;
use URI::Escape ();
use Carp;
use Prancer::Request::Upload;
# even though this *should* work automatically, it was not
our @CARP_NOT = qw(Prancer Try::Tiny);
sub new {
my ($class, $env) = @_;
my $self = bless({
'_env' => $env,
'_request' => Plack::Request->new($env),
}, $class);
# make instances of these and return those. these calls create new URI objects
# with every invocation so this should avoid creating unnecessary objects later
$self->{'_uri'} = $self->{'_request'}->uri();
$self->{'_base'} = $self->{'_request'}->base();
# other manipulation routines
$self->{'_uploads'} = $self->_parse_uploads();
$self->{'_cookies'} = $self->_parse_cookies();
return $self;
}
sub _parse_uploads {
my $self = shift;
# turn all uploads into Prancer::Upload objects
my $result = Hash::MultiValue->new();
my $uploads = $self->{'_request'}->uploads();
for my $key (keys %{$uploads}) {
$result->add($key, map { Prancer::Request::Upload->new($_) } $uploads->get_all($key));
}
return $result;
}
sub _parse_cookies {
my $self = shift;
my $result = Hash::MultiValue->new();
return $result unless defined($self->{'_env'}->{'HTTP_COOKIE'});
# translate all cookies
my @pairs = grep { m/=/x } split(/[;,]\s?/x, $self->{'_env'}->{'HTTP_COOKIE'});
for my $pair (@pairs) {
# trim leading and trailing whitespace
$pair =~ s/^\s+|\s+$//xg;
my ($key, $value) = map { URI::Escape::uri_unescape($_) } split(/=/x, $pair, 2);
$result->add($key, $value);
}
return $result;
}
sub env {
my $self = shift;
return $self->{'_env'};
}
sub uri {
my $self = shift;
return $self->{'_uri'};
}
sub base {
my $self = shift;
return $self->{'_base'};
}
sub method {
my $self = shift;
return $self->{'_request'}->method();
}
sub protocol {
my $self = shift;
return $self->{'_request'}->protocol();
}
sub scheme {
my $self = shift;
return $self->{'_request'}->scheme();
}
sub port {
my $self = shift;
return $self->{'_request'}->port();
}
sub secure {
my $self = shift;
return ($self->{'_request'}->secure() ? 1 : 0);
}
sub path {
my $self = shift;
return $self->{'_request'}->path();
}
sub body {
my $self = shift;
return $self->{'_request'}->body();
}
sub content {
my $self = shift;
return $self->{'_request'}->raw_body();
}
sub address {
my $self = shift;
return $self->{'_request'}->address();
}
sub user {
my $self = shift;
return $self->{'_request'}->user();
}
sub headers {
my $self = shift;
return $self->{'_request'}->headers();
}
sub param {
my $self = shift;
# return the keys if nothing is asked for
return keys %{$self->params()} unless @_;
my $key = shift;
return $self->params->get($key) unless wantarray;
return $self->params->get_all($key);
}
sub params {
my $self = shift;
return $self->{'_request'}->parameters();
}
sub cookie {
my $self = shift;
# return the keys if nothing is asked for
return keys %{$self->cookies()} unless @_;
my $key = shift;
return $self->cookies->get($key) unless wantarray;
return $self->cookies->get_all($key);
}
sub cookies {
my $self = shift;
return $self->{'_cookies'};
}
sub upload {
my $self = shift;
# return the keys if nothing is asked for
return keys %{$self->uploads()} unless @_;
my $key = shift;
return $self->uploads->get($key) unless wantarray;
return $self->uploads->get_all($key);
}
sub uploads {
my $self = shift;
return $self->{'_uploads'};
}
sub uri_for {
my ($self, $path, $args) = @_;
my $uri = URI->new($self->base());
# don't want multiple slashes clouding things up
if ($uri->path() =~ /\/$/x && $path =~ /^\//x) {
$path = substr($path, 1);
}
$uri->path($uri->path() . $path);
$uri->query_form(@{$args}) if $args;
return $uri;
}
1;
=head1 NAME
Prancer::Request
=head1 SYNOPSIS
sub handler {
my ($self, $env, $request, $response, $session) = @_;
sub (GET) {
my $path = $request->path();
my $cookie = $request->cookie("foo");
my $param = $request->param("bar");
my $cookie_names = $request->cookie();
my $user_agent = $request->headers->header("user-agent");
...
return $response->finalize(200);
}
}
=head1 METHODS
=over
=item uri
Returns an URI object for the current request. The URI is constructed using
various environment values such as C<SCRIPT_NAME>, C<PATH_INFO>,
C<QUERY_STRING>, C<HTTP_HOST>, C<SERVER_NAME> and C<SERVER_PORT>.
=item base
Returns a URI object for the base path of current request. This is like C<uri>
but only contains up to C<SCRIPT_NAME> where your application is hosted at.
=item method
Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
=item protocol
Returns the protocol (C<HTTP/1.0> or C<HTTP/1.1>) used for the current request.
=item scheme
Returns the scheme (C<http> or C<https>) of the request.
=item secure
Returns true or false, indicating whether the connection is secure (C<https>).
=item path
Returns B<PATH_INFO> in the environment but returns / in case it is empty.
=item body
Returns a handle to the input stream.
=item address
Returns the IP address of the client (C<REMOTE_ADDR>).
=item user
Returns C<REMOTE_USER> if it's set.
=item headers
Returns an L<HTTP::Headers::Fast> object containing the headers for the current
request.
=item param
When called with no arguments this will return a list of all parameter names.
When called in scalar context this will return the last value for the given
key. When called in list context this will return all values for the given key
in a list.
=item params
Returns a L<Hash::MultiValue> hash reference containing the merged GET and POST
parameters.
=item cookie
When called with no arguments this will return a list of all cookie names.
When called in scalar context this will return the last cookie for the given
key. When called in list context this will return all cookies for the given
key in a list.
=item cookies
Returns an L<Hash::MultiValue> containing all cookies.
=item upload
When called with no arguments this will return a list of all upload names.
When called in scalar context this will return the last
L<Prancer::Request::Upload> object for the given key. When called in list
context this will return all L<Prancer::Request::Upload> objects for the given
key.
=item uploads
Returns an L<Hash::MultiValue> containing all uploads.
=item uri_for
Generates a URL to a new location in an easy to use manner. For example:
my $link = $request->uri_for("/logout", [ signoff => 1 ]);
=back
=cut
lib/Prancer/Request/Upload.pm view on Meta::CPAN
package Prancer::Request::Upload;
use strict;
use warnings FATAL => 'all';
use version;
our $VERSION = '1.05';
use Carp;
# even though this *should* work automatically, it was not
our @CARP_NOT = qw(Prancer Try::Tiny);
sub new {
my ($class, $upload) = @_;
return bless({ '_upload' => $upload }, $class);
}
sub filename {
my $self = shift;
return $self->{'_upload'}->filename();
}
sub size {
my $self = shift;
return $self->{'_upload'}->size();
}
sub path {
my $self = shift;
return $self->{'_upload'}->path();
}
sub content_type {
my $self = shift;
return $self->{'_upload'}->content_type();
}
1;
=head1 NAME
Prancer::Request::Upload
=head1 SYNOPSIS
Uploads come from the L<Prancer::Request> object passed to your handler. They
can be used like this:
# in your HTML
<form method="POST" enctype="multipart/form-data">
<input type="file" name="foobar" />
</form>
# in the Prancer handler
my $upload = $request->upload("foo");
=head1 METHODS
=over
=item size
Returns the size of uploaded file.
=item path
Returns the path to the temporary file where uploaded file is saved.
=item content_type
Returns the content type of the uploaded file.
=item filename
Returns the original filename in the client.
=back
=cut
lib/Prancer/Response.pm view on Meta::CPAN
package Prancer::Response;
use strict;
use warnings FATAL => 'all';
use version;
our $VERSION = '1.05';
use Plack::Response;
use Hash::MultiValue;
use URI::Escape ();
use HTTP::Headers::Fast;
use Carp;
# even though this *should* work automatically, it was not
our @CARP_NOT = qw(Prancer Try::Tiny);
sub new {
my $class = shift;
return bless({
'_response' => Plack::Response->new(),
'_cookies' => Hash::MultiValue->new(),
'_headers' => Hash::MultiValue->new(),
}, $class);
}
# set a single header
# or get all the keys
sub header {
my $self = shift;
# if we are given multiple args assume they are headers in key/value pairs
croak "odd number of headers" unless (@_ % 2 == 0);
while (@_) {
my ($key, $value) = (shift(@_), shift(@_));
$self->headers->add($key => [@{$self->headers->get_all($key) || []}, $value]);
}
return;
}
# get all the headers that have been set
sub headers {
my $self = shift;
return $self->{'_headers'};
}
# set a single cookie
# or get all the keys
sub cookie {
my $self = shift;
# return the keys if nothing is asked for
return keys(%{$self->cookies()}) unless @_;
# if given just a key then return that
if (@_ == 1) {
my $key = shift;
return $self->cookies->{$key} unless wantarray;
return $self->cookies->get_all($key);
}
# if we are given multiple args assume they are cookies in key/value pairs
croak "odd number of cookies" unless (@_ % 2 == 0);
while (@_) {
my ($key, $value) = (shift(@_), shift(@_));
# take a moment to validate the cookie
# TODO
$self->cookies->add($key => [@{$self->cookies->get_all($key) || []}, $value]);
}
return;
}
sub cookies {
my $self = shift;
return $self->{'_cookies'};
}
sub body {
my $self = shift;
# make the response be a callback
if (ref($_[0]) && ref($_[0]) eq "CODE") {
$self->{'_callback'} = shift;
return;
}
# just add this to the body, whatever it is
return $self->{'_response'}->body(@_);
}
sub finalize {
my ($self, $status) = @_;
$self->{'_response'}->status($status);
# build the headers using something normal and then add them to the
# response later. for whatever reason plack is being weird about this when
# the same header name is being used more than once. though, i might be
# doing it wrong.
my $headers = HTTP::Headers::Fast->new();
# add normal headers
for my $key (keys %{$self->headers()}) {
for my $value (@{$self->headers->get_all($key)}) {
$headers->push_header($key => $value);
}
}
# add cookies
for my $key (keys %{$self->cookies()}) {
for my $value (@{$self->cookies->get_all($key)}) {
$headers->push_header("Set-Cookie" => $self->_bake_cookie($key, $value));
}
}
# now add the headers we've compiled
$self->{'_response'}->headers($headers);
if (ref($self->{'_callback'}) &&
ref($self->{'_callback'}) eq "CODE") {
# the extra array ref brackets around the sub are because Web::Simple,
# which we use as the router, will not do a callback without them. by
# returning an array ref we are telling Web::Simple that we are giving
# it a PSGI response. from the Web::Simple docs:
#
# Well, a sub is a valid PSGI response too (for ultimate streaming
# and async cleverness). If you want to return a PSGI sub you have
# to wrap it into an array ref.
#
return [ sub {
my $responder = shift;
# this idiom here borrows heavily from the documentation on this
# blog post, by tatsuhiko miyagawa:
#
# http://bulknews.typepad.com/blog/2009/10/psgiplack-streaming-is-now-complete.html
#
# this effectively allows the user of this api to stream data to
# the client.
# finalize will always return a three element array. the third
# element is supposed to be the body. because we don't have a body
# yet (it's in the callback), this uses splice to exclude the third
# element (aka the body) and just return the status code and the
# list of headers.
my $writer = $responder->([splice(@{$self->{'_response'}->finalize()}, 0, 2)]);
return $self->{'_callback'}->($writer);
} ];
}
# just return a normal response
return $self->{'_response'}->finalize();
}
sub _bake_cookie {
my ($self, $key, $value) = @_;
my @cookie = (URI::Escape::uri_escape($key) . "=" . URI::Escape::uri_escape($value->{'value'}));
push(@cookie, "domain=" . $value->{'domain'}) if $value->{'domain'};
push(@cookie, "path=" . $value->{'path'}) if $value->{'path'};
push(@cookie, "expires=" . $self->_cookie_date($value->{'expires'})) if $value->{'expires'};
push(@cookie, "secure") if $value->{'secure'};
push(@cookie, "HttpOnly") if $value->{'httponly'};
return join("; ", @cookie);
}
my @MON = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
my @WDAY = qw( Sun Mon Tue Wed Thu Fri Sat );
sub _cookie_date {
my ($self, $expires) = @_;
if ($expires =~ /^\-?\d+$/x) {
# all numbers -> epoch date
# (cookies use '-' as date separator, HTTP uses ' ')
my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($expires);
$year += 1900;
return sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
$WDAY[$wday], $mday, $MON[$mon], $year, $hour, $min, $sec);
}
return $expires;
}
1;
=head1 NAME
Prancer::Response
=head1 SYNOPSIS
sub handler {
my ($self, $env, $request, $response, $session) = @_;
...
sub (GET) {
$response->header("Content-Type" => "text/plain");
$response->body("hello, goodbye");
return $response->finalize(200);
}
}
# or using a callback
sub handler {
...
sub (GET) {
$response->header("Content-Type" => "text/plain");
$response->body(sub {
my $writer = shift;
$writer->write("What is up?");
$writer->close();
});
return $response->finalize(200);
}
}
=head1 METHODS
=over
=item header
This method expects a list of headers to add to the response. For example:
$response->header("Content-Type" => "text/plain");
$response->header("Content-Length" => 1234, "X-Foo" => "bar");
If the header has already been set this will add another value to it and the
response will include the same header multiple times. To replace a header that
has already been set, remove the existing value first:
$response->headers->remove("X-Foo");
=item headers
Returns a L<Hash::MultiValue> of all headers that have been set to be sent with
the response.
=item cookie
If called with no arguments this will return the names of all cookies that have
been set to be sent with the response. Otherwise, this method expects a list of
cookies to add to the response. For example:
$response->cookie("foo" => {
'value' => "test",
'path' => "/",
'domain' => ".example.com",
'expires' => time + 24 * 60 * 60,
});
The hashref may contain the keys C<value>, C<domain>, C<expires>, C<path>,
C<httponly>, and C<secure>. C<expires> can take a string or an integer (as an
epoch time) and B<does not> convert string formats like C<+3M>.
=item cookies
Returns a L<Hash::MultiValue> of all cookies that have been set to be sent with
the response.
=item body
Send buffered output to the client. Anything sent to the client with this
method will be buffered until C<finalize> is called. For example:
$response->body("hello");
$response->body("goodbye", "world");
If a buffered response is not desired then the body may be a callback to send a
streaming response to the client. Any headers or response codes set in the
callback will be ignored as they must all be set beforehand. Any body set
before a callback is set will also be ignored. For example:
$response->body(sub {
my $writer = shift;
$writer->write("Hello, world!");
$writer->close();
return;
});
=item finalize
This requires one argument: the HTTP status code of the response. It will then
send a PSGI compatible response to the client. For example:
# or hard code it
$response->finalize(200);
=back
=cut
lib/Prancer/Session.pm view on Meta::CPAN
package Prancer::Session;
use strict;
use warnings FATAL => 'all';
use version;
our $VERSION = '1.05';
use Storable qw(dclone);
sub new {
my ($class, $env) = @_;
my $self = bless({
'env' => $env,
'_session' => $env->{'psgix.session'},
'_options' => $env->{'psgix.session.options'},
}, $class);
return $self;
}
sub id {
my $self = shift;
return $self->{'_options'}->{'id'};
}
sub has {
my ($self, $key) = @_;
return exists($self->{'_session'}->{$key});
}
sub get {
my ($self, $key, $default) = @_;
# only return things if the are running in a non-void context
if (defined(wantarray())) {
my $value = undef;
if (exists($self->{'_session'}->{$key})) {
$value = $self->{'_session'}->{$key};
} else {
$value = $default;
}
# nothing to return
return unless defined($value);
# make a clone to avoid changing things
# through inadvertent references.
$value = dclone($value) if ref($value);
if (wantarray() && ref($value)) {
# return a value rather than a reference
if (ref($value) eq "HASH") {
return %{$value};
}
if (ref($value) eq "ARRAY") {
return @{$value};
}
}
# return a reference
return $value;
}
return;
}
sub set {
my ($self, $key, $value) = @_;
my $old = undef;
$old = $self->get($key) if defined(wantarray());
if (ref($value)) {
# make a copy of the original value to avoid inadvertently changing
# things via references
$self->{'_session'}->{$key} = dclone($value);
} else {
# can't clone non-references
$self->{'_session'}->{$key} = $value;
}
if (wantarray() && ref($old)) {
# return a value rather than a reference
if (ref($old) eq "HASH") {
return %{$old};
}
if (ref($old) eq "ARRAY") {
return @{$old};
}
}
return $old;
}
sub remove {
my ($self, $key) = @_;
my $old = undef;
$old = $self->get($key) if defined(wantarray());
delete($self->{'_session'}->{$key});
if (wantarray() && ref($old)) {
# return a value rather than a reference
if (ref($old) eq "HASH") {
return %{$old};
}
if (ref($old) eq "ARRAY") {
return @{$old};
}
}
return $old;
}
sub expire {
my $self = shift;
for my $key (keys %{$self->{'_session'}}) {
delete($self->{'_session'}->{$key});
}
$self->{'_options'}->{'expire'} = 1;
return;
}
1;
=head1 NAME
Prancer::Session
=head1 SYNOPSIS
Sessions are just as important in a web application as GET and POST parameters.
So if you have configured your application for sessions then every request will
include a session object specific to that request.
sub handler {
my ($self, $env, $request, $response, $session) = @_;
# increment this counter every time the user requests a page
my $counter = $session->get('counter');
$counter ||= 0;
++$counter;
$session->set('counter', $counter);
sub (GET + /logout) {
# blow the user's session away
$session->expire();
# then redirect the user
$response->header('Location' => '/login');
return $response->finalize(301);
}
}
=head1 CONFIGURATION
The basic configuration for the session engine looks like this:
session:
state:
driver: Prancer::Session::State::Cookie
options:
session_key: PSESSION
store:
driver: Prancer::Session::Store::Storable
options:
dir: /tmp/prancer/sessions
The documentation for the state and store drivers will have more information
about the specific options available to them.
=head1 METHODS
=over
=item id
This will return the session id of the current session. This is set and
maintained by the session state package.
=item has I<key>
This will return true if the named key exists in the session object.
if ($session->has('foo')) {
print "I see you've set foo already.\n";
}
It will return false otherwise.
=item get I<key> [I<default>]
The get method takes two arguments: a key and a default value. If the key does
not exist then the default value will be returned instead. If the value that
has been stored in the user's session is a reference then a clone of the value
will be returned to avoid modifying the session in a strange way. Additionally,
this method is context sensitive.
my $foo = $session->get('foo');
my %bar = $session->get('bar');
my @baz = $session->get('baz');
=item set I<key> I<value>
The set method takes two arguments: a key and a value. If the key already
exists in the session then it will be overwritten and the old value will be
returned in a context sensitive way. If the value is a reference then it will
be cloned before being saved into the user's session to avoid any strangeness.
my $old_foo = $session->set('foo', 'bar');
my %old_bar = $session->set('bar', { 'baz' => 'bat' });
my @old_baz = $session->set('baz', [ 'foo', 'bar', 'baz' ]);
$session->set('whatever', 'do not care');
=item remove I<key>
The remove method takes one argument: the key to remove. The value that was
removed will be returned in a context sensitive way.
=item expire
This will blow the session away.
=back
=head1 SEE ALSO
=over
=item L<Plack::Middleware::Session>
=item L<Prancer::Session::State::Cookie>
=item L<Prancer::Session::Store::Memory>
=item L<Prancer::Session::Store::Storable>
=item L<Prancer::Session::Store::Database>
=back
=cut
lib/Prancer/Session/State/Cookie.pm view on Meta::CPAN
package Prancer::Session::State::Cookie;
use strict;
use warnings FATAL => 'all';
use version;
our $VERSION = '1.05';
use Plack::Session::State::Cookie;
use parent qw(Plack::Session::State::Cookie);
1;
=head1 NAME
Prancer::Session::State::Cookie
=head1 SYNOPSIS
This package implements a session state handler that will keep track of
sessions by adding a cookie into the response headers and reading cookies in
the request headers. You must enable this if you want sessions to work.
To use this session state handler, add this to your configuration file:
session:
state:
driver: Prancer::Session::State::Cookie
options:
key: PSESSION
path: /
domain: .example.com
expires: 1800
secure: 1
httponly: 1
=head1 OPTIONS
=over 4
=item key
The name of the cookie. The default is B<PSESSION>.
=item path
The path of the cookie. This defaults to "/".
=item domain
The domain for the cookie. If this is not set then it will not be included in
the cookie.
=item expires
The expiration time of the cookie in seconds. If this is not set then it will
not be included in the cookie which means that sessions will expire at the end
of the user's browser session.
=item secure
The secure flag for the cookie. If this is not set then it will not be included
in the cookie. If this is set to a true value then the cookie will only be
transmitted over secure connections.
=item httponly
The HttpOnly flag for the cookie. If this is not set then it will not be
included in the cookie. If this is set to a true value then the cookie will
only be accessible by the server and not by, say, JavaScript.
=back
=cut
lib/Prancer/Session/Store/Memory.pm view on Meta::CPAN
package Prancer::Session::Store::Memory;
use strict;
use warnings FATAL => 'all';
use version;
our $VERSION = '1.05';
use Plack::Session::Store;
use parent qw(Plack::Session::Store);
1;
=head1 NAME
Prancer::Session::Store::Memory
=head1 SYNOPSIS
This package implements a session handler where all sessions are kept in
memory. B<THIS SHOULD NOT BE USED IN PRODUCTION>. If the server restarts then
all of your users will be logged out. If you are using a multi-process server
like L<Starman> then your users will be logged out whenever they connect to a
different process or basically every time they connect. This should be used
strictly for testing.
Though this will be the default session handler if none is configured, it can
be explicitly configured like this:
session:
store:
driver: Prancer::Session::Store::Memory
=cut
lib/Prancer/Session/Store/Storable.pm view on Meta::CPAN
package Prancer::Session::Store::Storable;
use strict;
use warnings FATAL => 'all';
use version;
our $VERSION = '1.05';
use Plack::Session::Store::File;
use parent qw(Plack::Session::Store::File);
1;
=head1 NAME
Prancer::Session::Store::Storable
=head1 SYNOPSIS
This package implements a session handler based on files written using the
L<Storable> package. Session files are saved in the configured directory.
This backend can be used in production environments but two things should be
kept in mind: the content of the session files is in plain text and session
files still need to be periodically purged.
To use this session storage handler, add this to your configuration file:
session:
store:
driver: Prancer::Session::Store::Storable
options:
dir: /tmp/prancer/sessions
=head1 OPTIONS
=over 4
=item dir
B<REQUIRED> This indicates the path where sessions will be written. This path
must be writable by the same user that is running the application server. If
this is not set or the configured path is not writable then the session handler
will not be initialized and sessions will not work.
=back
=cut
t/000.use.t view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings FATAL => 'all';
use Test::More;
BEGIN {
use_ok('Prancer');
use_ok('Prancer::Core');
use_ok('Prancer::Config');
use_ok('Prancer::Plugin');
use_ok('Prancer::Request');
use_ok('Prancer::Request::Upload');
use_ok('Prancer::Response');
use_ok('Prancer::Session');
use_ok('Prancer::Session::State::Cookie');
use_ok('Prancer::Session::Store::Memory');
use_ok('Prancer::Session::Store::Storable');
};
done_testing();
t/100.config.t view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings FATAL => 'all';
use Test::More;
use_ok('Prancer::Config');
{
my $config = Prancer::Config->load('t/configs/single.yml');
ok($config);
ok(ref($config));
is(ref($config), 'Prancer::Config');
ok($config->has('foo'));
my $a = $config->get('foo');
is($a, 'bar');
my $b = $config->get('listings');
ok(ref($b));
is(ref($b), 'ARRAY');
is(scalar(@{$b}), 3);
is_deeply($b, [ 'a', 'b', 'c' ]);
my @c = $config->get('listings');
is(scalar(@c), 3);
is_deeply(\@c, [ 'a', 'b', 'c' ]);
my @d = $config->get('foo');
is(scalar(@d), 1);
is_deeply(\@d, [ 'bar' ]);
my $e = $config->get('asdf');
ok(!defined($e));
my @f = $config->get('asdf');
is(scalar(@f), 0);
my $g = $config->get('channels');
ok(ref($g));
is(ref($g), 'HASH');
is_deeply($g, { 'foo' => 'bar', 'baz' => 'bat' });
my %h = $config->get('channels');
is_deeply(\%h, { 'foo' => 'bar', 'baz' => 'bat' });
# test default values
my $i = $config->get('asdf', 'fdsa');
is($i, 'fdsa');
my $j = $config->get('asdf', [ 'asdf', 'fdsa' ]);
ok(ref($j));
is(ref($j), 'ARRAY');
is(scalar(@{$j}), 2);
is_deeply($j, [ 'asdf', 'fdsa' ]);
my @k = $config->get('asdf', [ 'asdf', 'fdsa' ]);
is(scalar(@k), 2);
is_deeply(\@k, [ 'asdf', 'fdsa' ]);
}
# test setting values
{
# test setting value that doesn't exist
{
my $config = Prancer::Config->load('t/configs/single.yml');
ok(!$config->has('qwerty'));
ok(!defined($config->get('qwerty')));
my $a = $config->set('qwerty', 'ytrewq');
ok(!defined($a));
ok($config->has('qwerty'));
is($config->get('qwerty'), 'ytrewq');
}
# test setting a value over another value
{
my $config = Prancer::Config->load('t/configs/single.yml');
is($config->get('foo'), 'bar');
my $a = $config->set('foo', 'bazbat');
is($a, 'bar');
is($config->get('foo'), 'bazbat');
}
# test setting a value over a complex value and getting a reference
{
my $config = Prancer::Config->load('t/configs/single.yml');
my $a = $config->set('listings', 'qwerty');
ok(ref($a));
is(ref($a), 'ARRAY');
is_deeply($a, [ 'a', 'b', 'c' ]);
my $b = $config->get('listings');
is($b, 'qwerty');
}
# test setting a value over a complex value and getting a non-reference
{
my $config = Prancer::Config->load('t/configs/single.yml');
my @a = $config->set('listings', 'qwerty');
ok(scalar(@a));
is(scalar(@a), 3);
is_deeply(\@a, [ 'a', 'b', 'c' ]);
my $b = $config->get('listings');
is($b, 'qwerty');
}
}
# test removing values
{
# test removing a value that doesn't exist
{
my $config = Prancer::Config->load('t/configs/single.yml');
my $a = $config->get('qwerty');
ok(!defined($a));
$config->remove('qwerty');
ok(!defined($config->get('qwerty')));
}
# test removing a value
{
my $config = Prancer::Config->load('t/configs/single.yml');
my $a = $config->get('foo');
is($a, 'bar');
$config->remove('foo');
ok(!defined($config->get('foo')));
}
# test removing a complex value and getting a reference
{
my $config = Prancer::Config->load('t/configs/single.yml');
my $a = $config->remove('listings');
ok(ref($a));
is(ref($a), 'ARRAY');
is_deeply($a, [ 'a', 'b', 'c' ]);
my $b = $config->get('listings');
ok(!defined($b));
}
# test setting a value over a complex value and getting a non-reference
{
my $config = Prancer::Config->load('t/configs/single.yml');
my @a = $config->remove('listings');
ok(scalar(@a));
is(scalar(@a), 3);
is_deeply(\@a, [ 'a', 'b', 'c' ]);
my $b = $config->get('listings');
ok(!defined($b));
}
}
# test against using environment variables to load from directories
{
{
delete(local $ENV{'ENVIRONMENT'});
my $config = Prancer::Config->load('t/configs/envs');
ok($config);
ok(ref($config));
is(ref($config), 'Prancer::Config');
is($config->get('foo'), 'barbazbat');
is($config->get('name'), 'development-config-file');
}
{
local $ENV{'ENVIRONMENT'} = 'development';
my $config = Prancer::Config->load('t/configs/envs');
ok($config);
ok(ref($config));
is(ref($config), 'Prancer::Config');
is($config->get('foo'), 'barbazbat');
is($config->get('name'), 'development-config-file');
}
{
local $ENV{'ENVIRONMENT'} = 'production';
my $config = Prancer::Config->load('t/configs/envs');
ok($config);
ok(ref($config));
is(ref($config), 'Prancer::Config');
is($config->get('foo'), 'barbazbat');
is($config->get('name'), 'production-config-file');
}
}
# test against situations where there are no environment config files
{
{
delete(local $ENV{'ENVIRONMENT'});
my $config = Prancer::Config->load('t/configs/missing');
ok($config);
ok(ref($config));
is(ref($config), 'Prancer::Config');
is($config->get('foo'), 'qwerty');
is($config->get('name'), 'config');
}
{
local $ENV{'ENVIRONMENT'} = 'development';
my $config = Prancer::Config->load('t/configs/missing');
ok($config);
ok(ref($config));
is(ref($config), 'Prancer::Config');
is($config->get('foo'), 'qwerty');
is($config->get('name'), 'config');
}
{
local $ENV{'ENVIRONMENT'} = 'production';
my $config = Prancer::Config->load('t/configs/missing');
ok($config);
ok(ref($config));
is(ref($config), 'Prancer::Config');
is($config->get('foo'), 'qwerty');
is($config->get('name'), 'config');
}
}
# test against empty directories
{
{
delete(local $ENV{'ENVIRONMENT'});
my $config = Prancer::Config->load('t/configs/empty');
ok($config);
ok(ref($config));
is(ref($config), 'Prancer::Config');
ok(!defined($config->get('foo')));
ok(!defined($config->get('name')));
}
{
local $ENV{'ENVIRONMENT'} = 'development';
my $config = Prancer::Config->load('t/configs/empty');
ok($config);
ok(ref($config));
is(ref($config), 'Prancer::Config');
ok(!defined($config->get('foo')));
ok(!defined($config->get('name')));
}
{
local $ENV{'ENVIRONMENT'} = 'production';
my $config = Prancer::Config->load('t/configs/empty');
ok($config);
ok(ref($config));
is(ref($config), 'Prancer::Config');
ok(!defined($config->get('foo')));
ok(!defined($config->get('name')));
}
}
done_testing();
t/101.request.t view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings FATAL => 'all';
use Test::More;
use Plack::Test;
use HTTP::Request::Common qw(GET POST);
# these are the modules we are testing
use Prancer::Request;
use Prancer::Request::Upload;
use Prancer::Response;
{
# test basic methods with a GET
my $req = Prancer::Request->new({
'HTTP_ACCEPT' => 'text/html, text/plain, text/css, text/sgml, */*;q=0.01',
'HTTP_ACCEPT_ENCODING' => 'gzip, compress, bzip2',
'HTTP_ACCEPT_LANGUAGE' => 'en',
'HTTP_HOST' => 'localhost:5000',
'HTTP_USER_AGENT' => 'Lynx/2.8.8dev.12 libwww-FM/2.14 SSL-MM/1.4.1 GNUTLS/2.12.18',
'HTTP_X_MYHEADER' => '123, 321',
'PATH_INFO' => '/asdf',
'QUERY_STRING' => '',
'REMOTE_USER' => 'foobar',
'REMOTE_ADDR' => '127.0.0.1',
'REMOTE_PORT' => 41049,
'REQUEST_METHOD' => 'GET',
'REQUEST_URI' => '/asdf',
'SCRIPT_NAME' => '',
'SERVER_NAME' => 0,
'SERVER_PORT' => 5000,
'SERVER_PROTOCOL' => 'HTTP/1.0',
'psgi.input' => undef,
'psgi.errors' => undef,
'psgi.multiprocess' => '',
'psgi.multithread' => '',
'psgi.nonblocking' => '',
'psgi.run_once' => '',
'psgi.streaming' => 1,
'psgi.url_scheme' => 'http',
'psgi.version' => [ 1, 1 ],
'psgix.harakiri' => 1,
'psgix.input.buffered' => 1,
});
isa_ok($req, 'Prancer::Request');
is($req->uri(), 'http://localhost:5000/asdf');
is($req->base(), 'http://localhost:5000/');
is($req->method(), 'GET');
is($req->protocol(), 'HTTP/1.0');
is($req->scheme(), 'http');
is($req->port(), 5000);
is($req->secure(), 0);
is($req->path(), '/asdf');
is($req->body(), undef);
is($req->address(), '127.0.0.1');
is($req->user(), 'foobar');
is($req->uri_for('fdsa'), 'http://localhost:5000/fdsa');
is($req->uri_for('/fdsa'), 'http://localhost:5000/fdsa');
is($req->uri_for('/logout', [ signoff => 1 ]), 'http://localhost:5000/logout?signoff=1');
}
# most of Prancer::Request and Prancer::Request::Upload are implemented by
# Plack and Prancer just proxies the requests through. However, Prancer does
# implement some of its own logic for:
# - params
# - cookies
# - uploads
# - upload basename
# test params, cookies
{
my $req = Prancer::Request->new({
'HTTP_COOKIE' => 'USER_TOKEN=Yes',
'HTTP_ACCEPT' => 'text/html, text/plain, text/css, text/sgml, */*;q=0.01',
'HTTP_ACCEPT_ENCODING' => 'gzip, compress, bzip2',
'HTTP_ACCEPT_LANGUAGE' => 'en',
'HTTP_HOST' => 'localhost:5000',
'HTTP_USER_AGENT' => 'Lynx/2.8.8dev.12 libwww-FM/2.14 SSL-MM/1.4.1 GNUTLS/2.12.18',
'PATH_INFO' => '/asdf',
'REMOTE_ADDR' => '127.0.0.1',
'REMOTE_PORT' => 41049,
'REQUEST_METHOD' => 'GET',
'QUERY_STRING' => 'foo=bar&baz=bat&qwerty=fdsa&qwerty=asdf',
'REQUEST_URI' => '/index?foo=bar&baz=bat&qwerty=fdsa&qwerty=asdf',
'SCRIPT_NAME' => '',
'SERVER_NAME' => 0,
'SERVER_PORT' => 5000,
'SERVER_PROTOCOL' => 'HTTP/1.0',
'psgi.input' => undef,
'psgi.errors' => undef,
'psgi.multiprocess' => '',
'psgi.multithread' => '',
'psgi.nonblocking' => '',
'psgi.run_once' => '',
'psgi.streaming' => 1,
'psgi.url_scheme' => 'http',
'psgi.version' => [ 1, 1 ],
'psgix.harakiri' => 1,
'psgix.input.buffered' => 1,
});
{
my @keys = $req->param();
is_deeply([ sort @keys ], [ 'baz', 'foo', 'qwerty' ]);
my $keys = $req->param();
is($keys, 3);
is($req->param('foo'), 'bar');
is($req->param('baz'), 'bat');
my @multivalue = $req->param('qwerty');
is_deeply([ sort @multivalue ], [ 'asdf', 'fdsa' ]);
my $multivalue = $req->param('qwerty');
is($multivalue, 'asdf');
}
{
my @keys = $req->cookie();
is_deeply([ sort @keys ], [ 'USER_TOKEN' ]);
my $keys = $req->cookie();
is($keys, 1);
is($req->cookie('USER_TOKEN'), 'Yes');
my @multivalue = $req->cookie('USER_TOKEN');
is_deeply([ sort @multivalue ], [ 'Yes' ]);
my $multivalue = $req->cookie('USER_TOKEN');
is($multivalue, 'Yes');
}
}
# test posts with args
{
my $app = sub {
my $env = shift;
my $request = Prancer::Request->new($env);
my $response = Prancer::Response->new($env);
is($request->param('foo'), 'bar');
is($request->content(), 'foo=bar');
return $response->finalize(200);
};
test_psgi($app, sub {
my $cb = shift;
my $res = $cb->(POST "/", { foo => "bar" });
ok($res->is_success());
});
}
# test uploads
{
my $app = sub {
my $env = shift;
my $request = Prancer::Request->new($env);
my $response = Prancer::Response->new($env);
my @keys = $request->upload();
is_deeply([ sort @keys ], [ 'bar', 'foo' ]);
my $keys = $request->upload();
is($keys, 2);
my $single = $request->upload('bar');
isa_ok($single, 'Prancer::Request::Upload');
is($single->filename(), 'foo1.txt');
is($single->size(), 5);
is($single->content_type(), 'text/plain');
my @multi = $request->upload('foo');
isa_ok($_, 'Prancer::Request::Upload') for (@multi);
return $response->finalize(200);
};
test_psgi($app, sub {
my $cb = shift;
my $res = $cb->(POST "/", Content_Type => 'form-data', Content => [
'foo' => [ "t/foo1.txt" ],
'foo' => [ "t/foo2.txt" ],
'bar' => [ "t/foo1.txt" ],
]);
ok($res->is_success());
});
}
done_testing();
t/102.response.t view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings FATAL => 'all';
use Test::More;
use Test::More;
use Plack::Test;
use HTTP::Request::Common qw(GET POST);
# these are the modules we are testing
use Prancer::Request;
use Prancer::Request::Upload;
use Prancer::Response;
# basic response
{
my $app = sub {
my $env = shift;
my $request = Prancer::Request->new($env);
my $response = Prancer::Response->new($env);
return $response->finalize(200);
};
test_psgi($app, sub {
my $cb = shift;
my $res = $cb->(GET "/");
is($res->code(), 200);
is($res->content(), '');
is_deeply([ $res->headers->header_field_names() ], []);
});
}
# response with headers and cookies
{
my $app = sub {
my $env = shift;
my $request = Prancer::Request->new($env);
my $response = Prancer::Response->new($env);
# add some headers
$response->header("Content-Type" => "text/plain");
$response->header("Content-Length" => 1234, "X-Foo" => "bar");
$response->header("X-Bar" => "foo");
# remove a header
$response->headers->remove("X-Bar");
# add some cookies
$response->cookie("foo1" => {
'value' => "test",
'path' => "/",
'domain' => ".example.com",
'expires' => 0 + 24 * 60 * 60,
});
$response->cookie("foo2" => {
'value' => "test",
'path' => "/",
'domain' => ".example.com",
'expires' => 0 + 24 * 60 * 60,
'httponly' => 1,
'secure' => 1,
});
$response->cookie("foo3" => {
'value' => "test",
});
return $response->finalize(200);
};
test_psgi($app, sub {
my $cb = shift;
my $res = $cb->(GET "/");
is($res->code(), 200);
is($res->content(), '');
is_deeply([ sort $res->headers->header_field_names() ], [ 'Content-Length', 'Content-Type', 'Set-Cookie', 'X-Foo' ]);
is($res->headers->header('X-Foo'), 'bar');
is($res->headers->header('Content-Length'), 1234);
is_deeply([ sort $res->headers->header('Set-Cookie') ], [
'foo1=test; domain=.example.com; path=/; expires=Fri, 02-Jan-1970 00:00:00 GMT',
'foo2=test; domain=.example.com; path=/; expires=Fri, 02-Jan-1970 00:00:00 GMT; secure; HttpOnly',
'foo3=test',
]);
});
}
# response with static body
{
my $app = sub {
my $env = shift;
my $request = Prancer::Request->new($env);
my $response = Prancer::Response->new($env);
$response->body("Hello, world!");
return $response->finalize(200);
};
test_psgi($app, sub {
my $cb = shift;
my $res = $cb->(GET "/");
is($res->code(), 200);
is($res->content(), 'Hello, world!');
is_deeply([ $res->headers->header_field_names() ], []);
});
}
# response with callback
{
my $app = sub {
my $env = shift;
my $request = Prancer::Request->new($env);
my $response = Prancer::Response->new($env);
$response->body(sub {
my $writer = shift;
$writer->write("Goodbye, world!");
$writer->close();
});
# need to remove the arrayref from the response
# the arrayref is there for Web::Simple but breaks everything else
my $output = $response->finalize(200);
ok(ref($output));
is(ref($output), 'ARRAY');
is(scalar(@{$output}), 1);
return $output->[0];
};
test_psgi($app, sub {
my $cb = shift;
my $res = $cb->(GET "/");
is($res->code(), 200);
is($res->content(), 'Goodbye, world!');
is_deeply([ $res->headers->header_field_names() ], []);
});
}
done_testing();
t/999.critic.t view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings FATAL => 'all';
use Try::Tiny;
use Test::More;
if (!$ENV{RUN_AUTHOR_TESTS} ) {
plan( skip_all => 'Set $ENV{RUN_AUTHOR_TESTS} to a true value to run.' );
}
try {
require Test::Perl::Critic;
} catch {
plan(skip_all => 'Test::Perl::Critic not found.');
};
Test::Perl::Critic->import(-profile => 't/perlcriticrc');
all_critic_ok('lib');
t/999.eol.t view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings FATAL => 'all';
use Try::Tiny;
use Test::More;
if (!$ENV{RUN_AUTHOR_TESTS} ) {
plan( skip_all => 'Set $ENV{RUN_AUTHOR_TESTS} to a true value to run.' );
}
try {
require Test::EOL;
} catch {
plan(skip_all => 'Test::EOL not found.');
};
Test::EOL->import();
all_perl_files_ok({ trailing_whitespace => 1, all_reasons => 1 }, qw(lib t));
t/999.notabs.t view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings FATAL => 'all';
use Try::Tiny;
use Test::More;
if (!$ENV{RUN_AUTHOR_TESTS} ) {
plan( skip_all => 'Set $ENV{RUN_AUTHOR_TESTS} to a true value to run.' );
}
try {
require Test::NoTabs
} catch {
plan(skip_all => 'Test::NoTabs not found.');
};
Test::NoTabs->import();
all_perl_files_ok(qw(lib t));
t/configs/envs/config.yml view on Meta::CPAN
name: base-config-file
foo: barbazbat
( run in 1.249 second using v1.01-cache-2.11-cpan-39bf76dae61 )