X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FHelper.pm;h=94e17e348fca2db09f7f87071345bc14dfe53118;hb=a167676aab17c831bee4825cd9a8003e0a0c0676;hp=bfd026ebb552c7353054f89583533a8a52990f15;hpb=b7ae88ed86de2f1d70a8a84537616c6368324e88;p=catagits%2FCatalyst-Devel.git diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm index bfd026e..94e17e3 100644 --- a/lib/Catalyst/Helper.pm +++ b/lib/Catalyst/Helper.pm @@ -1,6 +1,5 @@ package Catalyst::Helper; use Moose; -use Moose::Util::TypeConstraints; use Config; use File::Spec; use File::Spec::Unix; @@ -14,8 +13,14 @@ use Catalyst::Utils; use Catalyst::Exception; use Path::Class qw/dir file/; use File::ShareDir qw/dist_dir/; +use YAML::Tiny; use namespace::autoclean; +with 'MooseX::Emulate::Class::Accessor::Fast'; + +# Change Catalyst/Devel.pm also +our $VERSION = '1.33'; + my %cache; =head1 NAME @@ -31,7 +36,10 @@ Catalyst::Helper - Bootstrap a Catalyst application sub get_sharedir_file { my ($self, @filename) = @_; my $dist_dir; - if (-d "inc/.author" && -f "lib/Catalyst/Helper.pm" + if (exists $ENV{CATALYST_DEVEL_SHAREDIR}) { + $dist_dir = $ENV{CATALYST_DEVEL_SHAREDIR}; + } + elsif (-d "inc/.author" && -f "lib/Catalyst/Helper.pm" ) { # Can't use sharedir if we're in a checkout # this feels horrible, better ideas? $dist_dir = 'share'; @@ -63,64 +71,50 @@ sub get_file { } return 0; } -my $appname = subtype 'Str', - where { not (/[^\w:]/ or /^\d/ or /\b:\b|:{3,}/) }, - message { "Error: Invalid application name '$_'." }; -has name => ( is => 'ro', isa => $appname, required => 1 ); -my @lazy_strs = qw/ dir appprefix author rootname /; -foreach my $name (@lazy_strs) { - has $name => ( is => 'ro', isa => 'Str', init_arg => undef, lazy => 1, builder => "_build_$name" ); -} +sub mk_app { + my ( $self, $name ) = @_; -class_type 'Path::Class::Dir'; -my $coerced_dir = subtype 'Str', where { 1 }; -coerce $coerced_dir, from 'Path::Class::Dir', via { '' . $_ }; + # Needs to be here for PAR + require Catalyst; -my @lazy_dirs = qw/ lib root static images t class mod m v c base script /; -foreach my $name (@lazy_dirs) { - has $name => ( is => 'ro', isa => $coerced_dir, coerce => 1, init_arg => undef, lazy => 1, builder => "_build_$name" ); -} + if($name eq '.') { + if(!-e 'META.yml') { + system perl => 'Makefile.PL' + and Catalyst::Exception->throw(message => q( + Failed to run "perl Makefile.PL". + )); + } -sub BUILD { - my $self = shift; - $self->$_ for @lazy_strs, @lazy_dirs; -} + $name = YAML::Tiny->read('META.yml')->[0]->{'name'}; + $name =~ s/-/::/g; + $self->{dir} = '.'; + } -sub _build_lib { dir( shift->dir, 'lib' ) } -sub _build_root { dir( shift->dir, 'root' ) } -sub _build_static { dir( shift->root, 'static' ) } -sub _build_images { dir( shift->static, 'images' ) } -sub _build_t { dir( shift->dir, 't' ) } -sub _build_class { dir( split( /\:\:/, shift->name ) ) } -sub _build_mod { my $self = shift; dir( $self->lib, $self->class ) } -sub _build_m { dir( shift->mod, 'Model' ) } -sub _build_v { dir( shift->mod, 'View' ) } -sub _build_c { dir( shift->mod, 'Controller' ) } -sub _build_base { dir( shift->dir )->absolute } -sub _build_script { dir( shift->dir, 'script' ) } - -sub _build_dir { my $dir = shift->name; $dir =~ s/\:\:/-/g; return $dir; } -sub _build_appprefix { Catalyst::Utils::appprefix(shift->name) } -sub _build_author { - $ENV{'AUTHOR'} - || eval { @{ [ getpwuid($<) ] }[6] } - || 'Catalyst developer'; -} -sub _build_rootname { shift->name . '::Controller::Root' } + if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) { + warn "Error: Invalid application name.\n"; + return 0; + } -sub mk_app { - my ( $self ) = @_; - # Needs to be here for PAR - require Catalyst; + if(!defined $self->{'dir'}) { + $self->{dir} = $name; + $self->{dir} =~ s/\:\:/-/g; + } + $self->{name } = $name; + $self->{script } = dir( $self->{dir}, 'script' ); + $self->{appprefix } = Catalyst::Utils::appprefix($name); + $self->{appenv } = Catalyst::Utils::class2env($name); $self->{startperl } = -r '/usr/bin/env' ? '#!/usr/bin/env perl' - : "#!$Config{perlpath} -w"; + : "#!$Config{perlpath}"; $self->{scriptgen } = $Catalyst::Devel::CATALYST_SCRIPT_GEN; $self->{catalyst_version} = $Catalyst::VERSION; + $self->{author } ||= $ENV{'AUTHOR'} + || eval { @{ [ getpwuid($<) ] }[6] } + || 'Catalyst developer'; my $gen_scripts = ( $self->{makefile} ) ? 0 : 1; my $gen_makefile = ( $self->{scripts} ) ? 0 : 1; @@ -128,7 +122,8 @@ sub mk_app { if ($gen_app) { for ( qw/ _mk_dirs _mk_config _mk_appclass _mk_rootclass _mk_readme - _mk_changes _mk_apptest _mk_images _mk_favicon/ ) { + _mk_changes _mk_apptest _mk_podtest _mk_podcoveragetest + _mk_images _mk_favicon/ ) { $self->$_; } @@ -143,7 +138,7 @@ sub mk_app { $self->$_; } } - return $self->dir; + return $self->{dir}; } ## not much of this can really be changed, mk_compclass must be left for @@ -152,7 +147,10 @@ sub mk_component { my $self = shift; my $app = shift; $self->{app} = $app; - $self->{base} ||= dir( $FindBin::Bin, '..' ); # FIXME! + $self->{author} = $self->{author} = $ENV{'AUTHOR'} + || eval { @{ [ getpwuid($<) ] }[6] } + || 'A clever guy'; + $self->{base} ||= dir( $FindBin::Bin, '..' ); unless ( $_[0] =~ /^(?:model|view|controller)$/i ) { my $helper = shift; my @args = @_; @@ -255,7 +253,6 @@ sub mk_dir { sub mk_file { my ( $self, $file, $content ) = @_; - Carp::confess("No file") unless $file; if ( -e $file && -s _ ) { print qq/ exists "$file"\n/; return 0 @@ -275,7 +272,7 @@ sub mk_file { binmode $f; print $f $content; print qq/created "$file"\n/; - return 1; + return $file; } Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ ); @@ -306,20 +303,20 @@ sub next_test { ## compatability. otherwise, we'd have no way to pass stuff from __DATA__ sub render_file { - my ( $self, $file, $path, $vars ) = @_; + my ( $self, $file, $path, $vars, $perms ) = @_; my $template = $self->get_file( ( caller(0) )[0], $file ); - $self->render_file_contents($template, $path, $vars); + $self->render_file_contents($template, $path, $vars, $perms); } sub render_sharedir_file { - my ( $self, $file, $path, $vars ) = @_; + my ( $self, $file, $path, $vars, $perms ) = @_; my $template = $self->get_sharedir_file( $file ); die("Cannot get template from $file for $self\n") unless $template; - $self->render_file_contents($template, $path, $vars); + $self->render_file_contents($template, $path, $vars, $perms); } sub render_file_contents { - my ( $self, $template, $path, $vars ) = @_; + my ( $self, $template, $path, $vars, $perms ) = @_; $vars ||= {}; my $t = Template->new; return 0 unless $template; @@ -327,7 +324,8 @@ sub render_file_contents { $t->process( \$template, { %{$self}, %$vars }, \$output ) || Catalyst::Exception->throw( message => qq/Couldn't process "$template", / . $t->error() ); - $self->mk_file( $path, $output ); + my $file = $self->mk_file( $path, $output ); + chmod $perms, file($file) if defined $perms; } sub _mk_information { @@ -337,9 +335,43 @@ sub _mk_information { sub _mk_dirs { my $self = shift; - foreach my $name ( qw/ dir script lib root static images t mod m v c /) { - $self->mk_dir( $self->$name() ); + $self->mk_dir( $self->{dir} ); + $self->mk_dir( $self->{script} ); + $self->{lib} = dir( $self->{dir}, 'lib' ); + $self->mk_dir( $self->{lib} ); + $self->{root} = dir( $self->{dir}, 'root' ); + $self->mk_dir( $self->{root} ); + $self->{static} = dir( $self->{root}, 'static' ); + $self->mk_dir( $self->{static} ); + $self->{images} = dir( $self->{static}, 'images' ); + $self->mk_dir( $self->{images} ); + $self->{t} = dir( $self->{dir}, 't' ); + $self->mk_dir( $self->{t} ); + + $self->{class} = dir( split( /\:\:/, $self->{name} ) ); + $self->{mod} = dir( $self->{lib}, $self->{class} ); + $self->mk_dir( $self->{mod} ); + + if ( $self->{short} ) { + $self->{m} = dir( $self->{mod}, 'M' ); + $self->mk_dir( $self->{m} ); + $self->{v} = dir( $self->{mod}, 'V' ); + $self->mk_dir( $self->{v} ); + $self->{c} = dir( $self->{mod}, 'C' ); + $self->mk_dir( $self->{c} ); + } + else { + $self->{m} = dir( $self->{mod}, 'Model' ); + $self->mk_dir( $self->{m} ); + $self->{v} = dir( $self->{mod}, 'View' ); + $self->mk_dir( $self->{v} ); + $self->{c} = dir( $self->{mod}, 'Controller' ); + $self->mk_dir( $self->{c} ); } + my $name = $self->{name}; + $self->{rootname} = + $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root"; + $self->{base} = dir( $self->{dir} )->absolute; } sub _mk_appclass { @@ -351,81 +383,101 @@ sub _mk_appclass { sub _mk_rootclass { my $self = shift; $self->render_sharedir_file( file('lib', 'MyApp', 'Controller', 'Root.pm.tt'), - file( $self->c, "Root.pm" ) ); + file( $self->{c}, "Root.pm" ) ); } sub _mk_makefile { my $self = shift; $self->{path} = dir( 'lib', split( '::', $self->{name} ) ); $self->{path} .= '.pm'; - $self->render_sharedir_file( 'Makefile.PL.tt', file($self->dir, "Makefile.PL") ); + my $dir = $self->{dir}; + $self->render_sharedir_file( 'Makefile.PL.tt', file($dir, "Makefile.PL") ); if ( $self->{makefile} ) { # deprecate the old Build.PL file when regenerating Makefile.PL $self->_deprecate_file( - file( $self->dir, 'Build.PL' ) ); + file( $self->{dir}, 'Build.PL' ) ); } } sub _mk_config { my $self = shift; + my $dir = $self->{dir}; + my $appprefix = $self->{appprefix}; $self->render_sharedir_file( 'myapp.conf.tt', - file( $self->dir, $self->appprefix . ".conf" ) ); + file( $dir, "$appprefix.conf" ) ); } sub _mk_readme { my $self = shift; - $self->render_sharedir_file( 'README.tt', file($self->dir, "README") ); + my $dir = $self->{dir}; + $self->render_sharedir_file( 'README.tt', file($dir, "README") ); } sub _mk_changes { my $self = shift; + my $dir = $self->{dir}; my $time = strftime('%Y-%m-%d %H:%M:%S', localtime time); - $self->render_sharedir_file( 'Changes.tt', file($self->dir, "Changes"), { time => $time } ); + $self->render_sharedir_file( 'Changes.tt', file($dir, "Changes"), { time => $time } ); } sub _mk_apptest { my $self = shift; my $t = $self->{t}; $self->render_sharedir_file( file('t', '01app.t.tt'), file($t, "01app.t") ); +} + +sub _mk_podtest { + my $self = shift; + my $t = $self->{t}; $self->render_sharedir_file( file('t', '02pod.t.tt'), file($t, "02pod.t") ); +} + +sub _mk_podcoveragetest { + my $self = shift; + my $t = $self->{t}; $self->render_sharedir_file( file('t', '03podcoverage.t.tt'), file($t, "03podcoverage.t") ); } sub _mk_cgi { my $self = shift; - my $fn = file($self->script, $self->appprefix . "_cgi.pl"); - $self->render_sharedir_file( file('script', 'myapp_cgi.pl.tt'), $fn ); - chmod 0700, $fn; + my $script = $self->{script}; + my $appprefix = $self->{appprefix}; + $self->render_sharedir_file( file('script', 'myapp_cgi.pl.tt'), + file($script,"$appprefix\_cgi.pl"), undef, 0755 ); } sub _mk_fastcgi { my $self = shift; - my $fn = file($self->script, $self->appprefix . "_fastcgi.pl"); - $self->render_sharedir_file( file('script', 'myapp_fastcgi.pl.tt'), $fn ); - chmod 0700, $fn; + my $script = $self->{script}; + my $appprefix = $self->{appprefix}; + $self->render_sharedir_file( file('script', 'myapp_fastcgi.pl.tt'), + file($script, "$appprefix\_fastcgi.pl"), undef, 0755 ); } sub _mk_server { my $self = shift; - my $fn = file($self->script, $self->appprefix . "_server.pl"); - $self->render_sharedir_file( file('script', 'myapp_server.pl.tt'), $fn ); - chmod 0700, $fn; + my $script = $self->{script}; + my $appprefix = $self->{appprefix}; + $self->render_sharedir_file( file('script', 'myapp_server.pl.tt'), + file($script, "$appprefix\_server.pl"), undef, 0755 ); } sub _mk_test { my $self = shift; - my $fn = file($self->script, $self->appprefix . "_test.pl"); - $self->render_sharedir_file( file('script', 'myapp_test.pl.tt'), $fn ); - chmod 0700, $fn; + my $script = $self->{script}; + my $appprefix = $self->{appprefix}; + $self->render_sharedir_file( file('script', 'myapp_test.pl.tt'), + file($script, "$appprefix\_test.pl"), undef, 0755 ); } sub _mk_create { my $self = shift; - my $fn = file($self->script, $self->appprefix . "_create.pl"); - $self->render_sharedir_file( file('script', 'myapp_create.pl.tt'), $fn ); - chmod 0700, $fn; + my $script = $self->{script}; + my $appprefix = $self->{appprefix}; + $self->render_sharedir_file( file('script', 'myapp_create.pl.tt'), + file($script, "$appprefix\_create.pl"), undef, 0755 ); } sub _mk_compclass { @@ -607,12 +659,13 @@ There is no fallback for this method. These are the methods that the Helper classes can call on the <$helper> object passed to them. -=head2 render_file ($file, $path, $vars) +=head2 render_file ($file, $path, $vars, $perms) Render and create a file from a template in DATA using Template Toolkit. $file is the relevent chunk of the __DATA__ section, $path is -the path to the file and $vars is the hashref as expected by -L