X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=c5294bddfd6593b3286a95c25fde00794a6ea74d;hp=7cde581408680823902267c725f7a08ebd0d5063;hb=ae9556190adec21134aa2ad4f52bc961bd3e28c8;hpb=4bd82c41837b80f57b4ca6a611a20d11d4830980 diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 7cde581..c5294bd 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -17,7 +17,9 @@ use Time::HiRes qw/gettimeofday tv_interval/; use URI; use Scalar::Util qw/weaken/; -__PACKAGE__->mk_accessors(qw/counter depth request response state/); +__PACKAGE__->mk_accessors( + qw/counter depth request response state action namespace/ +); # Laziness++ *comp = \&component; @@ -36,7 +38,7 @@ our $DETACH = "catalyst_detach\n"; require Module::Pluggable::Fast; # Helper script generation -our $CATALYST_SCRIPT_GEN = 6; +our $CATALYST_SCRIPT_GEN = 8; __PACKAGE__->mk_classdata($_) for qw/components arguments dispatcher engine log/; @@ -119,7 +121,7 @@ so C becomes C. use Catalyst 'My::Module'; -Special flags like -Debug and -Engine can also be specifed as arguments when +Special flags like -Debug and -Engine can also be specified as arguments when Catalyst is loaded: use Catalyst qw/-Debug My::Module/; @@ -167,6 +169,10 @@ Specify log level. =over 4 +=item $c->action + +Accessor for the current action + =item $c->comp($name) =item $c->component($name) @@ -251,6 +257,10 @@ from the function. sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) } +=item $c->namespace + +Accessor to the namespace of the current action + =item $c->setup Setup. @@ -500,9 +510,17 @@ Contains the return value of the last executed action. Returns a hashref containing all your data. - $c->stash->{foo} ||= 'yada'; print $c->stash->{foo}; +Keys may be set in the stash by assigning to the hash reference, or by passing +either a single hash reference or a list of key/value pairs as arguments. + +For example: + + $c->stash->{foo} ||= 'yada'; + $c->stash( { moose => 'majestic', qux => 0 } ); + $c->stash( bar => 1, gorch => 2 ); + =cut sub stash { @@ -516,6 +534,146 @@ sub stash { return $c->{stash}; } +=item $c->welcome_message + +Returns the Catalyst welcome HTML page. + +=cut + +sub welcome_message { + my $c = shift; + my $name = $c->config->{name}; + my $logo = $c->uri_for('/static/images/catalyst_logo.png'); + my $prefix = Catalyst::Utils::appprefix( ref $c ); + return <<"EOF"; + + + $name on Catalyst $VERSION + + + +
+
+

$name on Catalyst + $VERSION

+
+
+

+ +

+

Welcome to the wonderful world of Catalyst. + This MVC + framework will make web development something you had + never expected it to be: Fun, rewarding and quick.

+

What to do now?

+

That really depends on what you want to do. + We do, however, provide you with a few starting points.

+

If you want to jump right into web development with Catalyst + you might want to check out the documentation.

+ 
perldoc Catalyst::Manual::Intro
+perldoc Catalyst::Manual
+

What to do next?

+

Next it's time to write an actual application. Use the + helper scripts to generate controllers, + models and + views, + they can save you a lot of work.

+ 
script/${prefix}_create.pl -help
+

Also, be sure to check out the vast and growing + collection of plugins for Catalyst on CPAN, + you are likely to find what you need there. +

+ +

Need help?

+

Catalyst has a very active community. Here are the main places to + get in touch with us.

+ +

In conclusion

+

The Catalyst team hope you will enjoy using Catalyst as much + as we enjoyed making it. Please contact us if you have ideas + for improvement or other feedback.

+
+
+ + +EOF +} + =back =head1 INTERNAL METHODS @@ -592,14 +750,15 @@ sub execute { } $c->{depth}++; eval { - if ( $c->debug ) - { + if ( $c->debug ) { my ( $elapsed, @state ) = $c->benchmark( $code, $class, $c, @{ $c->req->args } ); push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ]; $c->state(@state); } - else { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) } + else { + $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) + } }; $c->{depth}--; @@ -805,7 +964,6 @@ sub prepare { arguments => [], body_parameters => {}, cookies => {}, - handle => \*STDIN, headers => HTTP::Headers->new, parameters => {}, query_parameters => {}, @@ -818,7 +976,6 @@ sub prepare { { body => '', cookies => {}, - handle => \*STDOUT, headers => HTTP::Headers->new(), status => 200 } @@ -910,8 +1067,8 @@ Prepare a chunk of data before sending it to HTTP::Body. =cut -sub prepare_body_chunk { - my $c = shift; +sub prepare_body_chunk { + my $c = shift; $c->engine->prepare_body_chunk( $c, @_ ); } @@ -1029,15 +1186,16 @@ sub prepare_uploads { if ( $c->debug && keys %{ $c->request->uploads } ) { my $t = Text::ASCIITable->new; - $t->setCols( 'Filename', 'Type', 'Size' ); - $t->setColWidth( 'Filename', 37, 1 ); - $t->setColWidth( 'Type', 24, 1 ); + $t->setCols( 'Key', 'Filename', 'Type', 'Size' ); + $t->setColWidth( 'Key', 12, 1 ); + $t->setColWidth( 'Filename', 28, 1 ); + $t->setColWidth( 'Type', 18, 1 ); $t->setColWidth( 'Size', 9, 1 ); $t->alignCol( 'Size', 'left' ); for my $key ( sort keys %{ $c->request->uploads } ) { my $upload = $c->request->uploads->{$key}; for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) { - $t->addRow( $key, $u->type, $u->size ); + $t->addRow( $key, $u->filename, $u->type, $u->size ); } } $c->log->debug( "File Uploads are:\n" . $t->draw ); @@ -1353,7 +1511,14 @@ data, if known. =cut -sub write { my $c = shift; return $c->engine->write( $c, @_ ) } +sub write { + my $c = shift; + + # Finalize headers if someone manually writes output + $c->finalize_headers; + + return $c->engine->write( $c, @_ ); +} =back @@ -1456,6 +1621,10 @@ Andy Grundman Andy Wardley +Andreas Marienborg + +Andrew Bramble + Andrew Ford Andrew Ruthven @@ -1500,14 +1669,16 @@ Tatsuhiko Miyagawa Ulf Edvinsson +Yuval Kogman + =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. +This library is free software, you can redistribute it and/or modify it under +the same terms as Perl itself. =cut