+Revision history for Catalyst-Component-ACCEPT_CONTEXT
+
+0.05 18 Jan 2008
+ Don't inherit from Catalyst::Component; this breaks NEXT (!)
+
+0.04 15 Sep 2007
+ Be less invasive; return the same $self each time.
+
+0.03 13 Jul 2007
+ Weaken context.
+
+0.01 18 Feb 2007
+ First version, released on an unsuspecting world.
+++ /dev/null
-.git/
-blib
-pm_to_blib
-MANIFEST.bak
-MANIFEST.SKIP~
-cover_db
-Makefile$
-Makefile.old$
use inc::Module::Install;
+use strict;
+use warnings;
name 'Catalyst-Component-ACCEPT_CONTEXT';
all_from 'lib/Catalyst/Component/ACCEPT_CONTEXT.pm';
-build_requires 'Catalyst::Runtime';
-build_requires 'Test::WWW::Mechanize::Catalyst';
-build_requires 'Test::More';
-build_requires 'ok';
+requires 'Catalyst';
+requires 'Scalar::Util';
+build_requires 'Devel::Cycle';
+auto_install;
+WriteAll;
-WriteAll();
+Catalyst-Component-ACCEPT_CONTEXT
+
+Make accessing the Catalyst context from a Model/View even easier.
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the perldoc command.
+
+ perldoc Catalyst::Component::ACCEPT_CONTEXT
+
+You can also look for information at:
+
+ Search CPAN
+ http://search.cpan.org/dist/Catalyst-Component-ACCEPT_CONTEXT
+
+ CPAN Request Tracker:
+ http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Component-ACCEPT_CONTEXT
+
+ AnnoCPAN, annotated CPAN documentation:
+ http://annocpan.org/dist/Catalyst-Component-ACCEPT_CONTEXT
+
+ CPAN Ratings:
+ http://cpanratings.perl.org/d/Catalyst-Component-ACCEPT_CONTEXT
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007 Jonathan Rockway
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
package Catalyst::Component::ACCEPT_CONTEXT;
-use strict;
+
use warnings;
+use strict;
+use NEXT;
+use Scalar::Util qw(weaken);
=head1 NAME
-Catalyst::Component::ACCEPT_CONTEXT -
+Catalyst::Component::ACCEPT_CONTEXT - Make the current Catalyst
+request context available in Models and Views.
+
+=head1 VERSION
+
+Version 0.05
+
+=cut
+
+our $VERSION = '0.05';
+
+=head1 SYNOPSIS
+
+Models and Views don't usually have access to the request object,
+since they probably don't really need it. Sometimes, however, having
+the request context available outside of Controllers makes your
+application cleaner. If that's the case, just use this module as a
+base class:
+
+ package MyApp::Model::Foobar;
+ use base qw|Catalyst::Component::ACCEPT_CONTEXT Catalyst::Model|;
+
+Then, you'll be able to get the current request object from within
+your model:
+
+ sub do_something {
+ my $self = shift;
+ print "The current URL is ". $self->context->req->uri->as_string;
+ }
+
+=head1 METHODS
+
+=head2 context
+
+Returns the current request context.
+
+=cut
+
+sub context {
+ return shift->{context};
+}
+
+=head2 ACCEPT_CONTEXT
+
+Catalyst calls this method to give the current context to your model.
+You should never call it directly.
+
+Note that a new instance of your component isn't created. All we do
+here is shove C<$c> into your component. ACCEPT_CONTEXT allows for
+other behavior that may be more useful; if you want something else to
+happen just implement it yourself.
+
+See L<Catalyst::Component> for details.
+
+=cut
+
+sub ACCEPT_CONTEXT {
+ my $self = shift;
+ my $context = shift;
+
+ $self->{context} = $context;
+ weaken($self->{context});
+
+ return $self->NEXT::ACCEPT_CONTEXT($context, @_) || $self;
+}
+
+=head2 COMPONENT
+
+Overridden to use initial application object as context before a request.
+
+=cut
+
+sub COMPONENT {
+ my $class = shift;
+ my $app = shift;
+ my $args = shift;
+ $args->{context} = $app;
+ weaken($args->{context}) if ref $args->{context};
+ return $class->NEXT::COMPONENT($app, $args, @_);
+}
+
+=head1 AUTHOR
+
+Jonathan Rockway, C<< <jrockway at cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-catalyst-component-accept_context at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Catalyst-Component-ACCEPT_CONTEXT>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Catalyst::Component::ACCEPT_CONTEXT
+
+You can also look for information at:
+
+=over 4
+
+=item * Catalyst Website
+
+L<http://www.catalystframework.org/>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Catalyst-Component-ACCEPT_CONTEXT>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Catalyst-Component-ACCEPT_CONTEXT>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Component-ACCEPT_CONTEXT>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Catalyst-Component-ACCEPT_CONTEXT>
+
+=back
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Jonathan Rockway.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
=cut
-1;
+1; # End of Catalyst::Component::ACCEPT_CONTEXT
-#!/usr/bin/env perl
+#!perl -T
-use strict;
-use warnings;
use Test::More tests => 1;
-use ok 'Catalyst::Component::ACCEPT_CONTEXT';
+
+BEGIN {
+ use_ok( 'Catalyst::Component::ACCEPT_CONTEXT' );
+}
+
+diag( "Testing Catalyst::Component::ACCEPT_CONTEXT $Catalyst::Component::ACCEPT_CONTEXT::VERSION, Perl $], $^X" );
--- /dev/null
+#!perl
+# Copyright (c) 2007 Jonathan Rockway <jrockway@cpan.org>
+
+use strict;
+use warnings;
+use Test::More tests => 4;
+
+use FindBin qw($Bin);
+use lib "$Bin/lib";
+use Catalyst::Test qw(TestApp);
+
+is( get('/controller'), 'controller', 'got controller ok' );
+is( get('/model'), 'model', 'model ok' );
+is( get('/view'), 'view', 'view ok' );
+is( get('/foo'), 'baz', 'got app at new() time' );
--- /dev/null
+# Copyright (c) 2007 Jonathan Rockway <jrockway@cpan.org>\r
+\r
+use strict;\r
+use warnings;\r
+use Test::More tests => 3;\r
+\r
+use FindBin qw($Bin);\r
+use lib "$Bin/lib";\r
+use Catalyst::Test qw(TestApp);\r
+\r
+is( get('/stash'), 'it worked', q{stashing works} );\r
+is( get('/cycle'), '1', 'no cycles');\r
+is( get('/weak_cycle'), '1', 'found weak cycle');\r
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+sub not_in_file_ok {
+ my ($filename, %regex) = @_;
+ open my $fh, "<", $filename
+ or die "couldn't open $filename for reading: $!";
+
+ my %violated;
+
+ while (my $line = <$fh>) {
+ while (my ($desc, $regex) = each %regex) {
+ if ($line =~ $regex) {
+ push @{$violated{$desc}||=[]}, $.;
+ }
+ }
+ }
+
+ if (%violated) {
+ fail("$filename contains boilerplate text");
+ diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+ } else {
+ pass("$filename contains no boilerplate text");
+ }
+}
+
+not_in_file_ok(README =>
+ "The README is used..." => qr/The README is used/,
+ "'version information here'" => qr/to provide version information/,
+);
+
+not_in_file_ok(Changes =>
+ "placeholder date/time" => qr(Date/time)
+);
+
+sub module_boilerplate_ok {
+ my ($module) = @_;
+ not_in_file_ok($module =>
+ 'the great new $MODULENAME' => qr/ - The great new /,
+ 'boilerplate description' => qr/Quick summary of what the module/,
+ 'stub function definition' => qr/function[12]/,
+ );
+}
+
+module_boilerplate_ok('lib/Catalyst/Component/ACCEPT_CONTEXT.pm');
+# Copyright (c) 2007 Jonathan Rockway <jrockway@cpan.org>
+
package TestApp;
use strict;
use warnings;
use Catalyst;
-
-__PACKAGE__->setup;
-
+TestApp->config(foo => 'baz');
+TestApp->setup;
1;
+
+# Copyright (c) 2007 Jonathan Rockway <jrockway@cpan.org>
+
package TestApp::Controller::Root;
use strict;
use warnings;
+use base qw/Catalyst::Component::ACCEPT_CONTEXT Catalyst::Controller/;
+use Devel::Cycle;
+
+__PACKAGE__->config(namespace => '');
+
+sub model : Global {
+ my ($self, $c) = @_;
+ $c->stash->{message} = "model";
+ $c->res->body($c->model('Test')->message);
+}
+
+sub view : Global {
+ my ($self, $c) = @_;
+ $c->stash->{message} = "view";
+ $c->res->body($c->view('Test')->message);
+}
-__PACKAGE__->config(namespace => q{});
+sub controller : Global {
+ my ($self, $c) = @_;
+ $c->res->body("controller");
+}
-use base 'Catalyst::Controller';
+sub foo : Global {
+ my ($self, $c) = @_;
+ $c->res->body($c->model('Test')->foo);
+}
-# your actions replace this one
-sub main :Path { $_[1]->res->body('<h1>It works</h1>') }
+sub stash : Global {
+ my ($self, $c) = @_;
+ $c->model('StashMe')->test;
+ $c->res->body($c->stash->{stashme}->foo);
+}
+
+sub cycle : Global {
+ my ($self, $c) = @_;
+ $c->model('StashMe')->test;
+ my $cycle_ok = 1;
+ my $got_cycle = sub { $cycle_ok = 0 };
+ find_cycle($c, $got_cycle);
+ $c->res->body($cycle_ok);
+}
+
+sub weak_cycle :Global {
+ my ($self, $c) = @_;
+ $c->model('StashMe')->test;
+ my $cycle_ok = 0;
+ my $got_cycle = sub { $cycle_ok = 1 };
+ find_weakened_cycle($c, $got_cycle);
+ $c->res->body($cycle_ok);
+}
1;
+
--- /dev/null
+#!/usr/bin/perl\r
+# StashMe.pm \r
+# Copyright (c) 2007 Jonathan Rockway <jrockway@cpan.org>\r
+\r
+package TestApp::Model::StashMe;\r
+use strict;\r
+use warnings;\r
+use base qw(Catalyst::Component::ACCEPT_CONTEXT Catalyst::Model);\r
+\r
+sub test {\r
+ my $self = shift;\r
+ $self->context->stash(stashme => $self);\r
+}\r
+\r
+sub foo {\r
+ return "it worked";\r
+}\r
+\r
+1;\r
--- /dev/null
+# Copyright (c) 2007 Jonathan Rockway <jrockway@cpan.org>
+
+package TestApp::Model::Test;
+use strict;
+use warnings;
+use base qw(Catalyst::Component::ACCEPT_CONTEXT Catalyst::Model);
+
+my $foo = 'bar';
+sub new {
+ my $self = shift;
+ $self = $self->NEXT::new(@_);
+ $foo = $self->context->config->{foo};
+ return $self;
+}
+
+sub message {
+ my $self = shift;
+ return $self->context->stash->{message};
+}
+
+sub foo {
+ return $foo;
+}
+
+1;
+
--- /dev/null
+# Copyright (c) 2007 Jonathan Rockway <jrockway@cpan.org>
+
+package TestApp::View::Test;
+use strict;
+use warnings;
+use base qw(Catalyst::Component::ACCEPT_CONTEXT Catalyst::View);
+
+sub message {
+ my $self = shift;
+ return $self->context->stash->{message};
+}
+
+1;
+
+++ /dev/null
-#!/usr/bin/env perl
-
-BEGIN {
- $ENV{CATALYST_ENGINE} ||= 'HTTP';
- $ENV{CATALYST_SCRIPT_GEN} = 31;
- require Catalyst::Engine::HTTP;
-}
-
-use strict;
-use warnings;
-use Getopt::Long;
-use Pod::Usage;
-use FindBin;
-use lib "$FindBin::Bin/..";
-
-my $debug = 0;
-my $fork = 0;
-my $help = 0;
-my $host = undef;
-my $port = 3000;
-my $keepalive = 0;
-my $restart = 0;
-my $restart_delay = 1;
-my $restart_regex = '\.yml$|\.yaml$|\.pm$';
-my $restart_directory = undef;
-my $background = 0;
-my $pidfile = "/tmp/testapp.pid";
-
-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,
- 'daemon' => \$background,
- 'pidfile=s' => \$pidfile,
-);
-
-pod2usage(1) if $help;
-
-if ( $restart ) {
- $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 TestApp;
-
-TestApp->run( $port, $host, {
- argv => \@argv,
- 'fork' => $fork,
- keepalive => $keepalive,
- restart => $restart,
- restart_delay => $restart_delay,
- restart_regex => qr/$restart_regex/,
- restart_directory => $restart_directory,
- background => $background,
- pidfile => $pidfile,
-} );
-
-1;
-
-=head1 NAME
-
-testapp_server.pl - Catalyst Testserver
-
-=head1 SYNOPSIS
-
-testapp_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 '../')
-
- -daemon background the server
- -pidfile=filename store the pid if the server in filename, if
- daemonizing
-
- See also:
- perldoc Catalyst::Manual
- perldoc Catalyst::Manual::Intro
-
-=head1 DESCRIPTION
-
-Run a Catalyst Testserver for this application.
-
-=head1 AUTHOR
-
-Sebastian Riedel, C<sri@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
+++ /dev/null
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use FindBin;
-use lib "$FindBin::Bin/..";
-use Catalyst::Test 'TestApp';
-
-print request($ARGV[0])->content . "\n";
-
-1;
+++ /dev/null
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-# setup library path
-use FindBin qw($Bin);
-use lib "$Bin/lib";
-
-# make sure testapp works
-use ok 'TestApp';
-
-# a live test against TestApp, the test application
-use Test::WWW::Mechanize::Catalyst 'TestApp';
-my $mech = Test::WWW::Mechanize::Catalyst->new;
-$mech->get_ok('http://localhost/', 'get main page');
-$mech->content_like(qr/it works/i, 'see if it has our text');
-
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+use Catalyst::Controller;
+my $NEW_CALLED;
+BEGIN {
+ $NEW_CALLED = 0;
+ { no warnings;
+ sub Catalyst::Controller::new {
+ $NEW_CALLED = 1;
+ return shift->NEXT::new(@_);
+ }
+ }
+}
+
+BEGIN { is $NEW_CALLED, 0, 'new not called yet' }
+
+use FindBin qw($Bin);
+use lib "$Bin/lib";
+use Catalyst::Test qw(TestApp);
+
+is $NEW_CALLED, '1', 'Catalyst::Controller::new does get called';
+
+1;
+
--- /dev/null
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More tests => 4;
+
+my $app = { app => 'oh yeah' };
+
+my $foo = Foo->COMPONENT($app, { args => 'yes' });
+is $foo->{args}, 'yes', 'foo created';
+is $foo->context->{app}, 'oh yeah', 'got app';
+
+my $ctx = { ctx => 'it is' };
+my $foo2 = $foo->ACCEPT_CONTEXT($ctx);
+is $foo, $foo2, 'foo and foo2 are the same ref';
+is $foo->context->{ctx}, 'it is', 'got ctx';
+
+{
+ package Foo;
+ use base qw/Catalyst::Component::ACCEPT_CONTEXT Catalyst::Component/;
+
+ sub new {
+ my $class = shift;
+ return $class->NEXT::new(@_);
+ }
+
+}
projects / catagits/Catalyst-Component-ACCEPT_CONTEXT.git / commitdiff