X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FHelper.pm;h=fab0b9aceb164c032ea8ad2371795abc580d6b9f;hb=87c8736657a2ec40afe7e66d7d490ca0a48ac5dd;hp=b9b2f5df7ec3e37206e08040c272cc91384b95f8;hpb=cb8d90e53d5eb2f3f985ca9f53d072797ab016af;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm index b9b2f5d..fab0b9a 100644 --- a/lib/Catalyst/Helper.pm +++ b/lib/Catalyst/Helper.pm @@ -7,6 +7,10 @@ use File::Spec; use File::Path; use IO::File; use FindBin; +use Template; +use Catalyst; + +my %cache; =head1 NAME @@ -18,12 +22,36 @@ See L =head1 DESCRIPTION -Bootstrap a Catalyst application. +Bootstrap a Catalyst application. Autogenerates scripts =head2 METHODS +=head3 get_file + +Slurp file from DATA. + +=cut + +sub get_file { + my ( $self, $class, $file ) = @_; + unless ( $cache{$class} ) { + local $/; + $cache{$class} = eval "package $class; "; + } + my $data = $cache{$class}; + my @files = split /^__(.+)__\n/m, $data; + shift @files; + while (@files) { + my ( $name, $content ) = splice @files, 0, 2; + return $content if $name eq $file; + } + return 0; +} + =head3 mk_app +Create the main application skeleton. + =cut sub mk_app { @@ -32,8 +60,15 @@ sub mk_app { $self->{name} = $name; $self->{dir} = $name; $self->{dir} =~ s/\:\:/-/g; + $self->{appprefix} = lc $self->{dir}; + $self->{appprefix} =~ s/-/_/g; + $self->{startperl} = $Config{startperl}; + $self->{scriptgen} = $Catalyst::CATALYST_SCRIPT_GEN; + $self->{author} = $self->{author} = $ENV{'AUTHOR'} + || eval { @{ [ getpwuid($<) ] }[6] } || 'A clever guy'; $self->_mk_dirs; $self->_mk_appclass; + $self->_mk_build; $self->_mk_makefile; $self->_mk_readme; $self->_mk_changes; @@ -48,12 +83,17 @@ sub mk_app { =head3 mk_component +This method is called by create.pl to make new components +for your application. + =cut sub mk_component { my $self = shift; my $app = shift; $self->{app} = $app; + $self->{author} = $self->{author} = $ENV{'AUTHOR'} + || eval { @{ [ getpwuid($<) ] }[6] } || 'A clever guy'; $self->{base} = File::Spec->catdir( $FindBin::Bin, '..' ); unless ( $_[0] =~ /^model|m|view|v|controller|c\$/i ) { my $helper = shift; @@ -67,8 +107,8 @@ sub mk_component { } else { my $type = shift; - my $name = shift; - my $helper = shift; + my $name = shift || "Missing name for model/view/controller"; + my $helper = shift ; my @args = @_; return 0 if $name =~ /[^\w\:]/; $type = 'M' if $type =~ /model|m/i; @@ -126,6 +166,8 @@ sub mk_component { =head3 mk_dir +Surprisingly, this function makes a directory. + =cut sub mk_dir { @@ -143,6 +185,8 @@ sub mk_dir { =head3 mk_file +writes content to a file. + =cut sub mk_file { @@ -179,6 +223,24 @@ sub next_test { return File::Spec->catfile( $dir, $type, $tname ); } +=head3 render_file + +Render and create a file from a template in DATA using +Template Toolkit. + +=cut + +sub render_file { + my ( $self, $file, $path, $vars ) = @_; + $vars ||= {}; + my $t = Template->new; + my $template = $self->get_file( ( caller(0) )[0], $file ); + return 0 unless $template; + my $output; + $t->process( \$template, { %{$self}, %$vars }, \$output ); + $self->mk_file( $path, $output ); +} + sub _mk_dirs { my $self = shift; $self->mk_dir( $self->{dir} ); @@ -208,33 +270,158 @@ sub _mk_dirs { sub _mk_appclass { my $self = shift; my $mod = $self->{mod}; - my $name = $self->{name}; - my $base = $self->{base}; - $self->mk_file( "$mod.pm", <<"EOF"); -package $name; + $self->render_file( 'appclass', "$mod.pm" ); +} + +sub _mk_build { + my $self = shift; + my $dir = $self->{dir}; + $self->render_file( 'build', "$dir\/Build.PL" ); +} + +sub _mk_makefile { + my $self = shift; + my $dir = $self->{dir}; + $self->render_file( 'makefile', "$dir\/Makefile.PL" ); +} + +sub _mk_readme { + my $self = shift; + my $dir = $self->{dir}; + $self->render_file( 'readme', "$dir\/README" ); +} + +sub _mk_changes { + my $self = shift; + my $dir = $self->{dir}; + my $time = localtime time; + $self->render_file( 'changes', "$dir\/Changes", { time => $time } ); +} + +sub _mk_apptest { + my $self = shift; + my $t = $self->{t}; + $self->render_file( 'apptest', "$t\/01app.t" ); + $self->render_file( 'podtest', "$t\/02pod.t" ); + $self->render_file( 'podcoveragetest', "$t\/03podcoverage.t" ); +} + +sub _mk_cgi { + my $self = shift; + my $script = $self->{script}; + my $appprefix = $self->{appprefix}; + $self->render_file( 'cgi', "$script\/$appprefix\_cgi.pl" ); + chmod 0700, "$script/$appprefix\_cgi.pl"; +} + +sub _mk_fcgi { + my $self = shift; + my $script = $self->{script}; + my $appprefix = $self->{appprefix}; + $self->render_file( 'fcgi', "$script\/$appprefix\_fcgi.pl" ); + chmod 0700, "$script/$appprefix\_fcgi.pl"; +} + +sub _mk_server { + my $self = shift; + my $script = $self->{script}; + my $appprefix = $self->{appprefix}; + $self->render_file( 'server', "$script\/$appprefix\_server.pl" ); + chmod 0700, "$script/$appprefix\_server.pl"; +} + +sub _mk_test { + my $self = shift; + my $script = $self->{script}; + my $appprefix = $self->{appprefix}; + $self->render_file( 'test', "$script/$appprefix\_test.pl" ); + chmod 0700, "$script/$appprefix\_test.pl"; +} + +sub _mk_create { + my $self = shift; + my $script = $self->{script}; + my $appprefix = $self->{appprefix}; + $self->render_file( 'create', "$script\/$appprefix\_create.pl" ); + chmod 0700, "$script/$appprefix\_create.pl"; +} + +sub _mk_compclass { + my $self = shift; + my $file = $self->{file}; + return $self->render_file( 'compclass', "$file" ); +} + +sub _mk_comptest { + my $self = shift; + my $test = $self->{test}; + $self->render_file( 'comptest', "$test" ); +} + +=head1 HELPERS + +Helpers are classes that provide two methods. + + * mk_compclass - creates the Component class + * mk_comptest - creates the Component test + +So when you call C, create would try to execute +Catalyst::Helper::View::TT->mk_compclass and +Catalyst::Helper::View::TT->mk_comptest. + +See L and L for +examples. + +All helper classes should be under one of the following namespaces. + + Catalyst::Helper::Model:: + Catalyst::Helper::View:: + Catalyst::Helper::Controller:: + +=head1 NOTE + +The helpers will read author name from /etc/passwd by default. +To override, please export the AUTHOR variable. + +=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; +__DATA__ + +__appclass__ +package [% name %]; use strict; use Catalyst qw/-Debug/; -our \$VERSION = '0.01'; +our $VERSION = '0.01'; -$name->config( - name => '$name', - root => '$base/root', -); +[% name %]->config( name => '[% name %]' ); -$name->action( +[% name %]->setup; - '!default' => sub { - my ( \$self, \$c ) = \@_; - \$c->res->output('Congratulations, $name is on Catalyst!'); - }, - -); +sub default : Private { + my ( $self, $c ) = @_; + $c->res->output('Congratulations, [% name %] is on Catalyst!'); +} =head1 NAME -$name - A very nice application +[% name %] - A very nice application =head1 SYNOPSIS @@ -246,103 +433,112 @@ Very nice application. =head1 AUTHOR -Clever guy +[%author%] =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 1; -EOF -} -sub _mk_makefile { - my $self = shift; - my $name = $self->{name}; - my $dir = $self->{dir}; - my $class = $self->{class}; - $self->mk_file( "$dir\/Makefile.PL", <<"EOF"); -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => '$name', - VERSION_FROM => 'lib/$class.pm', - PREREQ_PM => { Catalyst => 0 }, - test => { TESTS => join ' ', ( glob('t/*.t'), glob('t/*/*.t') ) } +__makefile__ + unless ( eval "use Module::Build::Compat 0.02; 1" ) { + print "This module requires Module::Build to install itself.\n"; + + require ExtUtils::MakeMaker; + my $yn = + ExtUtils::MakeMaker::prompt( ' Install Module::Build now from CPAN?', 'y' ); + + unless ( $yn =~ /^y/i ) { + die " *** Cannot install without Module::Build. Exiting ...\n"; + } + + require Cwd; + require File::Spec; + require CPAN; + + # Save this 'cause CPAN will chdir all over the place. + my $cwd = Cwd::cwd(); + my $makefile = File::Spec->rel2abs($0); + + CPAN::Shell->install('Module::Build::Compat') + or die " *** Cannot install without Module::Build. Exiting ...\n"; + + chdir $cwd or die "Cannot chdir() back to $cwd: $!"; + } + eval "use Module::Build::Compat 0.02; 1" or die $@; + use lib '_build/lib'; + Module::Build::Compat->run_build_pl( args => \@ARGV ); + require Module::Build; + Module::Build::Compat->write_makefile( build_class => 'Module::Build' ); + +__build__ +use strict; +use Catalyst::Build; + +my $build = Catalyst::Build->new( + create_makefile_pl => 'passthrough', + license => 'perl', + module_name => '[% name %]', + requires => { Catalyst => '5.10' }, + create_makefile_pl => 'passthrough', + script_files => [ glob('script/*') ], + test_files => [ glob('t/*.t'), glob('t/*/*.t') ] ); -EOF -} +$build->create_build_script; -sub _mk_readme { - my $self = shift; - my $dir = $self->{dir}; - $self->mk_file( "$dir\/README", <<"EOF"); -Run script/server.pl to test the application. -EOF -} +__readme__ +Run script/[% apprefix %]_server.pl to test the application. -sub _mk_changes { - my $self = shift; - my $name = $self->{name}; - my $dir = $self->{dir}; - my $time = localtime time; - $self->mk_file( "$dir\/Changes", <<"EOF"); -This file documents the revision history for Perl extension $name. +__changes__ +This file documents the revision history for Perl extension [% name %]. -0.01 $time +0.01 [% time %] - initial revision, generated by Catalyst -EOF -} -sub _mk_apptest { - my $self = shift; - my $t = $self->{t}; - my $name = $self->{name}; - $self->mk_file( "$t\/01app.t", <<"EOF"); +__apptest__ use Test::More tests => 2; -use_ok( Catalyst::Test, '$name' ); +use_ok( Catalyst::Test, '[% name %]' ); ok( request('/')->is_success ); -EOF - $self->mk_file( "$t\/02podcoverage.t", <<"EOF"); + +__podtest__ +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(); + +__podcoveragetest__ 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}; +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(); -EOF -} -sub _mk_cgi { - my $self = shift; - my $name = $self->{name}; - my $script = $self->{script}; - $self->mk_file( "$script\/nph-cgi.pl", <<"EOF"); -$Config{startperl} -w - -BEGIN { - \$ENV{CATALYST_ENGINE} = 'CGI'; - \$ENV{CATALYST_TEST} = 1; -} +__cgi__ +[% startperl %] -w +BEGIN { $ENV{CATALYST_ENGINE} = 'CGI' } use strict; use FindBin; -use lib "\$FindBin::Bin/../lib"; -use $name; +use lib "$FindBin::Bin/../lib"; +use [% name %]; -$name->run; +[% name %]->run; 1; -__END__ =head1 NAME -nph-cgi - Catalyst CGI +cgi - Catalyst CGI =head1 SYNOPSIS @@ -354,52 +550,30 @@ Run a Catalyst application as cgi. =head1 AUTHOR -Sebastian Riedel, C +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. +This library is free software. You can redistribute it and/or modify +it under the same terms as perl itself. =cut -EOF - chmod 0700, "$script/nph-cgi.pl"; -} -sub _mk_fcgi { - my $self = shift; - my $name = $self->{name}; - my $script = $self->{script}; - $self->mk_file( "$script\/fcgi.pl", <<"EOF"); -$Config{startperl} -w +__fcgi__ +[% startperl %] -w -BEGIN { - \$ENV{CATALYST_ENGINE} = 'CGI'; - \$ENV{CATALYST_TEST} = 1; -} +BEGIN { $ENV{CATALYST_ENGINE} = 'FCGI' } use strict; use FindBin; -use lib "\$FindBin::Bin/../lib"; -use FCGI; -use $name; - -my \$request = FCGI::Request(); -while ( \$request->Accept() >= 0 ) { - my \$output; - { - local(*STDOUT); - open( STDOUT, '>', \\\$output ); - $name->run; - } - \$output =~ s!^HTTP/\\d+.\\d+ \\d\\d\\d.*?\\n!!s; - print \$output; -} +use lib "$FindBin::Bin/../lib"; +use [% name %]; + +[% name %]->run; 1; -__END__ =head1 NAME @@ -415,50 +589,42 @@ Run a Catalyst application as fcgi. =head1 AUTHOR -Sebastian Riedel, C +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. +This library is free software. You can redistribute it and/or modify +it under the same terms as perl itself. =cut -EOF - chmod 0700, "$script/fcgi.pl"; -} -sub _mk_server { - my $self = shift; - my $name = $self->{name}; - my $script = $self->{script}; - $self->mk_file( "$script\/server.pl", <<"EOF"); -$Config{startperl} -w +__server__ +[% startperl %] -w BEGIN { - \$ENV{CATALYST_ENGINE} = 'Server'; - \$ENV{CATALYST_TEST} = 1; -} + $ENV{CATALYST_ENGINE} = 'HTTP'; + $ENV{CATALYST_SCRIPT_GEN} = [% scriptgen %]; +} use strict; use Getopt::Long; use Pod::Usage; use FindBin; -use lib "\$FindBin::Bin/../lib"; -use $name; +use lib "$FindBin::Bin/../lib"; +use [% name %]; -my \$help = 0; -my \$port = 3000; +my $help = 0; +my $port = 3000; -GetOptions( 'help|?' => \\\$help, 'port=s' => \\\$port ); +GetOptions( 'help|?' => \$help, 'port=s' => \$port ); -pod2usage(1) if \$help; +pod2usage(1) if $help; -$name->run(\$port); +[% name %]->run($port); 1; -__END__ =head1 NAME @@ -482,46 +648,38 @@ Run a Catalyst Testserver for this application. =head1 AUTHOR -Sebastian Riedel, C +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. +This library is free software. You can redistribute it and/or modify +it under the same terms as perl itself. =cut -EOF - chmod 0700, "$script/server.pl"; -} -sub _mk_test { - my $self = shift; - my $name = $self->{name}; - my $script = $self->{script}; - $self->mk_file( "$script/test.pl", <<"EOF"); -$Config{startperl} -w +__test__ +[% startperl %] -w + +BEGIN { $ENV{CATALYST_ENGINE} = 'Test' } use strict; use Getopt::Long; use Pod::Usage; use FindBin; -use lib "\$FindBin::Bin/../lib"; - -my \$help = 0; +use lib "$FindBin::Bin/../lib"; +use [% name %]; -GetOptions( 'help|?' => \\\$help ); +my $help = 0; -pod2usage(1) if ( \$help || !\$ARGV[0] ); +GetOptions( 'help|?' => \$help ); -require Catalyst::Test; -import Catalyst::Test '$name'; +pod2usage(1) if ( $help || !$ARGV[0] ); -print get(\$ARGV[0]) . "\n"; +print [% name %]->run($ARGV[0])->content . "\n"; 1; -__END__ =head1 NAME @@ -548,43 +706,35 @@ Run a Catalyst action from the comand line. =head1 AUTHOR -Sebastian Riedel, C +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. +This library is free software. You can redistribute it and/or modify +it under the same terms as perl itself. =cut -EOF - chmod 0700, "$script/test.pl"; -} -sub _mk_create { - my $self = shift; - my $name = $self->{name}; - my $script = $self->{script}; - $self->mk_file( "$script\/create.pl", <<"EOF"); -$Config{startperl} -w +__create__ +[% startperl %] -w use strict; use Getopt::Long; use Pod::Usage; use Catalyst::Helper; -my \$help = 0; +my $help = 0; GetOptions( 'help|?' => \$help ); -pod2usage(1) if ( \$help || !\$ARGV[0] ); +pod2usage(1) if ( $help || !$ARGV[0] ); -my \$helper = Catalyst::Helper->new; -pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV ); +my $helper = Catalyst::Helper->new; +pod2usage(1) unless $helper->mk_component( '[% name %]', @ARGV ); 1; -__END__ =head1 NAME @@ -623,41 +773,27 @@ Sebastian Riedel, C 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. +This library is free software. You can redistribute it and/or modify +it under the same terms as perl itself. =cut -EOF - chmod 0700, "$script/create.pl"; -} -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}; - return $self->mk_file( "$file", <<"EOF"); -package $class; +__compclass__ +package [% class %]; use strict; use base 'Catalyst::Base'; -$action + +[% IF type == 'C' %] +sub default : Private { + my ( $self, $c ) = @_; + $c->res->output('Congratulations, [% class %] is on Catalyst!'); +} + +[% END %] =head1 NAME -$class - A Component +[% class %] - A Component =head1 SYNOPSIS @@ -669,77 +805,25 @@ Very nice component. =head1 AUTHOR -Clever guy +[%author%] =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 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}; - if ( $self->{type} eq 'C' ) { - $self->mk_file( "$test", <<"EOF"); +__comptest__ +[% IF type == 'C' %] use Test::More tests => 3; -use_ok( Catalyst::Test, '$app' ); -use_ok('$class'); +use_ok( Catalyst::Test, '[% app %]' ); +use_ok('[% class %]'); -ok( request('$prefix')->is_success ); -EOF - } - else { - $self->mk_file( "$test", <<"EOF"); +ok( request('[% prefix %]')->is_success ); +[% ELSE %] use Test::More tests => 1; -use_ok('$class'); -EOF - } -} - -=head1 HELPERS - -Helpers are classes that provide two methods. - - * mk_compclass - creates the Component class - * mk_comptest - creates the Component test - -So when you call C, create would try to execute -Catalyst::Helper::View::TT->mk_compclass and -Catalyst::Helper::View::TT->mk_comptest. - -See L and L for -examples. - -All helper classes should be under one of the following namespaces. - - Catalyst::Helper::Model:: - Catalyst::Helper::View:: - Catalyst::Helper::Controller:: - -=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; +use_ok('[% class %]'); +[% END %]