X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FHelper.pm;h=21cb7e74ed82c9322f2bc66bea1dadfb641cde5b;hp=2f3e2a7c7be95b16c7d8d69e03a6f8fb671c9bb0;hb=1b2b8bdfa9e663a01bf0470180b355b4d5633b83;hpb=195631f4eb6fe6091112178b0c422a9b78fa5631 diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm index 2f3e2a7..21cb7e7 100644 --- a/lib/Catalyst/Helper.pm +++ b/lib/Catalyst/Helper.pm @@ -8,6 +8,7 @@ use File::Path; use IO::File; use FindBin; use Template; +use Catalyst; my %cache; @@ -21,7 +22,7 @@ See L =head1 DESCRIPTION -Bootstrap a Catalyst application. +Bootstrap a Catalyst application. Autogenerates scripts =head2 METHODS @@ -49,6 +50,8 @@ sub get_file { =head3 mk_app +Create the main application skeleton. + =cut sub mk_app { @@ -57,15 +60,22 @@ 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] } + || 'Catalyst developer'; $self->_mk_dirs; $self->_mk_appclass; + $self->_mk_build; $self->_mk_makefile; $self->_mk_readme; $self->_mk_changes; $self->_mk_apptest; $self->_mk_cgi; - $self->_mk_fcgi; + $self->_mk_fastcgi; $self->_mk_server; $self->_mk_test; $self->_mk_create; @@ -74,14 +84,20 @@ 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 ) { + unless ( $_[0] =~ /^(?:model|m|view|v|controller|c)$/i ) { my $helper = shift; my @args = @_; my $class = "Catalyst::Helper::$helper"; @@ -93,7 +109,7 @@ sub mk_component { } else { my $type = shift; - my $name = shift; + my $name = shift || "Missing name for model/view/controller"; my $helper = shift; my @args = @_; return 0 if $name =~ /[^\w\:]/; @@ -152,6 +168,8 @@ sub mk_component { =head3 mk_dir +Surprisingly, this function makes a directory. + =cut sub mk_dir { @@ -169,6 +187,8 @@ sub mk_dir { =head3 mk_file +writes content to a file. + =cut sub mk_file { @@ -195,19 +215,23 @@ sub next_test { else { my $name = $self->{name}; my $prefix = $name; - $prefix =~ s/::/_/g; - $prefix = lc $prefix; + $prefix =~ s/::/-/g; + $prefix = $prefix; $tname = $prefix . '.t'; $self->{prefix} = $prefix; + $prefix = lc $prefix; + $prefix =~ s/-/\//g; + $self->{uri} = $prefix; } my $dir = $self->{test_dir}; - my $type = lc $self->{type}; + my $type = $self->{type}; return File::Spec->catfile( $dir, $type, $tname ); } =head3 render_file -Render and create a file from a template in DATA. +Render and create a file from a template in DATA using +Template Toolkit. =cut @@ -233,9 +257,9 @@ sub _mk_dirs { $self->mk_dir( $self->{root} ); $self->{t} = File::Spec->catdir( $self->{dir}, 't' ); $self->mk_dir( $self->{t} ); - $self->mk_dir( File::Spec->catdir( $self->{t}, 'm' ) ); - $self->mk_dir( File::Spec->catdir( $self->{t}, 'v' ) ); - $self->mk_dir( File::Spec->catdir( $self->{t}, 'c' ) ); + $self->mk_dir( File::Spec->catdir( $self->{t}, 'M' ) ); + $self->mk_dir( File::Spec->catdir( $self->{t}, 'V' ) ); + $self->mk_dir( File::Spec->catdir( $self->{t}, 'C' ) ); $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) ); $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} ); $self->mk_dir( $self->{mod} ); @@ -254,6 +278,12 @@ sub _mk_appclass { $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}; @@ -282,38 +312,43 @@ sub _mk_apptest { } sub _mk_cgi { - my $self = shift; - my $script = $self->{script}; - $self->render_file( 'cgi', "$script\/cgi.pl" ); - chmod 0700, "$script/cgi.pl"; + 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}; - $self->render_file( 'fcgi', "$script\/fcgi.pl" ); - chmod 0700, "$script/fcgi.pl"; +sub _mk_fastcgi { + my $self = shift; + my $script = $self->{script}; + my $appprefix = $self->{appprefix}; + $self->render_file( 'fastcgi', "$script\/$appprefix\_fastcgi.pl" ); + chmod 0700, "$script/$appprefix\_fastcgi.pl"; } sub _mk_server { - my $self = shift; - my $script = $self->{script}; - $self->render_file( 'server', "$script\/server.pl" ); - chmod 0700, "$script/server.pl"; + 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}; - $self->render_file( 'test', "$script/test.pl" ); - chmod 0700, "$script/test.pl"; + 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}; - $self->render_file( 'create', "$script\/create.pl" ); - chmod 0700, "$script/create.pl"; + 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 { @@ -348,6 +383,11 @@ All helper classes should be under one of the following namespaces. 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, @@ -359,8 +399,8 @@ 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 @@ -375,68 +415,104 @@ use Catalyst qw/-Debug/; our $VERSION = '0.01'; -[% name %]->config( - name => '[% name %]', - root => '[% base %]/root', -); +[% name %]->config( name => '[% name %]' ); [% name %]->setup; -sub default : Private { - my ( $self, $c ) = @_; - $c->res->output('Congratulations, [% name %] is on Catalyst!'); -} - =head1 NAME -[% name %] - A very nice application +[% name %] - Catalyst based application =head1 SYNOPSIS - Very simple to use + script/[% appprefix %]_server.pl =head1 DESCRIPTION -Very nice application. +Catalyst based application. + +=head1 METHODS + +=over 4 + +=item default + +=cut + +sub default : Private { + my ( $self, $c ) = @_; + $c->res->output('Congratulations, [% name %] is on Catalyst!'); +} + +=back =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; - __makefile__ -use ExtUtils::MakeMaker; + unless ( eval "use Module::Build::Compat 0.02; 1" ) { + print "This module requires Module::Build to install itself.\n"; -WriteMakefile( - NAME => '[% name %]', - VERSION_FROM => 'lib/[% class %].pm', - PREREQ_PM => { Catalyst => 5 }, - test => { TESTS => join ' ', ( glob('t/*.t'), glob('t/*/*.t') ) } -); + require ExtUtils::MakeMaker; + my $yn = + ExtUtils::MakeMaker::prompt( ' Install Module::Build now from CPAN?', 'y' ); -__readme__ -Run script/server.pl to test the application. + unless ( $yn =~ /^y/i ) { + die " *** Cannot install without Module::Build. Exiting ...\n"; + } -__changes__ -This file documents the revision history for Perl extension $name. + 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') ] +); +$build->create_build_script; +__readme__ +Run script/[% appprefix %]_server.pl to test the application. +__changes__ +This file documents the revision history for Perl extension [% name %]. 0.01 [% time %] - initial revision, generated by Catalyst - __apptest__ use Test::More tests => 2; use_ok( Catalyst::Test, '[% name %]' ); ok( request('/')->is_success ); - __podtest__ use Test::More; @@ -445,7 +521,6 @@ 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; @@ -454,10 +529,10 @@ 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(); - __cgi__ [% startperl %] -w -BEGIN { $ENV{CATALYST_ENGINE} = 'CGI' } + +BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' } use strict; use FindBin; @@ -470,7 +545,7 @@ use [% name %]; =head1 NAME -cgi - Catalyst CGI +[% appprefix %]_cgi.pl - Catalyst CGI =head1 SYNOPSIS @@ -488,15 +563,14 @@ 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 - -__fcgi__ +__fastcgi__ [% startperl %] -w -BEGIN { $ENV{CATALYST_ENGINE} = 'FCGI' } +BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' } use strict; use FindBin; @@ -509,7 +583,7 @@ use [% name %]; =head1 NAME -fcgi - Catalyst FCGI +[% appprefix %]_fastcgi.pl - Catalyst FastCGI =head1 SYNOPSIS @@ -517,7 +591,7 @@ See L =head1 DESCRIPTION -Run a Catalyst application as fcgi. +Run a Catalyst application as fastcgi. =head1 AUTHOR @@ -527,15 +601,17 @@ 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 - __server__ [% startperl %] -w -BEGIN { $ENV{CATALYST_ENGINE} = 'HTTP' } +BEGIN { + $ENV{CATALYST_ENGINE} ||= 'HTTP'; + $ENV{CATALYST_SCRIPT_GEN} = [% scriptgen %]; +} use strict; use Getopt::Long; @@ -557,11 +633,11 @@ pod2usage(1) if $help; =head1 NAME -server - Catalyst Testserver +[% appprefix %]_server.pl - Catalyst Testserver =head1 SYNOPSIS -server.pl [options] +[% appprefix %]_server.pl [options] Options: -? -help display this help and exits @@ -583,15 +659,14 @@ 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 - __test__ [% startperl %] -w -BEGIN { $ENV{CATALYST_ENGINE} = 'Test' } +BEGIN { $ENV{CATALYST_ENGINE} ||= 'Test' } use strict; use Getopt::Long; @@ -612,18 +687,18 @@ print [% name %]->run($ARGV[0])->content . "\n"; =head1 NAME -test - Catalyst Test +[% appprefix %]_test.pl - Catalyst Test =head1 SYNOPSIS -test.pl [options] uri +[% appprefix %]_test.pl [options] uri Options: -help display this help and exits Examples: - test.pl http://localhost/some_action - test.pl /some_action + [% appprefix %]_test.pl http://localhost/some_action + [% appprefix %]_test.pl /some_action See also: perldoc Catalyst::Manual @@ -641,11 +716,10 @@ 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 - __create__ [% startperl %] -w @@ -667,24 +741,23 @@ pod2usage(1) unless $helper->mk_component( '[% name %]', @ARGV ); =head1 NAME -create - Create a new Catalyst Component +[% appprefix %]_create.pl - Create a new Catalyst Component =head1 SYNOPSIS -create.pl [options] model|view|controller name [helper] [options] +[% appprefix %]_create.pl [options] model|view|controller name [helper] [options] Options: -help display this help and exits Examples: - create.pl controller My::Controller - create.pl view My::View - create.pl view MyView TT - create.pl view TT TT - create.pl model My::Model - create.pl model SomeDB CDBI dbi:SQLite:/tmp/my.db - create.pl model AnotherDB CDBI dbi:Pg:dbname=foo root 4321 - create.pl Ajax + [% appprefix %]_create.pl controller My::Controller + [% appprefix %]_create.pl view My::View + [% appprefix %]_create.pl view MyView TT + [% appprefix %]_create.pl view TT TT + [% appprefix %]_create.pl model My::Model + [% appprefix %]_create.pl model SomeDB CDBI dbi:SQLite:/tmp/my.db + [% appprefix %]_create.pl model AnotherDB CDBI dbi:Pg:dbname=foo root 4321 See also: perldoc Catalyst::Manual @@ -702,56 +775,62 @@ 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 - __compclass__ package [% class %]; use strict; use base 'Catalyst::Base'; -[% IF type == 'C' %] -sub default : Private { - my ( $self, $c ) = \@_; - $c->res->output('Congratulations, [% class %] is on Catalyst!'); -} - -[% END %] =head1 NAME -[% class %] - A Component +[% class %] - Catalyst component =head1 SYNOPSIS - Very simple to use +See L<[% app %]> =head1 DESCRIPTION -Very nice component. +Catalyst component. +[% IF type == 'C' %] +=head1 METHODS + +=over 4 + +=item default + +=cut + +sub default : Private { + my ( $self, $c ) = @_; + $c->res->output('Congratulations, [% class %] is on Catalyst!'); +} +=back +[% END %] =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; - __comptest__ [% IF type == 'C' %] use Test::More tests => 3; use_ok( Catalyst::Test, '[% app %]' ); use_ok('[% class %]'); -ok( request('[% prefix %]')->is_success ); +ok( request('[% uri %]')->is_success ); [% ELSE %] use Test::More tests => 1; use_ok('[% class %]');