X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FHelper.pm;h=055d114bb1d9214b0cb089426b5275976129f0b7;hb=1857902685e365e5b35fa54a754d376dbd336aeb;hp=86ba60f7e2de03a4effc222ace20d3561a2893a1;hpb=9385890d6bcf864ba9c7be8d913e7a7d497d7ee8;p=catagits%2FCatalyst-Devel.git diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm index 86ba60f..055d114 100644 --- a/lib/Catalyst/Helper.pm +++ b/lib/Catalyst/Helper.pm @@ -13,12 +13,13 @@ 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.23'; +our $VERSION = '1.38'; my %cache; @@ -34,30 +35,21 @@ Catalyst::Helper - Bootstrap a Catalyst application sub get_sharedir_file { my ($self, @filename) = @_; - - my @try_dirs; - if (exists $self->{base}) { - push @try_dirs, $self->{base}; - } + my $dist_dir; if (exists $ENV{CATALYST_DEVEL_SHAREDIR}) { - push @try_dirs, $ENV{CATALYST_DEVEL_SHAREDIR} + $dist_dir = $ENV{CATALYST_DEVEL_SHAREDIR}; } - if (-d "inc/.author" && -f "lib/Catalyst/Helper.pm" + elsif (-d "inc/.author" && -f "lib/Catalyst/Helper.pm" ) { # Can't use sharedir if we're in a checkout # this feels horrible, better ideas? - push @try_dirs, 'share'; + $dist_dir = 'share'; } else { - push @try_dirs, dist_dir('Catalyst-Devel'); - } - - my $file; - foreach my $dist_dir (@try_dirs) { - $file = file( $dist_dir, @filename); - last if -r $file; + $dist_dir = dist_dir('Catalyst-Devel'); } + my $file = file( $dist_dir, @filename); Carp::confess("Cannot find $file") unless -r $file; - my $contents = $file->slurp; + my $contents = $file->slurp(iomode => "<:raw"); return $contents; } @@ -87,22 +79,40 @@ sub mk_app { # Needs to be here for PAR require Catalyst; + if($name eq '.') { + if(!-e 'META.yml') { + system perl => 'Makefile.PL' + and Catalyst::Exception->throw(message => q( + Failed to run "perl Makefile.PL". + )); + } + + $name = YAML::Tiny->read('META.yml')->[0]->{'name'}; + $name =~ s/-/::/g; + $self->{dir} = '.'; + } + if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) { warn "Error: Invalid application name.\n"; return 0; } + + + if(!defined $self->{'dir'}) { + $self->{dir} = $name; + $self->{dir} =~ s/\:\:/-/g; + } + $self->{name } = $name; - $self->{dir } = $name; - $self->{dir } =~ s/\:\:/-/g; $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 } = $self->{author} = $ENV{'AUTHOR'} + $self->{author } ||= $ENV{'AUTHOR'} || eval { @{ [ getpwuid($<) ] }[6] } || 'Catalyst developer'; @@ -111,9 +121,9 @@ sub mk_app { my $gen_app = ( $self->{scripts} || $self->{makefile} ) ? 0 : 1; if ($gen_app) { - for ( qw/ _mk_dirs _mk_config _mk_appclass _mk_rootclass _mk_readme - _mk_changes _mk_apptest _mk_images _mk_favicon/ ) { - + for ( qw/ _mk_dirs _mk_config _mk_psgi _mk_appclass _mk_rootclass + _mk_readme _mk_changes _mk_apptest _mk_podtest _mk_podcoveragetest + _mk_images _mk_favicon/ ) { $self->$_; } } @@ -121,7 +131,7 @@ sub mk_app { $self->_mk_makefile; } if ($gen_scripts) { - for ( qw/ _mk_cgi _mk_fastcgi _mk_server + for ( qw/ _mk_cgi _mk_fastcgi _mk_server _mk_test _mk_create _mk_information / ) { $self->$_; @@ -130,7 +140,7 @@ sub mk_app { return $self->{dir}; } -## not much of this can really be changed, mk_compclass must be left for +## not much of this can really be changed, mk_compclass must be left for ## backcompat sub mk_component { my $self = shift; @@ -261,7 +271,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", "$!"/ ); @@ -292,20 +302,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; @@ -313,7 +323,9 @@ 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; + return $file; } sub _mk_information { @@ -376,7 +388,7 @@ sub _mk_rootclass { sub _mk_makefile { my $self = shift; - $self->{path} = dir( 'lib', split( '::', $self->{name} ) ); + $self->{path} = join('/', 'lib', split( '::', $self->{name} ) ); $self->{path} .= '.pm'; my $dir = $self->{dir}; $self->render_sharedir_file( 'Makefile.PL.tt', file($dir, "Makefile.PL") ); @@ -389,6 +401,14 @@ sub _mk_makefile { } } +sub _mk_psgi { + my $self = shift; + my $dir = $self->{dir}; + my $appprefix = $self->{appprefix}; + $self->render_sharedir_file( 'myapp.psgi.tt', + file( $dir, "$appprefix.psgi" ) ); +} + sub _mk_config { my $self = shift; my $dir = $self->{dir}; @@ -414,7 +434,17 @@ 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") ); } @@ -422,40 +452,40 @@ sub _mk_cgi { my $self = shift; my $script = $self->{script}; my $appprefix = $self->{appprefix}; - $self->render_sharedir_file( file('script', 'myapp_cgi.pl.tt'), file($script,"$appprefix\_cgi.pl") ); - chmod 0700, file($script,"$appprefix\_cgi.pl"); + $self->render_sharedir_file( file('script', 'myapp_cgi.pl.tt'), + file($script,"$appprefix\_cgi.pl"), undef, 0755 ); } sub _mk_fastcgi { my $self = shift; my $script = $self->{script}; my $appprefix = $self->{appprefix}; - $self->render_sharedir_file( file('script', 'myapp_fastcgi.pl.tt'), file($script, "$appprefix\_fastcgi.pl") ); - chmod 0700, file($script, "$appprefix\_fastcgi.pl"); + $self->render_sharedir_file( file('script', 'myapp_fastcgi.pl.tt'), + file($script, "$appprefix\_fastcgi.pl"), undef, 0755 ); } sub _mk_server { my $self = shift; my $script = $self->{script}; my $appprefix = $self->{appprefix}; - $self->render_sharedir_file( file('script', 'myapp_server.pl.tt'), file($script, "$appprefix\_server.pl") ); - chmod 0700, file($script, "$appprefix\_server.pl"); + $self->render_sharedir_file( file('script', 'myapp_server.pl.tt'), + file($script, "$appprefix\_server.pl"), undef, 0755 ); } sub _mk_test { my $self = shift; my $script = $self->{script}; my $appprefix = $self->{appprefix}; - $self->render_sharedir_file( file('script', 'myapp_test.pl.tt'), file($script, "$appprefix\_test.pl") ); - chmod 0700, file($script, "$appprefix\_test.pl"); + $self->render_sharedir_file( file('script', 'myapp_test.pl.tt'), + file($script, "$appprefix\_test.pl"), undef, 0755 ); } sub _mk_create { my $self = shift; my $script = $self->{script}; my $appprefix = $self->{appprefix}; - $self->render_sharedir_file( file('script', 'myapp_create.pl.tt'), file($script, "$appprefix\_create.pl") ); - chmod 0700, file($script, "$appprefix\_create.pl"); + $self->render_sharedir_file( file('script', 'myapp_create.pl.tt'), + file($script, "$appprefix\_create.pl"), undef, 0755 ); } sub _mk_compclass { @@ -637,12 +667,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