From: Marcus Ramberg Date: Mon, 28 Feb 2005 19:24:51 +0000 (+0000) Subject: initial import of catalyst. X-Git-Tag: 5.7099_04~1800 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=fc7ec1d96ee55d1bf42af3abce155ecb717b9e2b initial import of catalyst. --- fc7ec1d96ee55d1bf42af3abce155ecb717b9e2b diff --git a/Changes b/Changes new file mode 100644 index 0000000..c142284 --- /dev/null +++ b/Changes @@ -0,0 +1,58 @@ +This file documents the revision history for Perl extension Catalyst. + +4.00 Sun Feb 27 22:00:00 2005 + - more verbose debug messages, especially for forward() + - implemented prefixed prvate actions, icluding built in + !?default, !?begin and !?end + - new Catalyst::Manual::Intro + - new helpers, bin/catalyst + - helper api + +3.11 Wed Feb 23 21:00:00 2005 + - added dependency to UNIVERSAL::require (Marcus Ramberg) + - added a little workaround for a warning in Catalyst::Test + (Marcus Ramberg) + - improved documentation for actions + +3.10 Thu Feb 19 20:00:00 2005 + - removed roles management from Catalyst::Engine + and added it to Catalyst::Plugin::Authentication::CDBI + +3.04 Thu Feb 17 21:00:00 2005 + - error reporting for app class + - no more engine debug messages + - class->method forwards get resolved now + +3.03 Wed Feb 16 23:00:00 2005 + - friendlier statistics + +3.02 Wed Feb 16 22:00:00 2005 + - fixed unintialized actions (Marcus Ramberg) + +3.01 Wed Feb 16 20:30:00 2005 + - better statistics + +3.00 Wed Feb 16 20:00:00 2005 + - real version number for CPAN.pm + - fixed redirect in CGI engine + - more statistics in debug logs + - ? prefix for forward() + +2.99_15 Wed Feb 02 22:00:00 2005 + - support for short namespaces, MyApp::M, MyApp::V and MyApp::C + - Replaced "Catched" with "Caught" in Catalyst::Engine + (Gary Ashton Jones) + - replaced _ with ! for private actions + - added ? for prefixed actions + - misc improvememts + +2.99_14 Mon Jan 31 22:00:00 2005 + - arguments for _default + - $c->entrance removed for more flexibility + - added $c->req->method + +2.99_13 Sun Jan 30 18:00:00 2005 + - POD fixes and improvements + +2.99_12 Fri Jan 28 22:00:00 2005 + - first development release diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..4ff5625 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,22 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Catalyst', + VERSION_FROM => 'lib/Catalyst.pm', + EXE_FILES => ['bin/catalyst'], + PREREQ_PM => { + UNIVERSAL::require => 0, + CGI::Simple => 0, + Class::Accessor::Fast => 0, + Class::Data::Inheritable => 0, + HTML::Entities => 0, + HTTP::Headers => 0, + Module::Pluggable::Fast => 0 + } +); + +my $gabb = + int( rand(2) ) == 1 + ? "Gabbana is the greatest!" + : "Gabbana is drunk again!"; +print "$gabb\n"; diff --git a/README b/README new file mode 100644 index 0000000..3ff93e9 --- /dev/null +++ b/README @@ -0,0 +1,103 @@ +NAME + Catalyst - The Elegant MVC Web Application Framework + +SYNOPSIS + # use the helper to start a new application + catalyst MyApp + cd MyApp + + # add models, views, controllers + bin/create model Something + bin/create view Stuff + bin/create controller Yada + + # built in testserver + bin/server + + # command line interface + bin/test /yada + + See also L + + use Catalyst; + + use Catalyst qw/My::Module My::OtherModule/; + + use Catalyst '-Debug'; + + use Catalyst qw/-Debug -Engine=CGI/; + + __PACKAGE__->action( '!default' => sub { $_[1]->res->output('Hello') } ); + + __PACKAGE__->action( + 'index.html' => sub { + my ( $self, $c ) = @_; + $c->res->output('Hello'); + $c->forward('_foo'); + } + ); + + __PACKAGE__->action( + '/^product[_]*(\d*).html$/' => sub { + my ( $self, $c ) = @_; + $c->stash->{template} = 'product.tt'; + $c->stash->{product} = $c->req->snippets->[0]; + } + ); + +DESCRIPTION + Catalyst is based upon Maypole, which you should consider for smaller + projects. + + The key concept of Catalyst is DRY (Don't Repeat Yourself). + + See Catalyst::Manual for more documentation. + + Omit the Catalyst::Plugin:: prefix from plugins. So + Catalyst::Plugin::My::Module becomes My::Module. + + use Catalyst 'My::Module'; + + You can also set special flags like -Debug and -Engine. + + use Catalyst qw/-Debug My::Module/; + + The position of plugins and flags in the chain is important, because + they are loaded in the same order they appear. + + -Debug + use Catalyst '-Debug'; + + is equivalent to + + use Catalyst; + sub debug { 1 } + + -Engine + Force Catalyst to use a specific engine. Omit the Catalyst::Engine:: + prefix. + + use Catalyst '-Engine=CGI'; + + METHODS + debug + Overload to enable debug messages. + + config + Returns a hashref containing your applications settings. + +SEE ALSO + Catalyst::Manual, Catalyst::Test, Catalyst::Request, Catalyst::Response, + Catalyst::Engine + +AUTHOR + Sebastian Riedel, "sri@oook.de" + +THANK YOU + David Naughton, Gary Ashton Jones, Marcus Ramberg and all the others + who've helped. + +LICENSE + This library is free software . You can redistribute it and/or modify it + under the same terms as perl itself. + diff --git a/bin/catalyst b/bin/catalyst new file mode 100755 index 0000000..cc083d7 --- /dev/null +++ b/bin/catalyst @@ -0,0 +1,52 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Long; +use Pod::Usage; +use Catalyst::Helper; + +my $help = 0; + +GetOptions( 'help|?' => \$help ); + +pod2usage(1) if ( $help || !$ARGV[0] ); + +my $helper = Catalyst::Helper->new; +pod2usage(1) unless $helper->mk_app( $ARGV[0] ); + +1; +__END__ + +=head1 NAME + +catalyst - Bootstrap a Catalyst application + +=head1 SYNOPSIS + +catalyst [options] application-name + + Options: + -help display this help and exits + + application-name has to be a valid Perl module name and can include :: + + Examples: + catalyst My::App + catalyst MyApp + +=head1 DESCRIPTION + +Bootstrap a Catalyst application. + +=head1 AUTHOR + +Sebastian Riedel Sebastian Riedel, C + +=head1 COPYRIGHT + +Copyright 2004 Sebastian Riedel. All rights reserved. + +This library is free software. You can redistribute it and/or modify it under +the same terms as perl itself. + +=cut diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm new file mode 100644 index 0000000..8cae33d --- /dev/null +++ b/lib/Catalyst.pm @@ -0,0 +1,200 @@ +package Catalyst; + +use strict; +use base 'Class::Data::Inheritable'; +use UNIVERSAL::require; +use Catalyst::Log; + +__PACKAGE__->mk_classdata($_) for qw/_config log/; + +our $VERSION = '4.00'; +our @ISA; + +=head1 NAME + +Catalyst - The Elegant MVC Web Application Framework + +=head1 SYNOPSIS + + # use the helper to start a new application + catalyst MyApp + cd MyApp + + # add models, views, controllers + bin/create model Something + bin/create view Stuff + bin/create controller Yada + + # built in testserver + bin/server + + # command line interface + bin/test /yada + + + See also L + + + use Catalyst; + + use Catalyst qw/My::Module My::OtherModule/; + + use Catalyst '-Debug'; + + use Catalyst qw/-Debug -Engine=CGI/; + + __PACKAGE__->action( '!default' => sub { $_[1]->res->output('Hello') } ); + + __PACKAGE__->action( + 'index.html' => sub { + my ( $self, $c ) = @_; + $c->res->output('Hello'); + $c->forward('_foo'); + } + ); + + __PACKAGE__->action( + '/^product[_]*(\d*).html$/' => sub { + my ( $self, $c ) = @_; + $c->stash->{template} = 'product.tt'; + $c->stash->{product} = $c->req->snippets->[0]; + } + ); + +=head1 DESCRIPTION + +Catalyst is based upon L, which you should consider for smaller +projects. + +The key concept of Catalyst is DRY (Don't Repeat Yourself). + +See L for more documentation. + +Omit the Catalyst::Plugin:: prefix from plugins. +So Catalyst::Plugin::My::Module becomes My::Module. + + use Catalyst 'My::Module'; + +You can also set special flags like -Debug and -Engine. + + use Catalyst qw/-Debug My::Module/; + +The position of plugins and flags in the chain is important, +because they are loaded in the same order they appear. + +=head2 -Debug + + use Catalyst '-Debug'; + +is equivalent to + + use Catalyst; + sub debug { 1 } + +=head2 -Engine + +Force Catalyst to use a specific engine. +Omit the Catalyst::Engine:: prefix. + + use Catalyst '-Engine=CGI'; + +=head2 METHODS + +=head3 debug + +Overload to enable debug messages. + +=cut + +sub debug { 0 } + +=head3 config + +Returns a hashref containing your applications settings. + +=cut + +sub config { + my $self = shift; + $self->_config( {} ) unless $self->_config; + if ( $_[0] ) { + my $config = $_[1] ? {@_} : $_[0]; + while ( my ( $key, $val ) = each %$config ) { + $self->_config->{$key} = $val; + } + } + return $self->_config; +} + +sub import { + my ( $self, @options ) = @_; + my $caller = caller(0); + + # Class + { + no strict 'refs'; + *{"$caller\::handler"} = + sub { Catalyst::Engine::handler( $caller, @_ ) }; + push @{"$caller\::ISA"}, $self; + } + $self->log( Catalyst::Log->new ); + + # Options + my $engine = + $ENV{MOD_PERL} ? 'Catalyst::Engine::Apache' : 'Catalyst::Engine::CGI'; + foreach (@options) { + if (/^\-Debug$/) { + no warnings; + no strict 'refs'; + *{"$self\::debug"} = sub { 1 }; + $caller->log->debug('Debug messages enabled'); + } + elsif (/^-Engine=(.*)$/) { $engine = "Catalyst::Engine::$1" } + elsif (/^-.*$/) { $caller->log->error(qq/Unknown flag "$_"/) } + else { + my $plugin = "Catalyst::Plugin::$_"; + + # Plugin caller should be our application class + eval "package $caller; require $plugin"; + if ($@) { + $caller->log->error(qq/Couldn't load plugin "$plugin", "$@"/); + } + else { + $caller->log->debug(qq/Loaded plugin "$plugin"/) + if $caller->debug; + unshift @ISA, $plugin; + } + } + } + + # Engine + $engine = "Catalyst::Engine::$ENV{CATALYST_ENGINE}" + if $ENV{CATALYST_ENGINE}; + $engine->require; + die qq/Couldn't load engine "$engine", "$@"/ if $@; + push @ISA, $engine; + $caller->log->debug(qq/Loaded engine "$engine"/) if $caller->debug; +} + +=head1 SEE ALSO + +L, L, L, +L, L + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 THANK YOU + +David Naughton, Gary Ashton Jones, Marcus Ramberg and all the others who've +helped. + +=head1 LICENSE + +This library is free software . You can redistribute it and/or modify it under +the same terms as perl itself. + +=cut + +1; diff --git a/lib/Catalyst/Base.pm b/lib/Catalyst/Base.pm new file mode 100644 index 0000000..7da4dbc --- /dev/null +++ b/lib/Catalyst/Base.pm @@ -0,0 +1,97 @@ +package Catalyst::Base; + +use strict; +use base qw/Class::Data::Inheritable Class::Accessor::Fast/; +use NEXT; + +__PACKAGE__->mk_classdata('_config'); + +=head1 NAME + +Catalyst::Base - Catalyst Universal Base Class + +=head1 SYNOPSIS + + # lib/MyApp/Model/Something.pm + package MyApp::Model::Something; + + use base 'Catalyst::Base'; + + __PACKAGE__->config( foo => 'bar' ); + + sub test { + my $self = shift; + return $self->{foo}; + } + + sub forward_to_me { + my ( $self, $c ) = @_; + $c->response->output( $self->{foo} ); + } + + 1; + + # Methods can be a request step + $c->forward(qw/MyApp::Model::Something forward_to_me/); + MyApp->action( 'index.html' => \&MyApp::Model::Something::forward_to_me ); + + # Or just methods + print $c->comp('MyApp::Model::Something')->test; + + print $c->comp('MyApp::Model::Something')->{foo}; + +=head1 DESCRIPTION + +This is the universal base class for Catalyst components +(Model/View/Controller). + +It provides you with a generic new() for instantiation through Catalyst's +component loader with config() support and a process() method placeholder. + +=head2 METHODS + +=cut + +sub new { + my ( $self, $c ) = @_; + return $self->NEXT::new( $self->config ); +} + +=head3 config + +=cut + +sub config { + my $self = shift; + $self->_config( {} ) unless $self->_config; + if ( $_[0] ) { + my $config = $_[1] ? {@_} : $_[0]; + while ( my ( $key, $val ) = each %$config ) { + $self->_config->{$key} = $val; + } + } + return $self->_config; +} + +=head3 process + +=cut + +sub process { 1 } + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 COPYRIGHT + +This program is free software, you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm new file mode 100644 index 0000000..a1ec313 --- /dev/null +++ b/lib/Catalyst/Engine.pm @@ -0,0 +1,731 @@ +package Catalyst::Engine; + +use strict; +use base qw/Class::Data::Inheritable Class::Accessor::Fast/; +use UNIVERSAL::require; +use B; +use Data::Dumper; +use HTML::Entities; +use HTTP::Headers; +use Time::HiRes qw/gettimeofday tv_interval/; +use Catalyst::Request; +use Catalyst::Response; + +require Module::Pluggable::Fast; + +$Data::Dumper::Terse = 1; + +__PACKAGE__->mk_classdata($_) for qw/actions components/; +__PACKAGE__->mk_accessors(qw/request response/); + +__PACKAGE__->actions( + { plain => {}, regex => {}, compiled => {}, reverse => {} } ); + +*comp = \&component; +*req = \&request; +*res = \&response; + +our $COUNT = 1; +our $START = time; + +=head1 NAME + +Catalyst::Engine - The Catalyst Engine + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +=head2 METHODS + +=head3 action + +Add one or more actions. + + $c->action( '!foo' => sub { $_[1]->res->output('Foo!') } ); + +Get an action's class and coderef. + + my ($class, $code) = @{ $c->action('foo') }; + +Get a list of available actions. + + my @actions = $c->action; + +It also automatically calls setup() if needed. + +See L for more informations about actions. + +=cut + +sub action { + my $self = shift; + $self->setup unless $self->components; + $self->actions( {} ) unless $self->actions; + my $action; + $_[1] ? ( $action = {@_} ) : ( $action = shift ); + if ( ref $action eq 'HASH' ) { + while ( my ( $name, $code ) = each %$action ) { + my $class = B::svref_2object($code)->STASH->NAME; + my $caller = caller(0); + if ( $name =~ /^\/(.*)\/$/ ) { + my $regex = $1; + $self->actions->{compiled}->{qr/$regex/} = $name; + $self->actions->{regex}->{$name} = [ $class, $code ]; + } + elsif ( $name =~ /^\?(.*)$/ ) { + $name = $1; + $name = _prefix( $caller, $name ); + $self->actions->{plain}->{$name} = [ $class, $code ]; + } + elsif ( $name =~ /^\!\?(.*)$/ ) { + $name = $1; + $name = _prefix( $caller, $name ); + $name = "\!$name"; + $self->actions->{plain}->{$name} = [ $class, $code ]; + } + else { $self->actions->{plain}->{$name} = [ $class, $code ] } + $self->actions->{reverse}->{"$code"} = $name; + $self->log->debug( + qq/"$caller" defined "$name" as "$code" from "$class"/) + if $self->debug; + } + } + elsif ($action) { + if ( my $p = $self->actions->{plain}->{$action} ) { return [$p] } + elsif ( my $r = $self->actions->{regex}->{$action} ) { return [$r] } + else { + while ( my ( $regex, $name ) = + each %{ $self->actions->{compiled} } ) + { + if ( $action =~ $regex ) { + my @snippets; + for my $i ( 1 .. 9 ) { + no strict 'refs'; + last unless ${$i}; + push @snippets, ${$i}; + } + return [ $name, \@snippets ]; + } + } + } + return 0; + } + else { + return ( + keys %{ $self->actions->{plain} }, + keys %{ $self->actions->{regex} } + ); + } +} + +=head3 benchmark + +Takes a coderef with arguments and returns elapsed time as float. + + my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } ); + $c->log->info( sprintf "Processing took %f seconds", $elapsed ); + +=cut + +sub benchmark { + my $c = shift; + my $code = shift; + my $time = [gettimeofday]; + my @return = &$code(@_); + my $elapsed = tv_interval $time; + return wantarray ? ( $elapsed, @return ) : $elapsed; +} + +=head3 component (comp) + +Get a component object by name. + + $c->comp('MyApp::Model::MyModel')->do_stuff; + +Regex search for a component. + + $c->comp('mymodel')->do_stuff; + +=cut + +sub component { + my ( $c, $name ) = @_; + if ( my $component = $c->components->{$name} ) { + return $component; + } + else { + for my $component ( keys %{ $c->components } ) { + return $c->components->{$component} if $component =~ /$name/i; + } + } +} + +=head3 errors + +Returns an arrayref containing errors messages. + + my @errors = @{ $c->errors }; + +Add a new error. + + $c->errors('Something bad happened'); + +=cut + +sub errors { + my $c = shift; + my $errors = ref $_[0] eq 'ARRAY' ? $_[0] : [@_]; + push @{ $c->{errors} }, @$errors; + return $c->{errors}; +} + +=head3 finalize + +Finalize request. + +=cut + +sub finalize { + my $c = shift; + if ( !$c->res->output || $#{ $c->errors } >= 0 ) { + $c->res->headers->content_type('text/html'); + my $name = $c->config->{name} || 'Catalyst Application'; + my ( $title, $errors, $infos ); + if ( $c->debug ) { + $errors = join '
', @{ $c->errors }; + $errors ||= 'No output'; + $title = $name = "$name on Catalyst $Catalyst::VERSION"; + my $req = encode_entities Dumper $c->req; + my $res = encode_entities Dumper $c->res; + my $stash = encode_entities Dumper $c->stash; + $infos = <<""; +
+Request
+
$req
+Response
+
$res
+Stash
+
$stash
+ + } + else { + $title = $name; + $errors = ''; + $infos = <<""; +
+(en) Please come back later
+(de) Bitte versuchen sie es spaeter nocheinmal
+(nl) Gelieve te komen later terug
+(no) Vennligst prov igjen senere
+(fr) Veuillez revenir plus tard
+(es) Vuelto por favor mas adelante
+(pt) Voltado por favor mais tarde
+(it) Ritornato prego più successivamente
+
+ + $name = ''; + } + $c->res->{output} = <<""; + + + $title + + + +
+
$errors
+
$infos
+
$name
+
+ + + + } + if ( my $location = $c->res->redirect ) { + $c->log->debug(qq/Redirecting to "$location"/) if $c->debug; + $c->res->headers->header( Location => $location ); + $c->res->status(302); + } + $c->res->headers->content_length( length $c->res->output ); + my $status = $c->finalize_headers; + $c->finalize_output; + return $status; +} + +=head3 finalize_headers + +Finalize headers. + +=cut + +sub finalize_headers { } + +=head3 finalize_output + +Finalize output. + +=cut + +sub finalize_output { } + +=head3 forward + +Forward processing to a private/public action or a method from a class. +If you define a class without method it will default to process(). + + $c->forward('!foo'); + $c->forward('index.html'); + $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/); + $c->forward('MyApp::View::TT'); + +=cut + +sub forward { + my $c = shift; + my $command = shift; + unless ($command) { + $c->log->debug('Nothing to forward to') if $c->debug; + return 0; + } + if ( $command =~ /^\?(.*)$/ ) { + $command = $1; + my $caller = caller(0); + $command = _prefix( $caller, $command ); + } + elsif ( $command =~ /^\!\?(.*)$/ ) { + $command = $1; + my $caller = caller(0); + $command = _prefix( $caller, $command ); + $command = "\!$command"; + } + my ( $class, $code ); + if ( my $action = $c->action($command) ) { + ( $class, $code ) = @{ $action->[0] }; + } + else { + $class = $command; + if ( $class =~ /[^\w\:]/ ) { + $c->log->debug(qq/Couldn't forward to "$class"/) if $c->debug; + return 0; + } + my $method = shift || 'process'; + if ( $code = $class->can($method) ) { + $c->actions->{reverse}->{"$code"} = "$class->$method"; + } + else { + $c->log->debug(qq/Couldn't forward to "$class->$method"/) + if $c->debug; + return 0; + } + } + $class = $c->components->{$class} || $class; + return $c->process( $class, $code ); +} + +=head3 handler + +Handles the request. + +=cut + +sub handler { + my ( $class, $r ) = @_; + + # Always expect worst case! + my $status = -1; + eval { + my $handler = sub { + my $c = $class->prepare($r); + if ( $c->req->action ) { + my ( $begin, $end ); + if ( my $prefix = $c->req->args->[0] ) { + if ( $c->actions->{plain}->{"\!$prefix/begin"} ) { + $begin = "\!$prefix/begin"; + } + elsif ( $c->actions->{plain}->{'!begin'} ) { + $begin = '!begin'; + } + if ( $c->actions->{plain}->{"\!$prefix/end"} ) { + $end = "\!$prefix/end"; + } + elsif ( $c->actions->{plain}->{'!end'} ) { $end = '!end' } + } + $c->forward($begin) if $begin; + $c->forward( $c->req->action ) if $c->req->action; + $c->forward($end) if $end; + } + else { + my $action = $c->req->path; + my $error = $action + ? qq/Unknown resource "$action"/ + : "Congratulations, you're on Catalyst!"; + $c->log->error($error) if $c->debug; + $c->errors($error); + } + return $c->finalize; + }; + if ( $class->debug ) { + my $elapsed; + ( $elapsed, $status ) = $class->benchmark($handler); + $elapsed = sprintf '%f', $elapsed; + my $av = sprintf '%.3f', 1 / $elapsed; + $class->log->info( "Request took $elapsed" . "s ($av/s)" ); + } + else { $status = &$handler } + }; + if ( my $error = $@ ) { + chomp $error; + $class->log->error(qq/Caught exception in engine "$error"/); + } + $COUNT++; + return $status; +} + +=head3 prepare + +Turns the request (Apache, CGI...) into a Catalyst context. + +=cut + +sub prepare { + my ( $class, $r ) = @_; + my $c = bless { + request => Catalyst::Request->new( + { + arguments => [], + cookies => {}, + headers => HTTP::Headers->new, + parameters => {}, + snippets => [], + uploads => {} + } + ), + response => Catalyst::Response->new( + { cookies => {}, headers => HTTP::Headers->new, status => 200 } + ), + stash => {} + }, $class; + if ( $c->debug ) { + my $secs = time - $START || 1; + my $av = sprintf '%.3f', $COUNT / $secs; + $c->log->debug('********************************'); + $c->log->debug("* Request $COUNT ($av/s) [$$]"); + $c->log->debug('********************************'); + $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); + } + $c->prepare_request($r); + $c->prepare_path; + my $path = $c->request->path; + $c->log->debug(qq/Requested path "$path"/) if $c->debug; + $c->prepare_cookies; + $c->prepare_headers; + $c->prepare_action; + $c->prepare_parameters; + $c->prepare_uploads; + return $c; +} + +=head3 prepare_action + +Prepare action. + +=cut + +sub prepare_action { + my $c = shift; + my $path = $c->req->path; + my @path = split /\//, $c->req->path; + $c->req->args( \my @args ); + while (@path) { + my $path = join '/', @path; + if ( my $result = $c->action($path) ) { + + # It's a regex + if ($#$result) { + my $match = $result->[0]; + my @snippets = @{ $result->[1] }; + $c->log->debug(qq/Requested action "$path" matched "$match"/) + if $c->debug; + $c->log->debug( + 'Snippets are "' . join( ' ', @snippets ) . '"' ) + if ( $c->debug && @snippets ); + $c->req->action($match); + $c->req->snippets( \@snippets ); + } + else { + $c->req->action($path); + $c->log->debug(qq/Requested action "$path"/) if $c->debug; + } + $c->req->match($path); + $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' ) + if ( $c->debug && @args ); + last; + } + unshift @args, pop @path; + } + unless ( $c->req->action ) { + my $prefix = $c->req->args->[0]; + if ( $prefix && $c->actions->{plain}->{"\!$prefix/default"} ) { + $c->req->match(''); + $c->req->action("\!$prefix/default"); + $c->log->debug('Using prefixed default action') if $c->debug; + } + elsif ( $c->actions->{plain}->{'!default'} ) { + $c->req->match(''); + $c->req->action('!default'); + $c->log->debug('Using default action') if $c->debug; + } + } +} + +=head3 prepare_cookies; + +Prepare cookies. + +=cut + +sub prepare_cookies { } + +=head3 prepare_headers + +Prepare headers. + +=cut + +sub prepare_headers { } + +=head3 prepare_parameters + +Prepare parameters. + +=cut + +sub prepare_parameters { } + +=head3 prepare_path + +Prepare path and base. + +=cut + +sub prepare_path { } + +=head3 prepare_request + +Prepare the engine request. + +=cut + +sub prepare_request { } + +=head3 prepare_uploads + +Prepare uploads. + +=cut + +sub prepare_uploads { } + +=head3 process + +Process a coderef in given class and catch exceptions. +Errors are available via $c->errors. + +=cut + +sub process { + my ( $c, $class, $code ) = @_; + my $status; + eval { + if ( $c->debug ) + { + my $action = $c->actions->{reverse}->{"$code"} || "$code"; + my $elapsed; + ( $elapsed, $status ) = + $c->benchmark( $code, $class, $c, @{ $c->req->args } ); + $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed ) + if $c->debug; + } + else { $status = &$code( $class, $c, @{ $c->req->args } ) } + }; + if ( my $error = $@ ) { + chomp $error; + $error = qq/Caught exception "$error"/; + $c->log->error($error); + $c->errors($error) if $c->debug; + return 0; + } + return $status; +} + +=head3 remove_action + +Remove an action. + + $c->remove_action('!foo'); + +=cut + +sub remove_action { + my ( $self, $action ) = @_; + if ( delete $self->actions->{regex}->{$action} ) { + while ( my ( $regex, $name ) = each %{ $self->actions->{compiled} } ) { + if ( $name eq $action ) { + delete $self->actions->{compiled}->{$regex}; + last; + } + } + } + else { + delete $self->actions->{plain}->{$action}; + } +} + +=head3 request (req) + +Returns a C object. + + my $req = $c->req; + +=head3 response (res) + +Returns a C object. + + my $res = $c->res; + +=head3 setup + +Setup. + + MyApp->setup; + +=cut + +sub setup { + my $self = shift; + $self->setup_components; + if ( $self->debug ) { + my $name = $self->config->{name} || 'Application'; + $self->log->info("$name powered by Catalyst $Catalyst::VERSION"); + } +} + +=head3 setup_components + +Setup components. + +=cut + +sub setup_components { + my $self = shift; + + # Components + my $class = ref $self || $self; + eval <<""; + package $class; + import Module::Pluggable::Fast + name => '_components', + search => [ + '$class\::Controller', '$class\::C', + '$class\::Model', '$class\::M', + '$class\::View', '$class\::V' + ]; + + if ( my $error = $@ ) { + chomp $error; + $self->log->error( + qq/Couldn't initialize "Module::Pluggable::Fast", "$error"/); + } + $self->components( {} ); + for my $component ( $self->_components($self) ) { + $self->components->{ ref $component } = $component; + } + $self->log->debug( 'Initialized components "' + . join( ' ', keys %{ $self->components } ) + . '"' ) + if $self->debug; +} + +=head3 stash + +Returns a hashref containing all your data. + + $c->stash->{foo} ||= 'yada'; + print $c->stash->{foo}; + +=cut + +sub stash { + my $self = shift; + if ( $_[0] ) { + my $stash = $_[1] ? {@_} : $_[0]; + while ( my ( $key, $val ) = each %$stash ) { + $self->{stash}->{$key} = $val; + } + } + return $self->{stash}; +} + +sub _prefix { + my ( $class, $name ) = @_; + $class =~ /^.*::[(M)(Model)(V)(View)(C)(Controller)]+::(.*)$/; + my $prefix = lc $1 || ''; + $prefix =~ s/\:\:/_/g; + $name = "$prefix/$name" if $prefix; + return $name; +} + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 COPYRIGHT + +This program is free software, you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Catalyst/Engine/Apache.pm b/lib/Catalyst/Engine/Apache.pm new file mode 100644 index 0000000..97b3387 --- /dev/null +++ b/lib/Catalyst/Engine/Apache.pm @@ -0,0 +1,189 @@ +package Catalyst::Engine::Apache; + +use strict; +use mod_perl; +use constant MP2 => $mod_perl::VERSION >= 1.99; +use base 'Catalyst::Engine'; +use URI; + +# mod_perl +if (MP2) { + require Apache2; + require Apache::RequestIO; + require Apache::RequestRec; + require Apache::SubRequest; + require Apache::RequestUtil; + require APR::URI; + require Apache::URI; +} +else { require Apache } + +# libapreq +require Apache::Request; +require Apache::Cookie; +require Apache::Upload if MP2; + +__PACKAGE__->mk_accessors(qw/apache_request original_request/); + +=head1 NAME + +Catalyst::Engine::Apache - Catalyst Apache Engine + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +The Apache Engine. + +=head2 METHODS + +=head3 apache_request + +Returns an C object. + +=head3 original_request + +Returns the original Apache request object. + +=head2 OVERLOADED METHODS + +This class overloads some methods from C. + +=head3 finalize_headers + +=cut + +sub finalize_headers { + my $c = shift; + for my $name ( $c->response->headers->header_field_names ) { + next if $name =~ /Content-Type/i; + $c->original_request->headers_out->set( + $name => $c->response->headers->header($name) ); + } + while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) { + my %cookie = ( -name => $name, -value => $cookie->{value} ); + $cookie->{-expires} = $cookie->{expires} if $cookie->{expires}; + $cookie->{-domain} = $cookie->{domain} if $cookie->{domain}; + $cookie->{-path} = $cookie->{path} if $cookie->{path}; + $cookie->{-secure} = $cookie->{secure} if $cookie->{secure}; + my $cookie = Apache::Cookie->new( $c->original_request, %cookie ); + MP2 + ? $c->apache_request->err_headers_out->add( + 'Set-Cookie' => $cookie->as_string ) + : $cookie->bake; + } + $c->original_request->status( $c->response->status ); + $c->original_request->content_type( $c->response->headers->content_type + || 'text/plain' ); + MP2 || $c->apache_request->send_http_header; + return 0; +} + +=head3 finalize_output + +=cut + +sub finalize_output { + my $c = shift; + $c->original_request->print( $c->response->{output} ); +} + +=head3 prepare_cookies + +=cut + +sub prepare_cookies { + my $c = shift; + MP2 + ? $c->req->cookies( { Apache::Cookie->fetch } ) + : $c->req->cookies( + { Apache::Cookie->new( $c->apache_request )->fetch } ); +} + +=head3 prepare_headers + +=cut + +sub prepare_headers { + my $c = shift; + $c->req->method( $c->apache_request->method ); + $c->req->headers->header( %{ $c->apache_request->headers_in } ); +} + +=head3 prepare_parameters + +=cut + +sub prepare_parameters { + my $c = shift; + my %args; + foreach my $key ( $c->apache_request->param ) { + my @values = $c->apache_request->param($key); + $args{$key} = @values == 1 ? $values[0] : \@values; + } + $c->req->parameters( \%args ); +} + +=head3 prepare_path + +=cut + +sub prepare_path { + my $c = shift; + $c->req->path( $c->apache_request->uri ); + my $loc = $c->apache_request->location; + no warnings 'uninitialized'; + $c->req->{path} =~ s/^($loc)?\///; + my $base = URI->new; + $base->scheme( $c->apache_request->protocol =~ /HTTPS/ ? 'https' : 'http' ); + $base->host( $c->apache_request->hostname ); + $base->port( $c->apache_request->get_server_port ); + $base->path( $c->apache_request->location ); + $c->req->base( $base->as_string ); +} + +=head3 prepare_request + +=cut + +sub prepare_request { + my ( $c, $r ) = @_; + $c->apache_request( Apache::Request->new($r) ); + $c->original_request($r); +} + +=head3 prepare_uploads + +=cut + +sub prepare_uploads { + my $c = shift; + for my $upload ( $c->apache_request->upload ) { + $upload = $c->apache_request->upload($upload) if MP2; + $c->req->uploads->{ $upload->name } = { + fh => $upload->fh, + filename => $upload->filename, + size => $upload->size, + type => $upload->type + }; + } +} + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 COPYRIGHT + +This program is free software, you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Catalyst/Engine/CGI.pm b/lib/Catalyst/Engine/CGI.pm new file mode 100644 index 0000000..c6d387a --- /dev/null +++ b/lib/Catalyst/Engine/CGI.pm @@ -0,0 +1,164 @@ +package Catalyst::Engine::CGI; + +use strict; +use base 'Catalyst::Engine'; +use URI; + +require CGI::Simple; +require CGI::Cookie; + +__PACKAGE__->mk_accessors('cgi'); + +=head1 NAME + +Catalyst::Engine::CGI - The CGI Engine + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +This is the CGI engine for Catalyst. + +=head2 METHODS + +=head3 run + +To be called from a CGI script to start the Catalyst application. + +=head3 cgi + +This config parameter contains the C object. + +=head2 OVERLOADED METHODS + +This class overloads some methods from C. + +=head3 finalize_headers + +=cut + +sub finalize_headers { + my $c = shift; + my %headers = ( -nph => 1 ); + $headers{-status} = $c->response->status if $c->response->status; + for my $name ( $c->response->headers->header_field_names ) { + $headers{"-$name"} = $c->response->headers->header($name); + } + my @cookies; + while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) { + push @cookies, $c->cgi->cookie( + -name => $name, + -value => $cookie->{value}, + -expires => $cookie->{expires}, + -domain => $cookie->{domain}, + -path => $cookie->{path}, + -secure => $cookie->{secure} || 0 + ); + } + $headers{-cookie} = \@cookies if @cookies; + print $c->cgi->header(%headers); +} + +=head3 finalize_output + +=cut + +sub finalize_output { + my $c = shift; + print $c->response->output; +} + +=head3 prepare_cookies + +=cut + +sub prepare_cookies { shift->req->cookies( { CGI::Cookie->fetch } ) } + +=head3 prepare_headers + +=cut + +sub prepare_headers { + my $c = shift; + $c->req->method( $c->cgi->request_method ); + for my $header ( $c->cgi->http ) { + ( my $field = $header ) =~ s/^HTTPS?_//; + $c->req->headers->header( $field => $c->cgi->http($header) ); + } +} + +=head3 prepare_parameters + +=cut + +sub prepare_parameters { + my $c = shift; + my %vars = $c->cgi->Vars; + while ( my ( $key, $value ) = each %vars ) { + my @values = split "\0", $value; + $vars{$key} = @values <= 1 ? $values[0] : \@values; + } + $c->req->parameters( {%vars} ); +} + +=head3 prepare_path + +=cut + +sub prepare_path { + my $c = shift; + $c->req->path( $c->cgi->url( -absolute => 1, -path_info => 1 ) ); + my $loc = $c->cgi->url( -absolute => 1 ); + no warnings 'uninitialized'; + $c->req->{path} =~ s/^($loc)?\///; + $c->req->{path} .= '/' if $c->req->path eq $loc; + my $base = $c->cgi->url; + $base = URI->new($base); + $base->path('/') if ( $ENV{CATALYST_TEST} || !$base->path ); + $c->req->base( $base->as_string ); +} + +=head3 prepare_request + +=cut + +sub prepare_request { shift->cgi( CGI::Simple->new ) } + +=head3 prepare_uploads + +=cut + +sub prepare_uploads { + my $c = shift; + for my $name ( $c->cgi->upload ) { + my $filename = $c->req->params->{$name}; + $c->req->uploads->{$name} = { + fh => $c->cgi->upload($filename), + filename => $filename, + size => $c->cgi->upload_info( $filename, 'size' ), + type => $c->cgi->upload_info( $filename, 'mime' ) + }; + } +} + +sub run { shift->handler } + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 COPYRIGHT + +This program is free software, you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut + +1; +## Please see file perltidy.ERR diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm new file mode 100644 index 0000000..3db98d0 --- /dev/null +++ b/lib/Catalyst/Helper.pm @@ -0,0 +1,511 @@ +package Catalyst::Helper; + +use strict; +use base 'Class::Accessor::Fast'; +use File::Spec; +use File::Path; +use IO::File; +use FindBin; + +=head1 NAME + +Catalyst::Helper - Bootstrap a Catalyst application + +=head1 SYNOPSIS + +See L + +=head1 DESCRIPTION + +Bootstrap a Catalyst application. + +=head2 METHODS + +=head3 mk_app + +=cut + +sub mk_app { + my ( $self, $name ) = @_; + return 0 if $name =~ /[^\w\:]/; + $self->{name} = $name; + $self->{dir} = $name; + $self->{dir} =~ s/\:\:/-/g; + $self->_mk_dirs; + $self->_mk_appclass; + $self->_mk_makefile; + $self->_mk_apptest; + $self->_mk_server; + $self->_mk_test; + $self->_mk_create; + return 1; +} + +sub _mk_dirs { + my $self = shift; + mkpath $self->{dir} unless -d $self->{dir}; + $self->{bin} = File::Spec->catdir( $self->{dir}, 'bin' ); + mkpath $self->{bin}; + $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' ); + mkpath $self->{lib}; + $self->{root} = File::Spec->catdir( $self->{dir}, 'root' ); + mkpath $self->{root}; + $self->{t} = File::Spec->catdir( $self->{dir}, 't' ); + mkpath $self->{t}; + $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) ); + $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} ); + mkpath $self->{mod}; + $self->{m} = File::Spec->catdir( $self->{mod}, 'M' ); + mkpath $self->{m}; + $self->{v} = File::Spec->catdir( $self->{mod}, 'V' ); + mkpath $self->{v}; + $self->{c} = File::Spec->catdir( $self->{mod}, 'C' ); + mkpath $self->{c}; + $self->{base} = File::Spec->rel2abs( $self->{dir} ); +} + +sub _mk_appclass { + my $self = shift; + my $mod = $self->{mod}; + my $name = $self->{name}; + my $base = $self->{base}; + my $class = IO::File->new("> $mod.pm") + or die qq/Couldn't open "$mod.pm", "$!"/; + print $class <<"EOF"; +package $name; + +use strict; +use Catalyst qw/-Debug/; + +our \$VERSION = '0.01'; + +$name->config( + name => '$name', + root => '$base/root', +); + +$name->action( + + '!default' => sub { + my ( \$self, \$c ) = \@_; + \$c->res->output('Congratulations, $name is on Catalyst!'); + }, + +); + +=head1 NAME + +$name - A very nice application + +=head1 SYNOPSIS + + Very simple to use + +=head1 DESCRIPTION + +Very nice application. + +=head1 AUTHOR + +Clever guy + +=head1 LICENSE + +This library is free software . You can redistribute it and/or modify it under +the same terms as perl itself. + +=cut + +1; +EOF +} + +sub _mk_makefile { + my $self = shift; + my $name = $self->{name}; + my $dir = $self->{dir}; + my $class = $self->{class}; + my $makefile = IO::File->new("> $dir/Makefile.PL") + or die qq/Couldn't open "$dir\/Makefile.PL", "$!"/; + print $makefile <<"EOF"; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => '$name', + VERSION_FROM => 'lib/$class.pm', + PREREQ_PM => { Catalyst => 0 } +); +EOF +} + +sub _mk_apptest { + my $self = shift; + my $t = $self->{t}; + my $name = $self->{name}; + my $test = IO::File->new("> $t/01app.t") + or die qq/Couldn't open "$t\/01app.t", "$!"/; + print $test <<"EOF"; +use Test::More tests => 2; +use_ok( Catalyst::Test, '$name' ); + +ok( request('/')->is_success ); +EOF +} + +sub _mk_server { + my $self = shift; + my $name = $self->{name}; + my $bin = $self->{bin}; + my $server = IO::File->new("> $bin/server") + or die qq/Could't open "$bin\/server", "$!"/; + print $server <<"EOF"; +#!/usr/bin/perl -w + +use strict; +use Getopt::Long; +use Pod::Usage; +use FindBin; +use lib "\$FindBin::Bin/../lib"; +use Catalyst::Test '$name'; + +my \$help = 0; +my \$port = 3000; + +GetOptions( 'help|?' => \\\$help, 'port=s' => \\\$port ); + +pod2usage(1) if \$help; + +Catalyst::Test::server(\$port); + +1; +__END__ + +=head1 NAME + +server - Catalyst Testserver + +=head1 SYNOPSIS + +server [options] + + Options: + -help display this help and exits + -port port (defaults to 3000) + +=head1 DESCRIPTION + +Run a Catalyst Testserver for this application. + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 COPYRIGHT + +Copyright 2004 Sebastian Riedel. All rights reserved. + +This library is free software. You can redistribute it and/or modify it under +the same terms as perl itself. + +=cut +EOF + chmod 0700, "$bin/server"; +} + +sub _mk_test { + my $self = shift; + my $name = $self->{name}; + my $bin = $self->{bin}; + my $test = IO::File->new("> $bin/test") + or die qq/Could't open "$bin\/test", "$!"/; + print $test <<"EOF"; +#!/usr/bin/perl -w + +use strict; +use Getopt::Long; +use Pod::Usage; +use FindBin; +use lib "\$FindBin::Bin/../lib"; + +my \$help = 0; + +GetOptions( 'help|?' => \\\$help ); + +pod2usage(1) if ( \$help || !\$ARGV[0] ); + +require Catalyst::Test; +import Catalyst::Test '$name'; + +print get(\$ARGV[0]) . "\n"; + +1; +__END__ + +=head1 NAME + +test - Catalyst Test + +=head1 SYNOPSIS + +test [options] uri + + Options: + -help display this help and exits + + Examples: + test http://localhost/some_action + test /some_action + +=head1 DESCRIPTION + +Run a Catalyst action from the comand line. + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 COPYRIGHT + +Copyright 2004 Sebastian Riedel. All rights reserved. + +This library is free software. You can redistribute it and/or modify it under +the same terms as perl itself. + +=cut +EOF + chmod 0700, "$bin/test"; +} + +sub _mk_create { + my $self = shift; + my $name = $self->{name}; + my $bin = $self->{bin}; + my $create = IO::File->new("> $bin/create") + or die qq/Could't open "$bin\/create", "$!"/; + print $create <<"EOF"; +#!/usr/bin/perl -w + +use strict; +use Getopt::Long; +use Pod::Usage; +use Catalyst::Helper; + +my \$help = 0; + +GetOptions( 'help|?' => \$help ); + +pod2usage(1) if ( \$help || !\$ARGV[1] ); + +my \$helper = Catalyst::Helper->new; +pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV ); + +1; +__END__ + +=head1 NAME + +create - Create a new Catalyst Component + +=head1 SYNOPSIS + +create [options] model|view|controller name + + Options: + -help display this help and exits + + Examples: + create controller My::Controller + create model My::Model + create view My::View + +=head1 DESCRIPTION + +Create a new Catalyst Component. + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 COPYRIGHT + +Copyright 2004 Sebastian Riedel. All rights reserved. + +This library is free software. You can redistribute it and/or modify it under +the same terms as perl itself. + +=cut +EOF + chmod 0700, "$bin/create"; +} + +=head3 mk_component + +=cut + +sub mk_component { + my ( $self, $app, $type, $name, $helper, @args ) = @_; + return 0 + if ( $name =~ /[^\w\:]/ || !\$type =~ /^model|m|view|v|controller|c\$/i ); + return 0 if $name =~ /[^\w\:]/; + $type = 'M' if $type =~ /model|m/i; + $type = 'V' if $type =~ /view|v/i; + $type = 'C' if $type =~ /controller|c/i; + $self->{type} = $type; + $self->{name} = $name; + $self->{class} = "$app\::$type\::$name"; + $self->{app} = $app; + + # Class + my $appdir = File::Spec->catdir( split /\:\:/, $app ); + my $path = File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type ); + my $file = $name; + if ( $name =~ /\:/ ) { + my @path = split /\:\:/, $name; + $file = pop @path; + $path = File::Spec->catdir( $path, @path ); + mkpath $path; + } + $file = File::Spec->catfile( $path, "$file.pm" ); + $self->{file} = $file; + + # Test + my $dir = File::Spec->catdir( $FindBin::Bin, '..', 't' ); + my $num = '01'; + for my $i (<$dir/*.t>) { + $i =~ /(\d+)[^\/]*.t$/; + my $j = $1 || $num; + $num = $j if $j > $num; + } + $num++; + $num = sprintf '%02d', $num; + my $prefix = $name; + $prefix =~ s/::/_/g; + $prefix = lc $prefix; + my $tname = lc( $num . $type . '_' . $prefix . '.t' ); + $self->{prefix} = $prefix; + $self->{test_dir} = $dir; + $self->{test} = "$dir/$tname"; + + # Helper + if ($helper) { + my $comp = 'Model'; + $comp = 'View' if $type eq 'V'; + $comp = 'Controller' if $type eq 'C'; + my $class = "Catalyst::Helper::$comp\::$helper"; + eval "require $class"; + die qq/Couldn't load helper "$class", "$@"/ if $@; + if ( $class->can('mk_compclass') ) { + $class->mk_compclass( $self, @args ); + } + else { $self->_mk_compclass } + + if ( $class->can('mk_comptest') ) { + $class->mk_comptest( $self, @args ); + } + else { $self->_mk_comptest } + } + + # Fallback + else { + $self->_mk_compclass; + $self->_mk_comptest; + } + return 1; +} + +sub _mk_compclass { + my $self = shift; + my $app = $self->{app}; + my $class = $self->{class}; + my $type = $self->{type}; + my $action = ''; + $action = <<"EOF" if $type eq 'C'; + +$app->action( + + '!?default' => sub { + my ( \$self, \$c ) = \@_; + \$c->res->output('Congratulations, $class is on Catalyst!'); + }, + +); +EOF + my $file = $self->{file}; + my $comp = IO::File->new("> $file") + or die qq/Couldn't open "$file", "$!"/; + print $comp <<"EOF"; +package $class; + +use strict; +use base 'Catalyst::Base'; +$action +=head1 NAME + +$class - A Component + +=head1 SYNOPSIS + + Very simple to use + +=head1 DESCRIPTION + +Very nice component. + +=head1 AUTHOR + +Clever guy + +=head1 LICENSE + +This library is free software . You can redistribute it and/or modify it under +the same terms as perl itself. + +=cut + +1; +EOF +} + +sub _mk_comptest { + my $self = shift; + my $prefix = $self->{prefix}; + my $type = $self->{type}; + my $class = $self->{class}; + my $app = $self->{app}; + my $test = $self->{test}; + my $t = IO::File->new("> $test") or die qq/Couldn't open "$test", "$!"/; + + if ( $self->{type} eq 'C' ) { + print $t <<"EOF"; +use Test::More tests => 3; +use_ok( Catalyst::Test, '$app' ); +use_ok('$class'); + +ok( request('$prefix')->is_success ); +EOF + } + else { + print $t <<"EOF"; +use Test::More tests => 1; +use_ok('$class'); +EOF + } +} + +=head1 SEE ALSO + +L, L, L, +L, L + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 LICENSE + +This library is free software . You can redistribute it and/or modify it under +the same terms as perl itself. + +=cut + +1; diff --git a/lib/Catalyst/Log.pm b/lib/Catalyst/Log.pm new file mode 100644 index 0000000..7ae9f07 --- /dev/null +++ b/lib/Catalyst/Log.pm @@ -0,0 +1,71 @@ +package Catalyst::Log; + +use strict; +use base 'Class::Accessor::Fast'; + +=head1 NAME + +Catalyst::Log - Catalyst Log Class + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +Simple logging functionality for Catalyst. + +=head2 METHODS + +=head3 debug + +Log debug informations. + +=cut + +sub debug { _format( 'debug', $_[1] ) } + +=head3 error + +Log error informations. + +=cut + +sub error { _format( 'error', $_[1] ) } + +=head3 info + +Log informations. + +=cut + +sub info { _format( 'info', $_[1] ) } + +=head3 warn + +Log warnings. + +=cut + +sub warn { _format( 'warn', $_[1] ) } + +sub _format { + print STDERR '[' . localtime(time) . "] [catalyst] [$_[0]] $_[1]\n"; +} + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 COPYRIGHT + +This program is free software, you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Catalyst/Manual.pod b/lib/Catalyst/Manual.pod new file mode 100644 index 0000000..c2b1562 --- /dev/null +++ b/lib/Catalyst/Manual.pod @@ -0,0 +1,25 @@ +=head1 NAME + +Catalyst::Manual - User guide and reference for Catalyst + +=head1 DESCRIPTION + +This is the comprehensive user guide and reference for Catalyst. + +L + Introduction to Catalyst. + +L + Cooking with Catalyst. + +L + Here be dragons! + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 COPYRIGHT + +This program is free software, you can redistribute it and/or modify it under +the same terms as Perl itself. diff --git a/lib/Catalyst/Manual/Cookbook.pod b/lib/Catalyst/Manual/Cookbook.pod new file mode 100644 index 0000000..28f43e3 --- /dev/null +++ b/lib/Catalyst/Manual/Cookbook.pod @@ -0,0 +1,78 @@ +=head1 NAME + +Catalyst::Manual::Cookbook - Cooking with Catalyst + +=head1 DESCRIPTION + +Yummy! + +=head1 RECIPES + +=head2 Force debug screen + +You can force Catalyst to display the debug screen at the end of the request by +placing a die() call in the _end action. + + __PACKAGE__->action( + '!end' => sub { + my ( $self, $c ) = @_; + die "testing"; + } + ); + +=head2 Disable statistics + +Just add this line to your application class if you don't want those nifty +statistics in your debug messages. + + sub Catalyst::Log::info { } + +=head2 Scaffolding + +Scaffolding is very simple with Catalyst. +Just use Catalyst::Model::CDBI::CRUD as baseclass. + + # lib/MyApp/Model/CDBI.pm + package MyApp::Model::CDBI; + + use strict; + use base 'Catalyst::Model::CDBI::CRUD'; + + __PACKAGE__->config( + dsn => 'dbi:SQLite:/tmp/myapp.db', + relationships => 1 + ); + + 1; + + # lib/MyApp.pm + package MyApp; + + use Catalyst 'FormValidator'; + + __PACKAGE__->config( + name => 'My Application', + root => '/home/joeuser/myapp/root' + ); + + __PACKAGE__->action( + 'table' => sub { + my ( $self, $c ) = @_; + $c->form( optional => [ MyApp::Model::CDBI::Table->columns ] ); + $c->forward('MyApp::Model::CDBI::Table'); + } + ); + + 1; + +Modify the $c->form() parameters to match your needs, and don't forget to copy +the templates. ;) + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 COPYRIGHT + +This program is free software, you can redistribute it and/or modify it under +the same terms as Perl itself. diff --git a/lib/Catalyst/Manual/Internals.pod b/lib/Catalyst/Manual/Internals.pod new file mode 100644 index 0000000..ac939f4 --- /dev/null +++ b/lib/Catalyst/Manual/Internals.pod @@ -0,0 +1,37 @@ +=head1 NAME + +Catalyst::Manual::Internals - Catalyst Internals + +=head1 DESCRIPTION + +=head2 Lifecycle + +These are the steps of a Catalyst request, every step can be overloaded to +extend Catalyst. + + handler + prepare + prepare_request + prepare_path + prepare_cookies + prepare_headers + prepare_action + prepare_parameters + prepare_uploads + process + finalize + finalize_headers + finalize_output + +These steps are normally overloaded from engine classes, and extended by +plugins. +Extending means using multiple inheritance with L. + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 COPYRIGHT + +This program is free software, you can redistribute it and/or modify it under +the same terms as Perl itself. diff --git a/lib/Catalyst/Manual/Intro.pod b/lib/Catalyst/Manual/Intro.pod new file mode 100644 index 0000000..79ddbbf --- /dev/null +++ b/lib/Catalyst/Manual/Intro.pod @@ -0,0 +1,551 @@ +=head1 NAME + +Catalyst::Manual::Intro - Introduction to Catalyst + +=head1 DESCRIPTION + +This is a brief overview of why and how to use Catalyst. It explains how Catalyst works and shows how to quickly get a simple application up and running. + +=head2 What is Catalyst? + +Catalyst is an elegant web application framework, extremely flexible yet extremely simple. It's similar to Ruby on Rails, Spring (Java) and L, upon which it was originally based. + +=head3 MVC + +Catalyst follows the Model-View-Controller (MVC) design pattern, allowing you to easily separate concerns, like content, presentation and flow control, into separate modules. This separation allows you to modify code tat handles one concern without affecting code that handles the others. Catalyst promotes re-use of existing Perl modules that already handle common web application concerns well. + +Here's how the M, V and C map to those concerns, with examples of well-known Perl modules you may want to use for each. + +=over 4 + +=item * Model + +Access and modify content (data). L, L, L... + +=item * View + +Present content to the user. L