1 package Catalyst::Helper;
13 use Catalyst::Exception;
14 use Path::Class qw/dir file/;
15 use File::ShareDir qw/dist_dir/;
17 use namespace::autoclean;
19 with 'MooseX::Emulate::Class::Accessor::Fast';
21 # Change Catalyst/Devel.pm also
22 our $VERSION = '1.33';
28 Catalyst::Helper - Bootstrap a Catalyst application
32 catalyst.pl <myappname>
36 sub get_sharedir_file {
37 my ($self, @filename) = @_;
39 if (exists $ENV{CATALYST_DEVEL_SHAREDIR}) {
40 $dist_dir = $ENV{CATALYST_DEVEL_SHAREDIR};
42 elsif (-d "inc/.author" && -f "lib/Catalyst/Helper.pm"
43 ) { # Can't use sharedir if we're in a checkout
44 # this feels horrible, better ideas?
48 $dist_dir = dist_dir('Catalyst-Devel');
50 my $file = file( $dist_dir, @filename);
51 Carp::confess("Cannot find $file") unless -r $file;
52 my $contents = $file->slurp;
56 # Do not touch this method, *EVER*, it is needed for back compat.
58 my ( $self, $class, $file ) = @_;
59 unless ( $cache{$class} ) {
61 $cache{$class} = eval "package $class; <DATA>";
63 my $data = $cache{$class};
64 Carp::confess("Could not get data from __DATA__ segment for $class")
66 my @files = split /^__(.+)__\r?\n/m, $data;
69 my ( $name, $content ) = splice @files, 0, 2;
70 return $content if $name eq $file;
77 my ( $self, $name ) = @_;
79 # Needs to be here for PAR
84 system perl => 'Makefile.PL'
85 and Catalyst::Exception->throw(message => q(
86 Failed to run "perl Makefile.PL".
90 $name = YAML::Tiny->read('META.yml')->[0]->{'name'};
95 if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) {
96 warn "Error: Invalid application name.\n";
101 if(!defined $self->{'dir'}) {
102 $self->{dir} = $name;
103 $self->{dir} =~ s/\:\:/-/g;
106 $self->{name } = $name;
107 $self->{script } = dir( $self->{dir}, 'script' );
108 $self->{appprefix } = Catalyst::Utils::appprefix($name);
109 $self->{appenv } = Catalyst::Utils::class2env($name);
110 $self->{startperl } = -r '/usr/bin/env'
111 ? '#!/usr/bin/env perl'
112 : "#!$Config{perlpath}";
113 $self->{scriptgen } = $Catalyst::Devel::CATALYST_SCRIPT_GEN;
114 $self->{catalyst_version} = $Catalyst::VERSION;
115 $self->{author } ||= $ENV{'AUTHOR'}
116 || eval { @{ [ getpwuid($<) ] }[6] }
117 || 'Catalyst developer';
119 my $gen_scripts = ( $self->{makefile} ) ? 0 : 1;
120 my $gen_makefile = ( $self->{scripts} ) ? 0 : 1;
121 my $gen_app = ( $self->{scripts} || $self->{makefile} ) ? 0 : 1;
124 for ( qw/ _mk_dirs _mk_config _mk_appclass _mk_rootclass _mk_readme
125 _mk_changes _mk_apptest _mk_podtest _mk_podcoveragetest
126 _mk_images _mk_favicon/ ) {
135 for ( qw/ _mk_cgi _mk_fastcgi _mk_server
136 _mk_test _mk_create _mk_information
144 ## not much of this can really be changed, mk_compclass must be left for
150 $self->{author} = $self->{author} = $ENV{'AUTHOR'}
151 || eval { @{ [ getpwuid($<) ] }[6] }
153 $self->{base} ||= dir( $FindBin::Bin, '..' );
154 unless ( $_[0] =~ /^(?:model|view|controller)$/i ) {
157 my $class = "Catalyst::Helper::$helper";
158 eval "require $class";
161 Catalyst::Exception->throw(
162 message => qq/Couldn't load helper "$class", "$@"/ );
165 if ( $class->can('mk_stuff') ) {
166 return 1 unless $class->mk_stuff( $self, @args );
171 my $name = shift || "Missing name for model/view/controller";
174 return 0 if $name =~ /[^\w\:]/;
176 $self->{long_type} = ucfirst $type;
177 $type = 'M' if $type =~ /model/i;
178 $type = 'V' if $type =~ /view/i;
179 $type = 'C' if $type =~ /controller/i;
180 my $appdir = dir( split /\:\:/, $app );
182 dir( $self->{base}, 'lib', $appdir, 'C' );
183 $type = $self->{long_type} unless -d $test_path;
184 $self->{type} = $type;
185 $self->{name} = $name;
186 $self->{class} = "$app\::$type\::$name";
190 dir( $self->{base}, 'lib', $appdir, $type );
192 if ( $name =~ /\:/ ) {
193 my @path = split /\:\:/, $name;
195 $path = dir( $path, @path );
197 $self->mk_dir($path);
198 $file = file( $path, "$file.pm" );
199 $self->{file} = $file;
202 $self->{test_dir} = dir( $self->{base}, 't' );
203 $self->{test} = $self->next_test;
207 my $comp = $self->{long_type};
208 my $class = "Catalyst::Helper::$comp\::$helper";
209 eval "require $class";
212 Catalyst::Exception->throw(
213 message => qq/Couldn't load helper "$class", "$@"/ );
216 if ( $class->can('mk_compclass') ) {
217 return 1 unless $class->mk_compclass( $self, @args );
220 return 1 unless $self->_mk_compclass
223 if ( $class->can('mk_comptest') ) {
224 $class->mk_comptest( $self, @args );
233 return 1 unless $self->_mk_compclass;
241 my ( $self, $dir ) = @_;
243 print qq/ exists "$dir"\n/;
246 if ( mkpath [$dir] ) {
247 print qq/created "$dir"\n/;
251 Catalyst::Exception->throw( message => qq/Couldn't create "$dir", "$!"/ );
255 my ( $self, $file, $content ) = @_;
256 if ( -e $file && -s _ ) {
257 print qq/ exists "$file"\n/;
259 unless ( $self->{'.newfiles'}
261 || $self->{makefile} );
262 if ( $self->{'.newfiles'} ) {
263 if ( my $f = IO::File->new("< $file") ) {
264 my $oldcontent = join( '', (<$f>) );
265 return 0 if $content eq $oldcontent;
271 if ( my $f = IO::File->new("> $file") ) {
274 print qq/created "$file"\n/;
278 Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ );
282 my ( $self, $tname ) = @_;
283 if ($tname) { $tname = "$tname.t" }
285 my $name = $self->{name};
289 $tname = $prefix . '.t';
290 $self->{prefix} = $prefix;
291 $prefix = lc $prefix;
293 $self->{uri} = "/$prefix";
295 my $dir = $self->{test_dir};
296 my $type = lc $self->{type};
298 return file( $dir, "$type\_$tname" );
301 # Do not touch this method, *EVER*, it is needed for back compat.
302 ## addendum: we had to split this method so we could have backwards
303 ## compatability. otherwise, we'd have no way to pass stuff from __DATA__
306 my ( $self, $file, $path, $vars, $perms ) = @_;
307 my $template = $self->get_file( ( caller(0) )[0], $file );
308 $self->render_file_contents($template, $path, $vars, $perms);
311 sub render_sharedir_file {
312 my ( $self, $file, $path, $vars, $perms ) = @_;
313 my $template = $self->get_sharedir_file( $file );
314 die("Cannot get template from $file for $self\n") unless $template;
315 $self->render_file_contents($template, $path, $vars, $perms);
318 sub render_file_contents {
319 my ( $self, $template, $path, $vars, $perms ) = @_;
321 my $t = Template->new;
322 return 0 unless $template;
324 $t->process( \$template, { %{$self}, %$vars }, \$output )
325 || Catalyst::Exception->throw(
326 message => qq/Couldn't process "$template", / . $t->error() );
327 my $file = $self->mk_file( $path, $output );
328 chmod $perms, file($file) if defined $perms;
331 sub _mk_information {
333 print qq/Change to application directory and Run "perl Makefile.PL" to make sure your install is complete\n/;
338 $self->mk_dir( $self->{dir} );
339 $self->mk_dir( $self->{script} );
340 $self->{lib} = dir( $self->{dir}, 'lib' );
341 $self->mk_dir( $self->{lib} );
342 $self->{root} = dir( $self->{dir}, 'root' );
343 $self->mk_dir( $self->{root} );
344 $self->{static} = dir( $self->{root}, 'static' );
345 $self->mk_dir( $self->{static} );
346 $self->{images} = dir( $self->{static}, 'images' );
347 $self->mk_dir( $self->{images} );
348 $self->{t} = dir( $self->{dir}, 't' );
349 $self->mk_dir( $self->{t} );
351 $self->{class} = dir( split( /\:\:/, $self->{name} ) );
352 $self->{mod} = dir( $self->{lib}, $self->{class} );
353 $self->mk_dir( $self->{mod} );
355 if ( $self->{short} ) {
356 $self->{m} = dir( $self->{mod}, 'M' );
357 $self->mk_dir( $self->{m} );
358 $self->{v} = dir( $self->{mod}, 'V' );
359 $self->mk_dir( $self->{v} );
360 $self->{c} = dir( $self->{mod}, 'C' );
361 $self->mk_dir( $self->{c} );
364 $self->{m} = dir( $self->{mod}, 'Model' );
365 $self->mk_dir( $self->{m} );
366 $self->{v} = dir( $self->{mod}, 'View' );
367 $self->mk_dir( $self->{v} );
368 $self->{c} = dir( $self->{mod}, 'Controller' );
369 $self->mk_dir( $self->{c} );
371 my $name = $self->{name};
373 $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root";
374 $self->{base} = dir( $self->{dir} )->absolute;
379 my $mod = $self->{mod};
380 $self->render_sharedir_file( file('lib', 'MyApp.pm.tt'), "$mod.pm" );
385 $self->render_sharedir_file( file('lib', 'MyApp', 'Controller', 'Root.pm.tt'),
386 file( $self->{c}, "Root.pm" ) );
391 $self->{path} = dir( 'lib', split( '::', $self->{name} ) );
392 $self->{path} .= '.pm';
393 my $dir = $self->{dir};
394 $self->render_sharedir_file( 'Makefile.PL.tt', file($dir, "Makefile.PL") );
396 if ( $self->{makefile} ) {
398 # deprecate the old Build.PL file when regenerating Makefile.PL
399 $self->_deprecate_file(
400 file( $self->{dir}, 'Build.PL' ) );
406 my $dir = $self->{dir};
407 my $appprefix = $self->{appprefix};
408 $self->render_sharedir_file( 'myapp.conf.tt',
409 file( $dir, "$appprefix.conf" ) );
414 my $dir = $self->{dir};
415 $self->render_sharedir_file( 'README.tt', file($dir, "README") );
420 my $dir = $self->{dir};
421 my $time = strftime('%Y-%m-%d %H:%M:%S', localtime time);
422 $self->render_sharedir_file( 'Changes.tt', file($dir, "Changes"), { time => $time } );
428 $self->render_sharedir_file( file('t', '01app.t.tt'), file($t, "01app.t") );
434 $self->render_sharedir_file( file('t', '02pod.t.tt'), file($t, "02pod.t") );
437 sub _mk_podcoveragetest {
440 $self->render_sharedir_file( file('t', '03podcoverage.t.tt'), file($t, "03podcoverage.t") );
445 my $script = $self->{script};
446 my $appprefix = $self->{appprefix};
447 $self->render_sharedir_file( file('script', 'myapp_cgi.pl.tt'),
448 file($script,"$appprefix\_cgi.pl"), undef, 0700 );
453 my $script = $self->{script};
454 my $appprefix = $self->{appprefix};
455 $self->render_sharedir_file( file('script', 'myapp_fastcgi.pl.tt'),
456 file($script, "$appprefix\_fastcgi.pl"), undef, 0700 );
461 my $script = $self->{script};
462 my $appprefix = $self->{appprefix};
463 $self->render_sharedir_file( file('script', 'myapp_server.pl.tt'),
464 file($script, "$appprefix\_server.pl"), undef, 0700 );
469 my $script = $self->{script};
470 my $appprefix = $self->{appprefix};
471 $self->render_sharedir_file( file('script', 'myapp_test.pl.tt'),
472 file($script, "$appprefix\_test.pl"), undef, 0700 );
477 my $script = $self->{script};
478 my $appprefix = $self->{appprefix};
479 $self->render_sharedir_file( file('script', 'myapp_create.pl.tt'),
480 file($script, "$appprefix\_create.pl"), undef, 0700 );
485 my $file = $self->{file};
486 return $self->render_sharedir_file( file('lib', 'Helper', 'compclass.pm.tt'), $file );
491 my $test = $self->{test};
492 $self->render_sharedir_file( file('t', 'comptest.tt'), $test ); ## wtf do i rename this to?
497 my $images = $self->{images};
499 qw/catalyst_logo btn_120x50_built btn_120x50_built_shadow
500 btn_120x50_powered btn_120x50_powered_shadow btn_88x31_built
501 btn_88x31_built_shadow btn_88x31_powered btn_88x31_powered_shadow/;
502 for my $name (@images) {
503 my $image = $self->get_sharedir_file("root", "static", "images", "$name.png.bin");
504 $self->mk_file( file( $images, "$name.png" ), $image );
510 my $root = $self->{root};
511 my $favicon = $self->get_sharedir_file( 'root', 'favicon.ico.bin' );
512 my $dest = dir( $root, "favicon.ico" );
513 $self->mk_file( $dest, $favicon );
517 sub _deprecate_file {
518 my ( $self, $file ) = @_;
520 my ($f, $oldcontent);
521 if ( $f = IO::File->new("< $file") ) {
522 $oldcontent = join( '', (<$f>) );
524 my $newfile = $file . '.deprecated';
525 if ( $f = IO::File->new("> $newfile") ) {
527 print $f $oldcontent;
528 print qq/created "$newfile"\n/;
530 print qq/removed "$file"\n/;
533 Catalyst::Exception->throw(
534 message => qq/Couldn't create "$file", "$!"/ );
540 This module is used by B<catalyst.pl> to create a set of scripts for a
541 new catalyst application. The scripts each contain documentation and
542 will output help on how to use them if called incorrectly or in some
543 cases, with no arguments.
545 It also provides some useful methods for a Helper module to call when
546 creating a component. See L</METHODS>.
552 Used to create new components for a catalyst application at the
557 The catalyst test server, starts an HTTPD which outputs debugging to
562 A script for running tests from the command-line.
566 Run your application as a CGI.
570 Run the application as a fastcgi app. Either by hand, or call this
571 from FastCgiServer in your http server config.
575 The L</_create.pl> script creates application components using Helper
576 modules. The Catalyst team provides a good number of Helper modules
577 for you to use. You can also add your own.
579 Helpers are classes that provide two methods.
581 * mk_compclass - creates the Component class
582 * mk_comptest - creates the Component test
584 So when you call C<scripts/myapp_create.pl view MyView TT>, create
585 will try to execute Catalyst::Helper::View::TT->mk_compclass and
586 Catalyst::Helper::View::TT->mk_comptest.
588 See L<Catalyst::Helper::View::TT> and
589 L<Catalyst::Helper::Model::DBIC::Schema> for examples.
591 All helper classes should be under one of the following namespaces.
593 Catalyst::Helper::Model::
594 Catalyst::Helper::View::
595 Catalyst::Helper::Controller::
597 =head2 COMMON HELPERS
603 L<Catalyst::Helper::Model::DBIC::Schema> - DBIx::Class models
607 L<Catalyst::Helper::View::TT> - Template Toolkit view
611 L<Catalyst::Helper::Model::LDAP>
615 L<Catalyst::Helper::Model::Adaptor> - wrap any class into a Catalyst model
621 The helpers will read author name from /etc/passwd by default.
622 To override, please export the AUTHOR variable.
628 This method in your Helper module is called with C<$helper>
629 which is a L<Catalyst::Helper> object, and whichever other arguments
630 the user added to the command-line. You can use the $helper to call methods
633 If the Helper module does not contain a C<mk_compclass> method, it
634 will fall back to calling L</render_file>, with an argument of
639 This method in your Helper module is called with C<$helper>
640 which is a L<Catalyst::Helper> object, and whichever other arguments
641 the user added to the command-line. You can use the $helper to call methods
644 If the Helper module does not contain a C<mk_compclass> method, it
645 will fall back to calling L</render_file>, with an argument of
650 This method is called if the user does not supply any of the usual
651 component types C<view>, C<controller>, C<model>. It is passed the
652 C<$helper> object (an instance of L<Catalyst::Helper>), and any other
653 arguments the user typed.
655 There is no fallback for this method.
657 =head1 INTERNAL METHODS
659 These are the methods that the Helper classes can call on the
660 <$helper> object passed to them.
662 =head2 render_file ($file, $path, $vars, $perms)
664 Render and create a file from a template in DATA using Template
665 Toolkit. $file is the relevent chunk of the __DATA__ section, $path is
666 the path to the file, $vars is the hashref as expected by
667 L<Template Toolkit|Template> and $perms are desired permissions (or system
668 defaults if not set).
670 =head2 get_file ($class, $file)
672 Fetch file contents from the DATA section. This is used internally by
673 L</render_file>. $class is the name of the class to get the DATA
674 section from. __PACKAGE__ or ( caller(0) )[0] might be sensible
679 Create the main application skeleton. This is called by L<catalyst.pl>.
681 =head2 mk_component ($app)
683 This method is called by L<create.pl> to make new components
684 for your application.
686 =head2 mk_dir ($path)
688 Surprisingly, this function makes a directory.
690 =head2 mk_file ($file, $content)
692 Writes content to a file. Called by L</render_file>.
694 =head2 next_test ($test_name)
696 Calculates the name of the next numbered test file and returns it.
697 Don't give the number or the .t suffix for the test name.
701 =head2 get_sharedir_file
703 Method for getting a file out of share/
707 =head2 render_file_contents
709 Process a L<Template::Toolkit> template.
713 =head2 render_sharedir_file
715 Render a template/image file from our share directory
721 The helpers will read author name from /etc/passwd by default.
722 To override, please export the AUTHOR variable.
726 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
727 L<Catalyst::Response>, L<Catalyst>
731 Catalyst Contributors, see Catalyst.pm
735 This library is free software. You can redistribute it and/or modify
736 it under the same terms as Perl itself.