[Catalyst-commits] r8004 - in Catalyst-Plugin-DebugCookie: . 1.000
1.000/trunk 1.000/trunk/lib 1.000/trunk/lib/Catalyst
1.000/trunk/lib/Catalyst/Plugin
1.000/trunk/lib/Catalyst/Plugin/DebugCookie 1.000/trunk/t
1.000/trunk/t/lib 1.000/trunk/t/lib/MyApp
1.000/trunk/t/lib/MyApp/Controller 1.000/trunk/t/lib/script
jgoulah at dev.catalyst.perl.org
jgoulah at dev.catalyst.perl.org
Wed Jun 25 21:52:45 BST 2008
Author: jgoulah
Date: 2008-06-25 21:52:44 +0100 (Wed, 25 Jun 2008)
New Revision: 8004
Added:
Catalyst-Plugin-DebugCookie/1.000/
Catalyst-Plugin-DebugCookie/1.000/branches/
Catalyst-Plugin-DebugCookie/1.000/tags/
Catalyst-Plugin-DebugCookie/1.000/trunk/
Catalyst-Plugin-DebugCookie/1.000/trunk/Changes
Catalyst-Plugin-DebugCookie/1.000/trunk/Makefile.PL
Catalyst-Plugin-DebugCookie/1.000/trunk/lib/
Catalyst-Plugin-DebugCookie/1.000/trunk/lib/Catalyst/
Catalyst-Plugin-DebugCookie/1.000/trunk/lib/Catalyst/Plugin/
Catalyst-Plugin-DebugCookie/1.000/trunk/lib/Catalyst/Plugin/DebugCookie.pm
Catalyst-Plugin-DebugCookie/1.000/trunk/lib/Catalyst/Plugin/DebugCookie/
Catalyst-Plugin-DebugCookie/1.000/trunk/lib/Catalyst/Plugin/DebugCookie/Util.pm
Catalyst-Plugin-DebugCookie/1.000/trunk/t/
Catalyst-Plugin-DebugCookie/1.000/trunk/t/01use.t
Catalyst-Plugin-DebugCookie/1.000/trunk/t/02pod.t
Catalyst-Plugin-DebugCookie/1.000/trunk/t/03podcoverage.t
Catalyst-Plugin-DebugCookie/1.000/trunk/t/04debug_cookie.t
Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/
Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp.pm
Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp/
Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp/Controller/
Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp/Controller/Root.pm
Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp/myapp.conf
Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/script/
Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/script/myapp_server.pl
Log:
initial checkin, needs pod
Added: Catalyst-Plugin-DebugCookie/1.000/trunk/Changes
===================================================================
--- Catalyst-Plugin-DebugCookie/1.000/trunk/Changes (rev 0)
+++ Catalyst-Plugin-DebugCookie/1.000/trunk/Changes 2008-06-25 20:52:44 UTC (rev 8004)
@@ -0,0 +1,3 @@
+
+0.999001 2008-06-25
+ - initial release
Added: Catalyst-Plugin-DebugCookie/1.000/trunk/Makefile.PL
===================================================================
--- Catalyst-Plugin-DebugCookie/1.000/trunk/Makefile.PL (rev 0)
+++ Catalyst-Plugin-DebugCookie/1.000/trunk/Makefile.PL 2008-06-25 20:52:44 UTC (rev 8004)
@@ -0,0 +1,19 @@
+use inc::Module::Install '0.68';
+
+name 'Catalyst-Plugin-DebugCookie';
+all_from 'lib/Catalyst/Plugin/DebugCookie.pm';
+
+requires 'Catalyst' => '5.7007';
+requires 'Class::C3' => '0.19';
+requires 'Digest::MD5';
+requires 'Sub::Exporter';
+
+# generate README file
+if ($Module::Install::AUTHOR) {
+ system('pod2text lib/Catalyst/Plugin/DebugCookie.pm > README');
+}
+
+tests_recursive();
+auto_install;
+WriteAll;
+
Added: Catalyst-Plugin-DebugCookie/1.000/trunk/lib/Catalyst/Plugin/DebugCookie/Util.pm
===================================================================
--- Catalyst-Plugin-DebugCookie/1.000/trunk/lib/Catalyst/Plugin/DebugCookie/Util.pm (rev 0)
+++ Catalyst-Plugin-DebugCookie/1.000/trunk/lib/Catalyst/Plugin/DebugCookie/Util.pm 2008-06-25 20:52:44 UTC (rev 8004)
@@ -0,0 +1,43 @@
+package Catalyst::Plugin::DebugCookie::Util;
+
+use strict;
+use warnings;
+use Class::C3;
+use Digest::MD5 qw(md5_hex);
+use Sub::Exporter
+ -setup => { exports => [ qw(make_debug_cookie check_debug_cookie_value) ] };
+
+sub make_debug_cookie {
+ my ($c, $username) = @_;
+
+ my $config = $c->config->{'Plugin::DebugCookie'} || {};
+ my $secret_key = $config->{secret_key};
+ die "config must define 'secret_key'" unless grep {defined && length} $secret_key;
+ my $cookie_name = (defined $config->{cookie_name})?$config->{cookie_name}:'debug_cookie';
+
+ $c->res->cookies->{$cookie_name} = {
+ value => md5_hex($username, $secret_key)
+ };
+
+ return 1;
+}
+
+
+sub check_debug_cookie_value {
+ my ($c, $username) = @_;
+
+ my $config = $c->config->{'Plugin::DebugCookie'} || {};
+ my $secret_key = $config->{secret_key};
+ die "config must define 'secret_key'" unless grep {defined && length} $secret_key;
+ my $cookie_name = (defined $config->{cookie_name})?$config->{cookie_name}:'debug_cookie';
+
+ if (exists ( $c->request->cookies->{$cookie_name}) ) {
+ my $cookie_val = $c->request->cookies->{$cookie_name}->value;
+ if (md5_hex($username, $secret_key) eq $cookie_val) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+1;
Added: Catalyst-Plugin-DebugCookie/1.000/trunk/lib/Catalyst/Plugin/DebugCookie.pm
===================================================================
--- Catalyst-Plugin-DebugCookie/1.000/trunk/lib/Catalyst/Plugin/DebugCookie.pm (rev 0)
+++ Catalyst-Plugin-DebugCookie/1.000/trunk/lib/Catalyst/Plugin/DebugCookie.pm 2008-06-25 20:52:44 UTC (rev 8004)
@@ -0,0 +1,55 @@
+package Catalyst::Plugin::DebugCookie;
+
+use strict;
+use warnings;
+use Class::C3;
+use Catalyst::Plugin::DebugCookie::Util qw/check_debug_cookie_value/;
+
+=head
+debug will only get hit when catalyst debug is off
+b/c CATALYST_DEBUG=1 injects a 'sub debug { 1 }' into MyApp::
+
+=cut
+
+our $VERSION = '0.999001';
+
+sub prepare {
+ my $class = shift;
+ my $self = $class->next::method(@_);
+ $self->response->header( 'X-Catalyst-Debug' => $self->debug ? 1 : 0 );
+ if ($self->debug) {
+ $self->stats->enable($self->use_stats);
+ }
+ $self;
+}
+
+sub valid_debug_mode {
+ my $self = shift;
+
+ if(my $is_debug = $self->req->query_params->{is_debug}) {
+ return check_debug_cookie_value($self, $is_debug);
+ }
+
+ return 0;
+}
+
+
+sub debug {
+ my $self = shift;
+ if (ref $self) {
+ return $self->{debug} ||= $self->valid_debug_mode;
+ } else {
+ $self->next::method(@_);
+ }
+}
+
+sub use_stats {
+ my $self = shift;
+ if (ref $self) {
+ return $self->{use_stats} ||= $self->valid_debug_mode;
+ } else {
+ $self->next::method(@_);
+ }
+}
+
+1;
Added: Catalyst-Plugin-DebugCookie/1.000/trunk/t/01use.t
===================================================================
--- Catalyst-Plugin-DebugCookie/1.000/trunk/t/01use.t (rev 0)
+++ Catalyst-Plugin-DebugCookie/1.000/trunk/t/01use.t 2008-06-25 20:52:44 UTC (rev 8004)
@@ -0,0 +1,5 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok('Catalyst::Plugin::AutoRestart') }
+
Added: Catalyst-Plugin-DebugCookie/1.000/trunk/t/02pod.t
===================================================================
--- Catalyst-Plugin-DebugCookie/1.000/trunk/t/02pod.t (rev 0)
+++ Catalyst-Plugin-DebugCookie/1.000/trunk/t/02pod.t 2008-06-25 20:52:44 UTC (rev 8004)
@@ -0,0 +1,10 @@
+use strict;
+use warnings;
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => 'Test::Pod 1.14 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_files_ok();
+
Added: Catalyst-Plugin-DebugCookie/1.000/trunk/t/03podcoverage.t
===================================================================
--- Catalyst-Plugin-DebugCookie/1.000/trunk/t/03podcoverage.t (rev 0)
+++ Catalyst-Plugin-DebugCookie/1.000/trunk/t/03podcoverage.t 2008-06-25 20:52:44 UTC (rev 8004)
@@ -0,0 +1,10 @@
+use strict;
+use warnings;
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_coverage_ok();
+
Added: Catalyst-Plugin-DebugCookie/1.000/trunk/t/04debug_cookie.t
===================================================================
--- Catalyst-Plugin-DebugCookie/1.000/trunk/t/04debug_cookie.t (rev 0)
+++ Catalyst-Plugin-DebugCookie/1.000/trunk/t/04debug_cookie.t 2008-06-25 20:52:44 UTC (rev 8004)
@@ -0,0 +1,51 @@
+use strict;
+use warnings;
+use Test::More tests => 9;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+BEGIN { use_ok 'Test::WWW::Mechanize::Catalyst', 'MyApp' }
+
+my $base = 'http://localhost';
+my $mech = Test::WWW::Mechanize::Catalyst->new;
+$mech->{catalyst_debug} = 1;
+
+# test setting the cookie
+$mech->get_ok("$base/this/is/not/public/someuser");
+$mech->content_contains('Cookie set');
+
+my $debug_header = get_debug_header();
+is($debug_header, 0, "debug is turned off initially");
+
+my $cookie_header = get_cookie_header();
+like($cookie_header, qr/debug_cookie/, "found cookie_debug cookie in header");
+
+# set an invalid username and make sure debug is still off
+$mech->get_ok("$base/?is_debug=someuser2");
+
+$debug_header = get_debug_header();
+is($debug_header, 0, "debug is still off");
+
+# set the valid username and make sure debug is turned on
+$mech->get_ok("$base/?is_debug=someuser");
+
+$debug_header = get_debug_header();
+is($debug_header, 1, "debug is turned on");
+
+
+
+sub get_debug_header {
+ my $response = $mech->response;
+ return $response->header('X-Catalyst-Debug');
+}
+
+sub get_cookie_header {
+ my $response = $mech->response;
+ return $response->header('Set-Cookie');
+}
+
+
+
+
+1;
Added: Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp/Controller/Root.pm
===================================================================
--- Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp/Controller/Root.pm (rev 0)
+++ Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp/Controller/Root.pm 2008-06-25 20:52:44 UTC (rev 8004)
@@ -0,0 +1,63 @@
+package MyApp::Controller::Root;
+
+use strict;
+use warnings;
+use base 'Catalyst::Controller';
+use Catalyst::Plugin::DebugCookie::Util qw/make_debug_cookie/;
+
+#
+# Sets the actions in this controller to be registered with no prefix
+# so they function identically to actions created in MyApp.pm
+#
+__PACKAGE__->config->{namespace} = '';
+
+=head1 NAME
+
+MyApp::Controller::Root - Root Controller for MyApp
+
+=head1 DESCRIPTION
+
+[enter your description here]
+
+=head1 METHODS
+
+=cut
+
+=head2 default
+
+=cut
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+
+ $c->response->body( "default page" );
+}
+
+sub secure_debug_cookie :Path(/this/is/not/public) {
+ my ($self, $c, $username) = @_;
+
+ make_debug_cookie($c, $username);
+
+ $c->res->body("Cookie set");
+}
+
+=head2 end
+
+Attempt to render a view, if needed.
+
+=cut
+
+sub end : ActionClass('RenderView') {}
+
+=head1 AUTHOR
+
+Catalyst developer
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Added: Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp/myapp.conf
===================================================================
--- Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp/myapp.conf (rev 0)
+++ Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp/myapp.conf 2008-06-25 20:52:44 UTC (rev 8004)
@@ -0,0 +1,5 @@
+name MyApp
+
+<Plugin::DebugCookie>
+ secret_key 001A4B28EE3936
+</Plugin::DebugCookie>
Added: Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp.pm
===================================================================
--- Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp.pm (rev 0)
+++ Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/MyApp.pm 2008-06-25 20:52:44 UTC (rev 8004)
@@ -0,0 +1,62 @@
+package MyApp;
+
+use strict;
+use warnings;
+
+use Catalyst::Runtime '5.70';
+
+# Set flags and add plugins for the application
+#
+# -Debug: activates the debug mode for very useful log messages
+# ConfigLoader: will load the configuration from a YAML file in the
+# application's home directory
+# Static::Simple: will serve static files from the application's root
+# directory
+
+use Catalyst qw/ConfigLoader Static::Simple DebugCookie/;
+
+our $VERSION = '0.01';
+
+# Configure the application.
+#
+# Note that settings in myapp.yml (or other external
+# configuration file that you set up manually) take precedence
+# over this when using ConfigLoader. Thus configuration
+# details given here can function as a default configuration,
+# with a external configuration file acting as an override for
+# local deployment.
+
+__PACKAGE__->config( name => 'MyApp' );
+
+# Start the application
+__PACKAGE__->setup;
+
+
+=head1 NAME
+
+MyApp - Catalyst based application
+
+=head1 SYNOPSIS
+
+ script/myapp_server.pl
+
+=head1 DESCRIPTION
+
+[enter your description here]
+
+=head1 SEE ALSO
+
+L<MyApp::Controller::Root>, L<Catalyst>
+
+=head1 AUTHOR
+
+Catalyst developer
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Added: Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/script/myapp_server.pl
===================================================================
--- Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/script/myapp_server.pl (rev 0)
+++ Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/script/myapp_server.pl 2008-06-25 20:52:44 UTC (rev 8004)
@@ -0,0 +1,111 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+ $ENV{CATALYST_ENGINE} ||= 'HTTP';
+ $ENV{CATALYST_SCRIPT_GEN} = 30;
+ require Catalyst::Engine::HTTP;
+}
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/../../../lib";
+
+my $debug = 0;
+my $fork = 0;
+my $help = 0;
+my $host = undef;
+my $port = $ENV{MYAPP_PORT} || $ENV{CATALYST_PORT} || 3000;
+my $keepalive = 0;
+my $restart = $ENV{MYAPP_RELOAD} || $ENV{CATALYST_RELOAD} || 0;
+my $restart_delay = 1;
+my $restart_regex = '\.yml$|\.yaml$|\.pm$';
+my $restart_directory = undef;
+
+my @argv = @ARGV;
+
+GetOptions(
+ 'debug|d' => \$debug,
+ 'fork' => \$fork,
+ 'help|?' => \$help,
+ 'host=s' => \$host,
+ 'port=s' => \$port,
+ 'keepalive|k' => \$keepalive,
+ 'restart|r' => \$restart,
+ 'restartdelay|rd=s' => \$restart_delay,
+ 'restartregex|rr=s' => \$restart_regex,
+ 'restartdirectory=s' => \$restart_directory,
+);
+
+pod2usage(1) if $help;
+
+if ( $restart && $ENV{CATALYST_ENGINE} eq 'HTTP' ) {
+ $ENV{CATALYST_ENGINE} = 'HTTP::Restarter';
+}
+if ( $debug ) {
+ $ENV{CATALYST_DEBUG} = 1;
+}
+
+# This is require instead of use so that the above environment
+# variables can be set at runtime.
+require MyApp;
+
+MyApp->run( $port, $host, {
+ argv => \@argv,
+ 'fork' => $fork,
+ keepalive => $keepalive,
+ restart => $restart,
+ restart_delay => $restart_delay,
+ restart_regex => qr/$restart_regex/,
+ restart_directory => $restart_directory,
+} );
+
+1;
+
+=head1 NAME
+
+myapp_server.pl - Catalyst Testserver
+
+=head1 SYNOPSIS
+
+myapp_server.pl [options]
+
+ Options:
+ -d -debug force debug mode
+ -f -fork handle each request in a new process
+ (defaults to false)
+ -? -help display this help and exits
+ -host host (defaults to all)
+ -p -port port (defaults to 3000)
+ -k -keepalive enable keep-alive connections
+ -r -restart restart when files get modified
+ (defaults to false)
+ -rd -restartdelay delay between file checks
+ -rr -restartregex regex match files that trigger
+ a restart when modified
+ (defaults to '\.yml$|\.yaml$|\.pm$')
+ -restartdirectory the directory to search for
+ modified files
+ (defaults to '../')
+
+ See also:
+ perldoc Catalyst::Manual
+ perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Run a Catalyst Testserver for this application.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri at oook.de>
+Maintained by the Catalyst Core Team.
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
Property changes on: Catalyst-Plugin-DebugCookie/1.000/trunk/t/lib/script/myapp_server.pl
___________________________________________________________________
Name: svn:executable
+ *
More information about the Catalyst-commits
mailing list