X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FHelper.pm;h=26d9142e480ae154e55ac847ccc1c41014f76c04;hb=23f9f14504b827c7fe63670e023549800c28b580;hp=97c0f56d58794e3deee1a28d4d9ba16b6fd025bb;hpb=11d090846da613b5f4fdc5efee5b8cae806cc0dd;p=catagits%2FCatalyst-Devel.git diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm index 97c0f56..26d9142 100644 --- a/lib/Catalyst/Helper.pm +++ b/lib/Catalyst/Helper.pm @@ -1,8 +1,5 @@ package Catalyst::Helper; - -use strict; -use warnings; -use base 'Class::Accessor::Fast'; +#use Moose; use Config; use File::Spec; use File::Path; @@ -13,6 +10,9 @@ use Template; use Catalyst::Devel; use Catalyst::Utils; use Catalyst::Exception; +use Path::Class qw/dir file/; +use File::ShareDir qw/dist_dir/; +#use namespace::autoclean; my %cache; @@ -26,6 +26,24 @@ Catalyst::Helper - Bootstrap a Catalyst application =cut +sub get_sharedir_file { + my ($self, @filename) = @_; + my $dist_dir; + if (-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'; + } + else { + $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; +} + +# Do not touch this method, *EVER*, it is needed for back compat. sub get_file { my ( $self, $class, $file ) = @_; unless ( $cache{$class} ) { @@ -33,6 +51,8 @@ sub get_file { $cache{$class} = eval "package $class; "; } my $data = $cache{$class}; + Carp::confess("Could not get data from __DATA__ segment for $class") + unless $data; my @files = split /^__(.+)__\r?\n/m, $data; shift @files; while (@files) { @@ -42,23 +62,26 @@ sub get_file { return 0; } + sub mk_app { my ( $self, $name ) = @_; # Needs to be here for PAR require Catalyst; - if ( $name =~ /[^\w\:]/ ) { + 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->{script } = dir( $self->{dir}, 'script' ); $self->{appprefix } = Catalyst::Utils::appprefix($name); $self->{appenv } = Catalyst::Utils::class2env($name); - $self->{startperl } = "#!$Config{perlpath} -w"; + $self->{startperl } = -r '/usr/bin/env' + ? '#!/usr/bin/env perl' + : "#!$Config{perlpath} -w"; $self->{scriptgen } = $Catalyst::Devel::CATALYST_SCRIPT_GEN || 4; $self->{catalyst_version} = $Catalyst::VERSION; $self->{author } = $self->{author} = $ENV{'AUTHOR'} @@ -70,6 +93,8 @@ sub mk_app { my $gen_app = ( $self->{scripts} || $self->{makefile} ) ? 0 : 1; if ($gen_app) { + + $self->_mk_dirs; $self->_mk_config; $self->_mk_appclass; @@ -87,12 +112,19 @@ sub mk_app { $self->_mk_cgi; $self->_mk_fastcgi; $self->_mk_server; + # 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; $self->_mk_test; $self->_mk_create; + $self->_mk_information; } 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; @@ -100,7 +132,7 @@ sub mk_component { $self->{author} = $self->{author} = $ENV{'AUTHOR'} || eval { @{ [ getpwuid($<) ] }[6] } || 'A clever guy'; - $self->{base} ||= File::Spec->catdir( $FindBin::Bin, '..' ); + $self->{base} ||= dir( $FindBin::Bin, '..' ); unless ( $_[0] =~ /^(?:model|view|controller)$/i ) { my $helper = shift; my @args = @_; @@ -127,9 +159,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; @@ -137,19 +169,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 @@ -163,6 +195,7 @@ 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 ); } @@ -172,6 +205,7 @@ sub mk_component { $class->mk_comptest( $self, @args ); } else { $self->_mk_comptest } + #################################################################### } # Fallback @@ -199,7 +233,7 @@ sub mk_dir { sub mk_file { my ( $self, $file, $content ) = @_; - if ( -e $file ) { + if ( -e $file && -s _ ) { print qq/ exists "$file"\n/; return 0 unless ( $self->{'.newfiles'} @@ -213,6 +247,7 @@ sub mk_file { $file .= '.new'; } } + if ( my $f = IO::File->new("> $file") ) { binmode $f; print $f $content; @@ -240,87 +275,108 @@ 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. +## addendum: we had to split this method so we could have backwards +## compatability. otherwise, we'd have no way to pass stuff from __DATA__ + sub render_file { my ( $self, $file, $path, $vars ) = @_; + my $template = $self->get_file( ( caller(0) )[0], $file ); + $self->render_file_contents($template, $path, $vars); +} + +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); +} + +sub render_file_contents { + my ( $self, $template, $path, $vars ) = @_; $vars ||= {}; my $t = Template->new; - my $template = $self->get_file( ( caller(0) )[0], $file ); return 0 unless $template; my $output; $t->process( \$template, { %{$self}, %$vars }, \$output ) || Catalyst::Exception->throw( - message => qq/Couldn't process "$file", / . $t->error() ); + message => qq/Couldn't process "$template", / . $t->error() ); $self->mk_file( $path, $output ); } +sub _mk_information { + my $self = shift; + print qq/Change to application directory and Run "perl Makefile.PL" to make sure your install is complete\n/; +} + 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->{lib} = dir( $self->{dir}, 'lib' ); $self->mk_dir( $self->{lib} ); - $self->{root} = File::Spec->catdir( $self->{dir}, 'root' ); + $self->{root} = dir( $self->{dir}, 'root' ); $self->mk_dir( $self->{root} ); - $self->{static} = File::Spec->catdir( $self->{root}, 'static' ); + $self->{static} = dir( $self->{root}, 'static' ); $self->mk_dir( $self->{static} ); - $self->{images} = File::Spec->catdir( $self->{static}, 'images' ); + $self->{images} = dir( $self->{static}, 'images' ); $self->mk_dir( $self->{images} ); - $self->{t} = File::Spec->catdir( $self->{dir}, 't' ); + $self->{t} = dir( $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->{class} = dir( split( /\:\:/, $self->{name} ) ); + $self->{mod} = dir( $self->{lib}, $self->{class} ); $self->mk_dir( $self->{mod} ); if ( $self->{short} ) { - $self->{m} = File::Spec->catdir( $self->{mod}, 'M' ); + $self->{m} = dir( $self->{mod}, 'M' ); $self->mk_dir( $self->{m} ); - $self->{v} = File::Spec->catdir( $self->{mod}, 'V' ); + $self->{v} = dir( $self->{mod}, 'V' ); $self->mk_dir( $self->{v} ); - $self->{c} = File::Spec->catdir( $self->{mod}, 'C' ); + $self->{c} = dir( $self->{mod}, 'C' ); $self->mk_dir( $self->{c} ); } else { - $self->{m} = File::Spec->catdir( $self->{mod}, 'Model' ); + $self->{m} = dir( $self->{mod}, 'Model' ); $self->mk_dir( $self->{m} ); - $self->{v} = File::Spec->catdir( $self->{mod}, 'View' ); + $self->{v} = dir( $self->{mod}, 'View' ); $self->mk_dir( $self->{v} ); - $self->{c} = File::Spec->catdir( $self->{mod}, 'Controller' ); + $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} = File::Spec->rel2abs( $self->{dir} ); + $self->{base} = dir( $self->{dir} )->absolute; } sub _mk_appclass { my $self = shift; my $mod = $self->{mod}; - $self->render_file( 'appclass', "$mod.pm" ); + $self->render_sharedir_file( file('lib', 'MyApp.pm.tt'), "$mod.pm" ); } sub _mk_rootclass { my $self = shift; - $self->render_file( 'rootclass', - 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_file( 'makefile', "$dir\/Makefile.PL" ); + $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::Spec->catdir( $self->{dir}, 'Build.PL' ) ); + file( $self->{dir}, 'Build.PL' ) ); } } @@ -328,81 +384,81 @@ sub _mk_config { my $self = shift; my $dir = $self->{dir}; my $appprefix = $self->{appprefix}; - $self->render_file( 'config', - File::Spec->catfile( $dir, "$appprefix.conf" ) ); + $self->render_sharedir_file( 'myapp.conf.tt', + file( $dir, "$appprefix.conf" ) ); } sub _mk_readme { my $self = shift; my $dir = $self->{dir}; - $self->render_file( 'readme', "$dir\/README" ); + $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_file( 'changes', "$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_file( 'apptest', "$t\/01app.t" ); - $self->render_file( 'podtest', "$t\/02pod.t" ); - $self->render_file( 'podcoveragetest', "$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_file( 'cgi', "$script\/$appprefix\_cgi.pl" ); - chmod 0700, "$script/$appprefix\_cgi.pl"; + $self->render_sharedir_file( file('script', 'myapp_cgi.pl.tt'), file($script,"$appprefix\_cgi.pl") ); + chmod 0700, file($script,"$appprefix\_cgi.pl"); } sub _mk_fastcgi { my $self = shift; my $script = $self->{script}; my $appprefix = $self->{appprefix}; - $self->render_file( 'fastcgi', "$script\/$appprefix\_fastcgi.pl" ); - chmod 0700, "$script/$appprefix\_fastcgi.pl"; + $self->render_sharedir_file( file('script', 'myapp_fastcgi.pl.tt'), file($script, "$appprefix\_fastcgi.pl") ); + chmod 0700, file($script, "$appprefix\_fastcgi.pl"); } sub _mk_server { my $self = shift; my $script = $self->{script}; my $appprefix = $self->{appprefix}; - $self->render_file( 'server', "$script\/$appprefix\_server.pl" ); - chmod 0700, "$script/$appprefix\_server.pl"; + $self->render_sharedir_file( file('script', 'myapp_server.pl.tt'), file($script, "$appprefix\_server.pl") ); + chmod 0700, file($script, "$appprefix\_server.pl"); } sub _mk_test { my $self = shift; my $script = $self->{script}; my $appprefix = $self->{appprefix}; - $self->render_file( 'test', "$script/$appprefix\_test.pl" ); - chmod 0700, "$script/$appprefix\_test.pl"; + $self->render_sharedir_file( file('script', 'myapp_test.pl.tt'), file($script, "$appprefix\_test.pl") ); + chmod 0700, file($script, "$appprefix\_test.pl"); } sub _mk_create { my $self = shift; my $script = $self->{script}; my $appprefix = $self->{appprefix}; - $self->render_file( 'create', "$script\/$appprefix\_create.pl" ); - chmod 0700, "$script/$appprefix\_create.pl"; + $self->render_sharedir_file( file('script', 'myapp_create.pl.tt'), file($script, "$appprefix\_create.pl") ); + chmod 0700, file($script, "$appprefix\_create.pl"); } sub _mk_compclass { my $self = shift; my $file = $self->{file}; - return $self->render_file( 'compclass', "$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_file( 'comptest', "$test" ); + $self->render_sharedir_file( file('t', 'comptest.tt'), $test ); ## wtf do i rename this to? } sub _mk_images { @@ -413,19 +469,26 @@ sub _mk_images { btn_120x50_powered btn_120x50_powered_shadow btn_88x31_built btn_88x31_built_shadow btn_88x31_powered btn_88x31_powered_shadow/; for my $name (@images) { - my $hex = $self->get_file( ( caller(0) )[0], $name ); - my $image = pack "H*", $hex; - $self->mk_file( File::Spec->catfile( $images, "$name.png" ), $image ); + my $image = $self->get_sharedir_file("root", "static", "images", "$name.png.bin"); + $self->mk_file( file( $images, "$name.png" ), $image ); } } sub _mk_favicon { my $self = shift; my $root = $self->{root}; - my $hex = $self->get_file( ( caller(0) )[0], 'favicon' ); - my $favicon = pack "H*", $hex; - $self->mk_file( File::Spec->catfile( $root, "favicon.ico" ), $favicon ); + my $favicon = $self->get_sharedir_file( 'root', 'favicon.ico.bin' ); + my $dest = dir( $root, "favicon.ico" ); + $self->mk_file( $dest, $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 { @@ -471,6 +534,10 @@ 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. @@ -499,8 +566,8 @@ So when you call C, create will try to execute Catalyst::Helper::View::TT->mk_compclass and Catalyst::Helper::View::TT->mk_comptest. -See L and L for -examples. +See L and +L for examples. All helper classes should be under one of the following namespaces. @@ -508,6 +575,34 @@ All helper classes should be under one of the following namespaces. Catalyst::Helper::View:: Catalyst::Helper::Controller:: +=head2 COMMON HELPERS + +=over + +=item * + +L - DBIx::Class models + +=item * + +L - Template Toolkit view + +=item * + +L + +=item * + +L - wrap any class into a Catalyst model + +=back + +=head3 NOTE + +The helpers will read author name from /etc/passwd by default. + To override, please export the AUTHOR variable. + +=head1 METHODS + =head2 mk_compclass This method in your Helper module is called with C<$helper> @@ -539,703 +634,90 @@ arguments the user typed. There is no fallback for this method. -=head1 METHODS +=head1 INTERNAL METHODS These are the methods that the Helper classes can call on the <$helper> object passed to them. -=head2 render_file +=head2 render_file ($file, $path, $vars) -Render and create a file from a template in DATA using -Template Toolkit. +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