X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FHelper.pm;h=26d9142e480ae154e55ac847ccc1c41014f76c04;hb=23f9f14504b827c7fe63670e023549800c28b580;hp=4dd40ef3fb6cad0b024035bd746fe3876c7f89a0;hpb=03082a71ed45aaa95c53b349dc2d4ad8506403f9;p=catagits%2FCatalyst-Devel.git diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm index 4dd40ef..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; @@ -15,6 +12,7 @@ use Catalyst::Utils; use Catalyst::Exception; use Path::Class qw/dir file/; use File::ShareDir qw/dist_dir/; +#use namespace::autoclean; my %cache; @@ -30,12 +28,22 @@ Catalyst::Helper - Bootstrap a Catalyst application sub get_sharedir_file { my ($self, @filename) = @_; - my $file = file( dist_dir('Catalyst-Devel'), @filename); - warn $file; + 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} ) { @@ -43,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) { @@ -66,7 +76,7 @@ sub mk_app { $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 } = -r '/usr/bin/env' @@ -83,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; @@ -100,6 +112,9 @@ 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; @@ -107,6 +122,9 @@ sub mk_app { 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; @@ -114,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 = @_; @@ -141,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; @@ -151,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 @@ -177,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 ); } @@ -186,6 +205,7 @@ sub mk_component { $class->mk_comptest( $self, @args ); } else { $self->_mk_comptest } + #################################################################### } # Fallback @@ -213,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'} @@ -227,6 +247,7 @@ sub mk_file { $file .= '.new'; } } + if ( my $f = IO::File->new("> $file") ) { binmode $f; print $f $content; @@ -254,19 +275,35 @@ 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_sharedir_file( 'root', $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 ); } @@ -279,67 +316,67 @@ 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.tt', "$mod.pm" ); + $self->render_sharedir_file( file('lib', 'MyApp.pm.tt'), "$mod.pm" ); } sub _mk_rootclass { my $self = shift; - $self->render_file( 'rootclass.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_file( 'makefile.tt', "$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' ) ); } } @@ -347,81 +384,81 @@ sub _mk_config { my $self = shift; my $dir = $self->{dir}; my $appprefix = $self->{appprefix}; - $self->render_file( 'config.tt', - 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.tt', "$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.tt', "$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.tt', "$t\/01app.t" ); - $self->render_file( 'podtest.tt', "$t\/02pod.t" ); - $self->render_file( 'podcoveragetest.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_file( 'cgi.tt', "$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.tt', "$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.tt', "$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.tt', "$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.tt', "$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.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_file( 'comptest.tt', "$test" ); + $self->render_sharedir_file( file('t', 'comptest.tt'), $test ); ## wtf do i rename this to? } sub _mk_images { @@ -432,20 +469,28 @@ 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 $image = $self->get_file("$name.png"); - $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 $favicon = $self->get_sharedir_file( 'root', 'favicon.ico' ); - my $dest = File::Spec->catfile( $root, "favicon.ico" ); + 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 { my ( $self, $file ) = @_; if ( -e $file ) { @@ -489,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. @@ -626,6 +675,27 @@ 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. +=cut + +=head2 get_sharedir_file + +Method for getting a file out of share/ + +=cut + +=head2 render_file_contents + +Process a L template. + +=cut + +=head2 render_sharedir_file + +Render a template/image file from our share directory + +=cut + + =head1 NOTE The helpers will read author name from /etc/passwd by default.