package Catalyst::Helper;
-
-use strict;
-use warnings;
-use base 'Class::Accessor::Fast';
+use Moose;
use Config;
use File::Spec;
+use File::Spec::Unix;
use File::Path;
use FindBin;
use IO::File;
use Catalyst::Exception;
use Path::Class qw/dir file/;
use File::ShareDir qw/dist_dir/;
-use Moose;
-use aliased 'Path::Class::Dir';
+use YAML::Tiny;
+use namespace::autoclean;
+with 'MooseX::Emulate::Class::Accessor::Fast';
+
+# Change Catalyst/Devel.pm also
+our $VERSION = '1.39';
my %cache;
=cut
-
-
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';
$dist_dir = dist_dir('Catalyst-Devel');
}
my $file = file( $dist_dir, @filename);
- my $contents = $file->slurp;
+ Carp::confess("Cannot find $file") unless -r $file;
+ my $contents = $file->slurp(iomode => "<:raw");
return $contents;
}
# Needs to be here for PAR
require Catalyst;
+ if($name eq '.') {
+ if(!-e 'META.yml') {
+ system perl => 'Makefile.PL'
+ and Catalyst::Exception->throw(message => q(
+ Failed to run "perl Makefile.PL".
+ ));
+ }
+
+ $name = YAML::Tiny->read('META.yml')->[0]->{'name'};
+ $name =~ s/-/::/g;
+ $self->{dir} = '.';
+ }
+
if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) {
warn "Error: Invalid application name.\n";
return 0;
}
+
+
+ if(!defined $self->{'dir'}) {
+ $self->{dir} = $name;
+ $self->{dir} =~ s/\:\:/-/g;
+ }
+
$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'
? '#!/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'}
+ $self->{author } ||= $ENV{'AUTHOR'}
|| eval { @{ [ getpwuid($<) ] }[6] }
|| 'Catalyst developer';
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_psgi _mk_appclass _mk_rootclass
+ _mk_readme _mk_changes _mk_apptest _mk_podtest _mk_podcoveragetest
+ _mk_images _mk_favicon/ ) {
+ $self->$_;
+ }
}
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->$_;
+ }
}
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->{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 = @_;
$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;
# 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
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
$file .= '.new';
}
}
+
if ( my $f = IO::File->new("> $file") ) {
binmode $f;
print $f $content;
print qq/created "$file"\n/;
- return 1;
+ return $file;
}
Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ );
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__
+## compatability. otherwise, we'd have no way to pass stuff from __DATA__
sub render_file {
- my ( $self, $file, $path, $vars ) = @_;
+ my ( $self, $file, $path, $vars, $perms ) = @_;
my $template = $self->get_file( ( caller(0) )[0], $file );
- $self->render_file_contents($template, $path, $vars);
+ $self->render_file_contents($template, $path, $vars, $perms);
}
sub render_sharedir_file {
- my ( $self, $file, $path, $vars ) = @_;
+ my ( $self, $file, $path, $vars, $perms ) = @_;
my $template = $self->get_sharedir_file( $file );
- $self->render_file_contents($template, $path, $vars);
+ die("Cannot get template from $file for $self\n") unless $template;
+ $self->render_file_contents($template, $path, $vars, $perms);
}
sub render_file_contents {
- my ( $self, $template, $path, $vars ) = @_;
+ my ( $self, $template, $path, $vars, $perms ) = @_;
$vars ||= {};
my $t = Template->new;
return 0 unless $template;
$t->process( \$template, { %{$self}, %$vars }, \$output )
|| Catalyst::Exception->throw(
message => qq/Couldn't process "$template", / . $t->error() );
- $self->mk_file( $path, $output );
+ my $file = $self->mk_file( $path, $output );
+ chmod $perms, file($file) if defined $perms;
+ return $file;
}
sub _mk_information {
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_sharedir_file( File::Spec->catfile('lib', 'MyApp.pm.tt'), "$mod.pm" );
+ $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} = join('/', '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($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_psgi {
+ my $self = shift;
+ my $dir = $self->{dir};
+ my $appprefix = $self->{appprefix};
+ $self->render_sharedir_file( 'myapp.psgi.tt',
+ file( $dir, "$appprefix.psgi" ) );
+}
+
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( $dir, "$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($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($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") );
+}
+
+sub _mk_podtest {
+ my $self = shift;
+ my $t = $self->{t};
+ $self->render_sharedir_file( file('t', '02pod.t.tt'), file($t, "02pod.t") );
+}
+
+sub _mk_podcoveragetest {
+ my $self = shift;
+ my $t = $self->{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";
+ $self->render_sharedir_file( file('script', 'myapp_cgi.pl.tt'),
+ file($script,"$appprefix\_cgi.pl"), undef, 0755 );
}
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";
+ $self->render_sharedir_file( file('script', 'myapp_fastcgi.pl.tt'),
+ file($script, "$appprefix\_fastcgi.pl"), undef, 0755 );
}
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";
+ $self->render_sharedir_file( file('script', 'myapp_server.pl.tt'),
+ file($script, "$appprefix\_server.pl"), undef, 0755 );
}
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";
+ $self->render_sharedir_file( file('script', 'myapp_test.pl.tt'),
+ file($script, "$appprefix\_test.pl"), undef, 0755 );
}
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";
+ $self->render_sharedir_file( file('script', 'myapp_create.pl.tt'),
+ file($script, "$appprefix\_create.pl"), undef, 0755 );
}
sub _mk_compclass {
my $self = shift;
my $file = $self->{file};
- return $self->render_sharedir_file( 'myapp_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 {
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 );
}
}
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 );
}
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/;
}
}
-
-## 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<catalyst.pl> to create a set of scripts for a
=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
These are the methods that the Helper classes can call on the
<$helper> object passed to them.
-=head2 render_file ($file, $path, $vars)
+=head2 render_file ($file, $path, $vars, $perms)
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<Template Toolkit|Template>.
+the path to the file, $vars is the hashref as expected by
+L<Template Toolkit|Template> and $perms are desired permissions (or system
+defaults if not set).
=head2 get_file ($class, $file)
This method is called by L<create.pl> to make new components
for your application.
-=head3 mk_dir ($path)
+=head2 mk_dir ($path)
Surprisingly, this function makes a directory.
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<Path::Class::Dir>
-
=cut
=head2 get_sharedir_file
=cut
-
=head1 NOTE
The helpers will read author name from /etc/passwd by default.
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;
projects / catagits/Catalyst-Devel.git / blobdiff