X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FHelper.pm;h=a37c0c4f6f92afc6d17bf6881268b8549c20c734;hb=a73b39712fa4f12f8a2608b5f851f08c6a4ef47c;hp=ed9ea20bf3bfe8ec95177381d49f9c0329bf5131;hpb=d4655cdce64fa3814934fa5876311b8523e6a34b;p=catagits%2FCatalyst-Devel.git diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm index ed9ea20..a37c0c4 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; @@ -12,7 +14,6 @@ use Catalyst::Utils; use Catalyst::Exception; use Path::Class qw/dir file/; use File::ShareDir qw/dist_dir/; -use aliased 'Path::Class::Dir'; use namespace::autoclean; my %cache; @@ -27,8 +28,6 @@ Catalyst::Helper - Bootstrap a Catalyst application =cut - - sub get_sharedir_file { my ($self, @filename) = @_; my $dist_dir; @@ -41,6 +40,7 @@ sub get_sharedir_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; return $contents; } @@ -63,70 +63,116 @@ 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, writer => '_set_name', lazy => 1, isa => 'Str', default => sub { confess("no name") } ); + +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/ class base script /; +foreach my $name (@lazy_dirs) { + has $name => ( is => 'ro', isa => $coerced_dir, coerce => 1, init_arg => undef, lazy => 1, builder => "_build_$name" ); +} + +foreach my $wrap (qw/mk_app/) { + before $wrap => sub { + my $self = shift; + $self->$_ for @lazy_strs, @lazy_dirs; + }; +} +sub _build_dir_locations { + my $self = shift; + my ($script, $lib, $root, $static, $mod); + return ( + script => do { $script = dir( $self->dir, 'script' ) }, + lib => do { $lib = dir( $self->dir, 'lib' ) }, + root => do { $root = dir( $self->dir, 'root' ) }, + static => do {$static = dir( $root, 'static' ) }, + images => dir( $static, 'images' ), + t => dir( $self->dir, 't' ), + mod => do { $mod = dir( $self->lib, $self->class ) }, + m => dir( $mod, 'Model' ), + v => dir( $mod, 'View' ), + c => dir( $mod, 'Controller' ), + ); +} + +sub _build_class { dir( split( /\:\:/, shift->name ) ) } + + + +sub _build_base { dir( shift->dir )->absolute } +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' } + +has _app_template_data => ( isa => 'HashRef', is => 'ro', lazy => 1, builder => '_build_app_template_data' ); +sub _build_app_template_data { + my $self = shift; + my %data = ( + $self->_build_dir_locations, + ); + return \%data; +} 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 } = File::Spec->catdir( $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 || 4; + $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; my $gen_app = ( $self->{scripts} || $self->{makefile} ) ? 0 : 1; if ($gen_app) { - $self->_mk_dirs; - $self->_mk_config; - $self->_mk_appclass; - $self->_mk_rootclass; - $self->_mk_readme; - $self->_mk_changes; - $self->_mk_apptest; - $self->_mk_images; - $self->_mk_favicon; + for ( qw/ _mk_dirs _mk_config _mk_appclass _mk_rootclass _mk_readme + _mk_changes _mk_apptest _mk_images _mk_favicon/ ) { + + $self->$_($self->_app_template_data); + } } if ($gen_makefile) { $self->_mk_makefile; } if ($gen_scripts) { - $self->_mk_cgi; - $self->_mk_fastcgi; - $self->_mk_server; - $self->_mk_test; - $self->_mk_create; - $self->_mk_information; + for ( qw/ _mk_cgi _mk_fastcgi _mk_server + _mk_test _mk_create _mk_information + / ) { + $self->$_($self->_app_template_data); + } } - return $self->{dir}; + return $self->dir; } +## not much of this can really be changed, mk_compclass must be left for +## backcompat 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, '..' ); + $self->{base} ||= dir( $FindBin::Bin, '..' ); # FIXME! unless ( $_[0] =~ /^(?:model|view|controller)$/i ) { my $helper = shift; my @args = @_; @@ -153,9 +199,9 @@ sub mk_component { $type = 'M' if $type =~ /model/i; $type = 'V' if $type =~ /view/i; $type = 'C' if $type =~ /controller/i; - my $appdir = File::Spec->catdir( split /\:\:/, $app ); + my $appdir = dir( split /\:\:/, $app ); my $test_path = - File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, 'C' ); + dir( $self->{base}, 'lib', $appdir, 'C' ); $type = $self->{long_type} unless -d $test_path; $self->{type} = $type; $self->{name} = $name; @@ -163,19 +209,19 @@ sub mk_component { # Class my $path = - File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type ); + dir( $self->{base}, 'lib', $appdir, $type ); my $file = $name; if ( $name =~ /\:/ ) { my @path = split /\:\:/, $name; $file = pop @path; - $path = File::Spec->catdir( $path, @path ); + $path = dir( $path, @path ); } $self->mk_dir($path); - $file = File::Spec->catfile( $path, "$file.pm" ); + $file = file( $path, "$file.pm" ); $self->{file} = $file; # Test - $self->{test_dir} = File::Spec->catdir( $FindBin::Bin, '..', 't' ); + $self->{test_dir} = dir( $self->{base}, 't' ); $self->{test} = $self->next_test; # Helper @@ -192,12 +238,16 @@ sub mk_component { 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 @@ -225,6 +275,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 @@ -239,6 +290,7 @@ sub mk_file { $file .= '.new'; } } + if ( my $f = IO::File->new("> $file") ) { binmode $f; print $f $content; @@ -266,7 +318,7 @@ sub next_test { my $dir = $self->{test_dir}; my $type = lc $self->{type}; $self->mk_dir($dir); - return File::Spec->catfile( $dir, "$type\_$tname" ); + return file( $dir, "$type\_$tname" ); } # Do not touch this method, *EVER*, it is needed for back compat. @@ -282,6 +334,7 @@ sub render_file { sub render_sharedir_file { my ( $self, $file, $path, $vars ) = @_; 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); } @@ -304,151 +357,108 @@ sub _mk_information { sub _mk_dirs { my $self = shift; - $self->mk_dir( $self->{dir} ); - $self->mk_dir( $self->{script} ); - $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' ); - $self->mk_dir( $self->{lib} ); - $self->{root} = File::Spec->catdir( $self->{dir}, 'root' ); - $self->mk_dir( $self->{root} ); - $self->{static} = File::Spec->catdir( $self->{root}, 'static' ); - $self->mk_dir( $self->{static} ); - $self->{images} = File::Spec->catdir( $self->{static}, 'images' ); - $self->mk_dir( $self->{images} ); - $self->{t} = File::Spec->catdir( $self->{dir}, 't' ); - $self->mk_dir( $self->{t} ); - - $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) ); - $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} ); - $self->mk_dir( $self->{mod} ); - - if ( $self->{short} ) { - $self->{m} = File::Spec->catdir( $self->{mod}, 'M' ); - $self->mk_dir( $self->{m} ); - $self->{v} = File::Spec->catdir( $self->{mod}, 'V' ); - $self->mk_dir( $self->{v} ); - $self->{c} = File::Spec->catdir( $self->{mod}, 'C' ); - $self->mk_dir( $self->{c} ); + my @dirs = $self->_build_dir_locations; + while (my ($name, $location) = (shift(@dirs), shift(@dirs))) { + $self->mk_dir( $location ); } - else { - $self->{m} = File::Spec->catdir( $self->{mod}, 'Model' ); - $self->mk_dir( $self->{m} ); - $self->{v} = File::Spec->catdir( $self->{mod}, 'View' ); - $self->mk_dir( $self->{v} ); - $self->{c} = File::Spec->catdir( $self->{mod}, 'Controller' ); - $self->mk_dir( $self->{c} ); - } - my $name = $self->{name}; - $self->{rootname} = - $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root"; - $self->{base} = File::Spec->rel2abs( $self->{dir} ); } sub _mk_appclass { my $self = shift; - my $mod = $self->{mod}; - $self->render_sharedir_file( File::Spec->catfile('lib', 'MyApp.pm.tt'), "$mod.pm" ); + my $mod = $self->mod; + $self->render_sharedir_file( file('lib', 'MyApp.pm.tt'), "$mod.pm" ); } sub _mk_rootclass { my $self = shift; - $self->render_sharedir_file( File::Spec->catfile('lib', 'MyApp', 'Controller', 'Root.pm.tt'), - File::Spec->catfile( $self->{c}, "Root.pm" ) ); + $self->render_sharedir_file( file('lib', 'MyApp', 'Controller', 'Root.pm.tt'), + file( $self->c, "Root.pm" ) ); } sub _mk_makefile { my $self = shift; - $self->{path} = File::Spec->catfile( 'lib', split( '::', $self->{name} ) ); + $self->{path} = dir( 'lib', split( '::', $self->{name} ) ); $self->{path} .= '.pm'; - my $dir = $self->{dir}; - $self->render_sharedir_file( 'Makefile.PL.tt', "$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::Spec->catdir( $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::Spec->catfile( $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', "$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', "$dir\/Changes", { time => $time } ); + $self->render_sharedir_file( 'Changes.tt', file($self->dir, "Changes"), { time => $time } ); } sub _mk_apptest { my $self = shift; my $t = $self->{t}; - $self->render_sharedir_file( File::Spec->catfile('t', '01app.t.tt'), "$t\/01app.t" ); - $self->render_sharedir_file( File::Spec->catfile('t', '02pod.t.tt'), "$t\/02pod.t" ); - $self->render_sharedir_file( File::Spec->catfile('t', '03podcoverage.t.tt'), "$t\/03podcoverage.t" ); + $self->render_sharedir_file( file('t', '01app.t.tt'), file($t, "01app.t") ); + $self->render_sharedir_file( file('t', '02pod.t.tt'), file($t, "02pod.t") ); + $self->render_sharedir_file( file('t', '03podcoverage.t.tt'), file($t, "03podcoverage.t") ); } sub _mk_cgi { my $self = shift; - my $script = $self->{script}; - my $appprefix = $self->{appprefix}; - $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_cgi.pl.tt'), "$script\/$appprefix\_cgi.pl" ); - chmod 0700, "$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::Spec->catfile('script', 'myapp_fastcgi.pl.tt'), "$script\/$appprefix\_fastcgi.pl" ); - chmod 0700, "$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::Spec->catfile('script', 'myapp_server.pl.tt'), "$script\/$appprefix\_server.pl" ); - chmod 0700, "$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::Spec->catfile('script', 'myapp_test.pl.tt'), "$script/$appprefix\_test.pl" ); - chmod 0700, "$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::Spec->catfile('script', 'myapp_create.pl.tt'), "$script\/$appprefix\_create.pl" ); - chmod 0700, "$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 { my $self = shift; my $file = $self->{file}; - return $self->render_sharedir_file( 'lib', 'Helper', 'compclass.pl.tt', "$file" ); + return $self->render_sharedir_file( file('lib', 'Helper', 'compclass.pm.tt'), $file ); } sub _mk_comptest { my $self = shift; my $test = $self->{test}; - $self->render_sharedir_file( 't', 'comptest.tt', "$test" ); ## wtf do i rename this to? + $self->render_sharedir_file( file('t', 'comptest.tt'), $test ); ## wtf do i rename this to? } sub _mk_images { @@ -460,7 +470,7 @@ sub _mk_images { btn_88x31_built_shadow btn_88x31_powered btn_88x31_powered_shadow/; for my $name (@images) { my $image = $self->get_sharedir_file("root", "static", "images", "$name.png.bin"); - $self->mk_file( File::Spec->catfile( $images, "$name.png" ), $image ); + $self->mk_file( file( $images, "$name.png" ), $image ); } } @@ -468,7 +478,7 @@ sub _mk_favicon { my $self = shift; my $root = $self->{root}; my $favicon = $self->get_sharedir_file( 'root', 'favicon.ico.bin' ); - my $dest = File::Spec->catfile( $root, "favicon.ico" ); + my $dest = dir( $root, "favicon.ico" ); $self->mk_file( $dest, $favicon ); } @@ -476,12 +486,12 @@ sub _mk_favicon { 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/; @@ -494,42 +504,6 @@ sub _deprecate_file { } } - -## this is so you don't have to do make install after every change to test -sub _find_share_dir { - my ($self, $args) = @_; - my $share_name = $self->name; - if ($share_name =~ s!^/(.*?)/!!) { - my $dist = $1; - $args->{share_base_dir} = eval { - Dir->new(File::ShareDir::dist_dir($dist)) - ->subdir('share'); - }; - if ($@) { - # not installed - my $file = __FILE__; - my $dir = Dir->new(dirname($file)); - my $share_base; - while ($dir->parent) { - if (-d $dir->subdir('share') && -d $dir->subdir('share')->subdir('root')) { - $share_base = $dir->subdir('share')->subdir('root'); - last; - } - $dir = $dir->parent; - } - confess "could not find sharebase by recursion. ended up at $dir, from $file" - unless $share_base; - $args->{share_base_dir} = $share_base; - } - } - my $base = $args->{share_base_dir}->subdir($share_name); - confess "No such share base directory ${base}" - unless -d $base; - $self->share_dir($base); -}; - - - =head1 DESCRIPTION This module is used by B to create a set of scripts for a @@ -613,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 @@ -676,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,10 +664,6 @@ Writes content to a file. Called by L. Calculates the name of the next numbered test file and returns it. Don't give the number or the .t suffix for the test name. -=head2 Dir - -Alias for L - =cut =head2 get_sharedir_file @@ -713,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. @@ -733,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;