X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FHelper.pm;h=3b182addbd27ea23c284bb39ae572ba9b66a9b1c;hb=1a50c493813f72e440cf1975d41f4080f411a547;hp=1bb9f97fbffec35a4d73ba23879631c8f923a815;hpb=420ad6922a8793454f5de61409889193125ae6a1;p=catagits%2FCatalyst-Devel.git diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm index 1bb9f97..3b182ad 100644 --- a/lib/Catalyst/Helper.pm +++ b/lib/Catalyst/Helper.pm @@ -1,7 +1,8 @@ package Catalyst::Helper; -#use Moose; +use Moose; use Config; use File::Spec; +use File::Spec::Unix; use File::Path; use FindBin; use IO::File; @@ -12,7 +13,12 @@ use Catalyst::Utils; use Catalyst::Exception; use Path::Class qw/dir file/; use File::ShareDir qw/dist_dir/; -#use namespace::autoclean; +use namespace::autoclean; + +with 'MooseX::Emulate::Class::Accessor::Fast'; + +# Change Catalyst/Devel.pm also +our $VERSION = '1.28'; my %cache; @@ -29,7 +35,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'; @@ -81,8 +90,8 @@ sub mk_app { $self->{appenv } = Catalyst::Utils::class2env($name); $self->{startperl } = -r '/usr/bin/env' ? '#!/usr/bin/env perl' - : "#!$Config{perlpath} -w"; - $self->{scriptgen } = $Catalyst::Devel::CATALYST_SCRIPT_GEN || 4; + : "#!$Config{perlpath}"; + $self->{scriptgen } = $Catalyst::Devel::CATALYST_SCRIPT_GEN; $self->{catalyst_version} = $Catalyst::VERSION; $self->{author } = $self->{author} = $ENV{'AUTHOR'} || eval { @{ [ getpwuid($<) ] }[6] } @@ -93,12 +102,10 @@ 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/ ) { $self->$_; - } } if ($gen_makefile) { @@ -106,17 +113,14 @@ sub mk_app { } if ($gen_scripts) { for ( qw/ _mk_cgi _mk_fastcgi _mk_server - _mk_test _mk_create _mk_information / ) { - $self->$_; - # probably want to only do this if a DBIC schema is specified, or move it - # to C::H::Model::DBIC::Schema - # $self->_mk_dbic_deploy; - + _mk_test _mk_create _mk_information + / ) { + $self->$_; + } } return $self->{dir}; } - ## not much of this can really be changed, mk_compclass must be left for ## backcompat sub mk_component { @@ -189,17 +193,19 @@ sub mk_component { message => qq/Couldn't load helper "$class", "$@"/ ); } - ## must be left for back compat! ################################### if ( $class->can('mk_compclass') ) { return 1 unless $class->mk_compclass( $self, @args ); } - else { return 1 unless $self->_mk_compclass } + else { + return 1 unless $self->_mk_compclass + } if ( $class->can('mk_comptest') ) { $class->mk_comptest( $self, @args ); } - else { $self->_mk_comptest } - #################################################################### + else { + $self->_mk_comptest + } } # Fallback @@ -392,7 +398,7 @@ 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($dir, "Changes", { time => $time } ); + $self->render_sharedir_file( 'Changes.tt', file($dir, "Changes"), { time => $time } ); } sub _mk_apptest { @@ -477,23 +483,15 @@ sub _mk_favicon { } -sub _mk_dbic_deploy { - my $self = shift; - my $script = $self->{script}; - my $appprefix = $self->{appprefix}; - $self->render_sharedir_file( file('script', 'myapp_deploy_schema.pl.tt'), file($script, "$appprefix\_deploy_schema.pl") ); - chmod 0700, file($script, "$appprefix\_deploy_schema.pl"); -} - sub _deprecate_file { my ( $self, $file ) = @_; if ( -e $file ) { - my $oldcontent; - if ( my $f = IO::File->new("< $file") ) { + my ($f, $oldcontent); + if ( $f = IO::File->new("< $file") ) { $oldcontent = join( '', (<$f>) ); } my $newfile = $file . '.deprecated'; - if ( my $f = IO::File->new("> $newfile") ) { + if ( $f = IO::File->new("> $newfile") ) { binmode $f; print $f $oldcontent; print qq/created "$newfile"\n/; @@ -528,10 +526,6 @@ development stage. The catalyst test server, starts an HTTPD which outputs debugging to the terminal. -=head2 _deploy_dbic.pl - -Deploy a L schema to the database of your choice. - =head2 _test.pl A script for running tests from the command-line. @@ -593,7 +587,8 @@ L - wrap any class into a Catalyst model =head3 NOTE -The helpers will read author name from /etc/passwd by default. + To override, please export the AUTHOR variable. +The helpers will read author name from /etc/passwd by default. +To override, please export the AUTHOR variable. =head1 METHODS @@ -656,7 +651,7 @@ Create the main application skeleton. This is called by L. This method is called by L to make new components for your application. -=head3 mk_dir ($path) +=head2 mk_dir ($path) Surprisingly, this function makes a directory. @@ -689,7 +684,6 @@ Render a template/image file from our share directory =cut - =head1 NOTE The helpers will read author name from /etc/passwd by default. @@ -709,8 +703,6 @@ Catalyst Contributors, see Catalyst.pm This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. -=begin pod_to_ignore - =cut 1;