X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FHelper.pm;h=bfd026ebb552c7353054f89583533a8a52990f15;hb=0d4859fc90e116d00924532f98f114162fb3ba5a;hp=5df10e6f9b8f76924804415bf7ae8dde8eaf6ca3;hpb=2ad364470c25e803c2b8394431490622d3fb9dd7;p=catagits%2FCatalyst-Devel.git diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm index 5df10e6..bfd026e 100644 --- a/lib/Catalyst/Helper.pm +++ b/lib/Catalyst/Helper.pm @@ -1,7 +1,9 @@ package Catalyst::Helper; use Moose; +use Moose::Util::TypeConstraints; use Config; use File::Spec; +use File::Spec::Unix; use File::Path; use FindBin; use IO::File; @@ -61,32 +63,64 @@ 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" ); +} + +class_type 'Path::Class::Dir'; +my $coerced_dir = subtype 'Str', where { 1 }; +coerce $coerced_dir, from 'Path::Class::Dir', via { '' . $_ }; + +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" ); +} + +sub BUILD { + my $self = shift; + $self->$_ for @lazy_strs, @lazy_dirs; +} + +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' } sub mk_app { - my ( $self, $name ) = @_; + my ( $self ) = @_; # Needs to be here for PAR require Catalyst; - if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) { - warn "Error: Invalid application name.\n"; - return 0; - } - $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"; $self->{scriptgen } = $Catalyst::Devel::CATALYST_SCRIPT_GEN; $self->{catalyst_version} = $Catalyst::VERSION; - $self->{author } = $self->{author} = $ENV{'AUTHOR'} - || eval { @{ [ getpwuid($<) ] }[6] } - || 'Catalyst developer'; my $gen_scripts = ( $self->{makefile} ) ? 0 : 1; my $gen_makefile = ( $self->{scripts} ) ? 0 : 1; @@ -109,7 +143,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 @@ -118,10 +152,7 @@ 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} ||= dir( $FindBin::Bin, '..' ); + $self->{base} ||= dir( $FindBin::Bin, '..' ); # FIXME! unless ( $_[0] =~ /^(?:model|view|controller)$/i ) { my $helper = shift; my @args = @_; @@ -184,17 +215,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 @@ -222,6 +255,7 @@ 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 @@ -303,43 +337,9 @@ sub _mk_information { sub _mk_dirs { my $self = shift; - $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} ); + foreach my $name ( qw/ dir script lib root static images t mod m v c /) { + $self->mk_dir( $self->$name() ); } - my $name = $self->{name}; - $self->{rootname} = - $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root"; - $self->{base} = dir( $self->{dir} )->absolute; } sub _mk_appclass { @@ -351,43 +351,38 @@ 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'; - my $dir = $self->{dir}; - $self->render_sharedir_file( 'Makefile.PL.tt', file($dir, "Makefile.PL") ); + $self->render_sharedir_file( 'Makefile.PL.tt', file($self->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( $dir, "$appprefix.conf" ) ); + file( $self->dir, $self->appprefix . ".conf" ) ); } sub _mk_readme { my $self = shift; - my $dir = $self->{dir}; - $self->render_sharedir_file( 'README.tt', file($dir, "README") ); + $self->render_sharedir_file( 'README.tt', file($self->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($dir, "Changes"), { time => $time } ); + $self->render_sharedir_file( 'Changes.tt', file($self->dir, "Changes"), { time => $time } ); } sub _mk_apptest { @@ -400,42 +395,37 @@ sub _mk_apptest { 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"); + my $fn = file($self->script, $self->appprefix . "_cgi.pl"); + $self->render_sharedir_file( file('script', 'myapp_cgi.pl.tt'), $fn ); + chmod 0700, $fn; } 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"); + my $fn = file($self->script, $self->appprefix . "_fastcgi.pl"); + $self->render_sharedir_file( file('script', 'myapp_fastcgi.pl.tt'), $fn ); + chmod 0700, $fn; } 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"); + my $fn = file($self->script, $self->appprefix . "_server.pl"); + $self->render_sharedir_file( file('script', 'myapp_server.pl.tt'), $fn ); + chmod 0700, $fn; } 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"); + my $fn = file($self->script, $self->appprefix . "_test.pl"); + $self->render_sharedir_file( file('script', 'myapp_test.pl.tt'), $fn ); + chmod 0700, $fn; } 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"); + my $fn = file($self->script, $self->appprefix . "_create.pl"); + $self->render_sharedir_file( file('script', 'myapp_create.pl.tt'), $fn ); + chmod 0700, $fn; } sub _mk_compclass { @@ -640,7 +630,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.