1 package Catalyst::Helper;
13 use Catalyst::Exception;
14 use Path::Class qw/dir file/;
15 use File::ShareDir qw/dist_dir/;
16 use namespace::autoclean;
18 with 'MooseX::Emulate::Class::Accessor::Fast';
20 # Change Catalyst/Devel.pm also
21 our $VERSION = '1.23';
27 Catalyst::Helper - Bootstrap a Catalyst application
31 catalyst.pl <myappname>
35 sub get_sharedir_file {
36 my ($self, @filename) = @_;
38 if (exists $ENV{CATALYST_DEVEL_SHAREDIR}) {
39 $dist_dir = $ENV{CATALYST_DEVEL_SHAREDIR};
41 elsif (-d "inc/.author" && -f "lib/Catalyst/Helper.pm"
42 ) { # Can't use sharedir if we're in a checkout
43 # this feels horrible, better ideas?
47 $dist_dir = dist_dir('Catalyst-Devel');
49 my $file = file( $dist_dir, @filename);
50 Carp::confess("Cannot find $file") unless -r $file;
51 my $contents = $file->slurp;
55 # Do not touch this method, *EVER*, it is needed for back compat.
57 my ( $self, $class, $file ) = @_;
58 unless ( $cache{$class} ) {
60 $cache{$class} = eval "package $class; <DATA>";
62 my $data = $cache{$class};
63 Carp::confess("Could not get data from __DATA__ segment for $class")
65 my @files = split /^__(.+)__\r?\n/m, $data;
68 my ( $name, $content ) = splice @files, 0, 2;
69 return $content if $name eq $file;
76 my ( $self, $name ) = @_;
78 # Needs to be here for PAR
81 if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) {
82 warn "Error: Invalid application name.\n";
85 $self->{name } = $name;
86 $self->{dir } = $name;
87 $self->{dir } =~ s/\:\:/-/g;
88 $self->{script } = dir( $self->{dir}, 'script' );
89 $self->{appprefix } = Catalyst::Utils::appprefix($name);
90 $self->{appenv } = Catalyst::Utils::class2env($name);
91 $self->{startperl } = -r '/usr/bin/env'
92 ? '#!/usr/bin/env perl'
93 : "#!$Config{perlpath}";
94 $self->{scriptgen } = $Catalyst::Devel::CATALYST_SCRIPT_GEN;
95 $self->{catalyst_version} = $Catalyst::VERSION;
96 $self->{author } = $self->{author} = $ENV{'AUTHOR'}
97 || eval { @{ [ getpwuid($<) ] }[6] }
98 || 'Catalyst developer';
100 my $gen_scripts = ( $self->{makefile} ) ? 0 : 1;
101 my $gen_makefile = ( $self->{scripts} ) ? 0 : 1;
102 my $gen_app = ( $self->{scripts} || $self->{makefile} ) ? 0 : 1;
105 for ( qw/ _mk_dirs _mk_config _mk_appclass _mk_rootclass _mk_readme
106 _mk_changes _mk_apptest _mk_images _mk_favicon/ ) {
115 for ( qw/ _mk_cgi _mk_fastcgi _mk_server
116 _mk_test _mk_create _mk_information
124 ## not much of this can really be changed, mk_compclass must be left for
130 $self->{author} = $self->{author} = $ENV{'AUTHOR'}
131 || eval { @{ [ getpwuid($<) ] }[6] }
133 $self->{base} ||= dir( $FindBin::Bin, '..' );
134 unless ( $_[0] =~ /^(?:model|view|controller)$/i ) {
137 my $class = "Catalyst::Helper::$helper";
138 eval "require $class";
141 Catalyst::Exception->throw(
142 message => qq/Couldn't load helper "$class", "$@"/ );
145 if ( $class->can('mk_stuff') ) {
146 return 1 unless $class->mk_stuff( $self, @args );
151 my $name = shift || "Missing name for model/view/controller";
154 return 0 if $name =~ /[^\w\:]/;
156 $self->{long_type} = ucfirst $type;
157 $type = 'M' if $type =~ /model/i;
158 $type = 'V' if $type =~ /view/i;
159 $type = 'C' if $type =~ /controller/i;
160 my $appdir = dir( split /\:\:/, $app );
162 dir( $self->{base}, 'lib', $appdir, 'C' );
163 $type = $self->{long_type} unless -d $test_path;
164 $self->{type} = $type;
165 $self->{name} = $name;
166 $self->{class} = "$app\::$type\::$name";
170 dir( $self->{base}, 'lib', $appdir, $type );
172 if ( $name =~ /\:/ ) {
173 my @path = split /\:\:/, $name;
175 $path = dir( $path, @path );
177 $self->mk_dir($path);
178 $file = file( $path, "$file.pm" );
179 $self->{file} = $file;
182 $self->{test_dir} = dir( $self->{base}, 't' );
183 $self->{test} = $self->next_test;
187 my $comp = $self->{long_type};
188 my $class = "Catalyst::Helper::$comp\::$helper";
189 eval "require $class";
192 Catalyst::Exception->throw(
193 message => qq/Couldn't load helper "$class", "$@"/ );
196 if ( $class->can('mk_compclass') ) {
197 return 1 unless $class->mk_compclass( $self, @args );
200 return 1 unless $self->_mk_compclass
203 if ( $class->can('mk_comptest') ) {
204 $class->mk_comptest( $self, @args );
213 return 1 unless $self->_mk_compclass;
221 my ( $self, $dir ) = @_;
223 print qq/ exists "$dir"\n/;
226 if ( mkpath [$dir] ) {
227 print qq/created "$dir"\n/;
231 Catalyst::Exception->throw( message => qq/Couldn't create "$dir", "$!"/ );
235 my ( $self, $file, $content ) = @_;
236 if ( -e $file && -s _ ) {
237 print qq/ exists "$file"\n/;
239 unless ( $self->{'.newfiles'}
241 || $self->{makefile} );
242 if ( $self->{'.newfiles'} ) {
243 if ( my $f = IO::File->new("< $file") ) {
244 my $oldcontent = join( '', (<$f>) );
245 return 0 if $content eq $oldcontent;
251 if ( my $f = IO::File->new("> $file") ) {
254 print qq/created "$file"\n/;
258 Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ );
262 my ( $self, $tname ) = @_;
263 if ($tname) { $tname = "$tname.t" }
265 my $name = $self->{name};
269 $tname = $prefix . '.t';
270 $self->{prefix} = $prefix;
271 $prefix = lc $prefix;
273 $self->{uri} = "/$prefix";
275 my $dir = $self->{test_dir};
276 my $type = lc $self->{type};
278 return file( $dir, "$type\_$tname" );
281 # Do not touch this method, *EVER*, it is needed for back compat.
282 ## addendum: we had to split this method so we could have backwards
283 ## compatability. otherwise, we'd have no way to pass stuff from __DATA__
286 my ( $self, $file, $path, $vars ) = @_;
287 my $template = $self->get_file( ( caller(0) )[0], $file );
288 $self->render_file_contents($template, $path, $vars);
291 sub render_sharedir_file {
292 my ( $self, $file, $path, $vars ) = @_;
293 my $template = $self->get_sharedir_file( $file );
294 die("Cannot get template from $file for $self\n") unless $template;
295 $self->render_file_contents($template, $path, $vars);
298 sub render_file_contents {
299 my ( $self, $template, $path, $vars ) = @_;
301 my $t = Template->new;
302 return 0 unless $template;
304 $t->process( \$template, { %{$self}, %$vars }, \$output )
305 || Catalyst::Exception->throw(
306 message => qq/Couldn't process "$template", / . $t->error() );
307 $self->mk_file( $path, $output );
310 sub _mk_information {
312 print qq/Change to application directory and Run "perl Makefile.PL" to make sure your install is complete\n/;
317 $self->mk_dir( $self->{dir} );
318 $self->mk_dir( $self->{script} );
319 $self->{lib} = dir( $self->{dir}, 'lib' );
320 $self->mk_dir( $self->{lib} );
321 $self->{root} = dir( $self->{dir}, 'root' );
322 $self->mk_dir( $self->{root} );
323 $self->{static} = dir( $self->{root}, 'static' );
324 $self->mk_dir( $self->{static} );
325 $self->{images} = dir( $self->{static}, 'images' );
326 $self->mk_dir( $self->{images} );
327 $self->{t} = dir( $self->{dir}, 't' );
328 $self->mk_dir( $self->{t} );
330 $self->{class} = dir( split( /\:\:/, $self->{name} ) );
331 $self->{mod} = dir( $self->{lib}, $self->{class} );
332 $self->mk_dir( $self->{mod} );
334 if ( $self->{short} ) {
335 $self->{m} = dir( $self->{mod}, 'M' );
336 $self->mk_dir( $self->{m} );
337 $self->{v} = dir( $self->{mod}, 'V' );
338 $self->mk_dir( $self->{v} );
339 $self->{c} = dir( $self->{mod}, 'C' );
340 $self->mk_dir( $self->{c} );
343 $self->{m} = dir( $self->{mod}, 'Model' );
344 $self->mk_dir( $self->{m} );
345 $self->{v} = dir( $self->{mod}, 'View' );
346 $self->mk_dir( $self->{v} );
347 $self->{c} = dir( $self->{mod}, 'Controller' );
348 $self->mk_dir( $self->{c} );
350 my $name = $self->{name};
352 $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root";
353 $self->{base} = dir( $self->{dir} )->absolute;
358 my $mod = $self->{mod};
359 $self->render_sharedir_file( file('lib', 'MyApp.pm.tt'), "$mod.pm" );
364 $self->render_sharedir_file( file('lib', 'MyApp', 'Controller', 'Root.pm.tt'),
365 file( $self->{c}, "Root.pm" ) );
370 $self->{path} = dir( 'lib', split( '::', $self->{name} ) );
371 $self->{path} .= '.pm';
372 my $dir = $self->{dir};
373 $self->render_sharedir_file( 'Makefile.PL.tt', file($dir, "Makefile.PL") );
375 if ( $self->{makefile} ) {
377 # deprecate the old Build.PL file when regenerating Makefile.PL
378 $self->_deprecate_file(
379 file( $self->{dir}, 'Build.PL' ) );
385 my $dir = $self->{dir};
386 my $appprefix = $self->{appprefix};
387 $self->render_sharedir_file( 'myapp.conf.tt',
388 file( $dir, "$appprefix.conf" ) );
393 my $dir = $self->{dir};
394 $self->render_sharedir_file( 'README.tt', file($dir, "README") );
399 my $dir = $self->{dir};
400 my $time = strftime('%Y-%m-%d %H:%M:%S', localtime time);
401 $self->render_sharedir_file( 'Changes.tt', file($dir, "Changes"), { time => $time } );
407 $self->render_sharedir_file( file('t', '01app.t.tt'), file($t, "01app.t") );
408 $self->render_sharedir_file( file('t', '02pod.t.tt'), file($t, "02pod.t") );
409 $self->render_sharedir_file( file('t', '03podcoverage.t.tt'), file($t, "03podcoverage.t") );
414 my $script = $self->{script};
415 my $appprefix = $self->{appprefix};
416 $self->render_sharedir_file( file('script', 'myapp_cgi.pl.tt'), file($script,"$appprefix\_cgi.pl") );
417 chmod 0700, file($script,"$appprefix\_cgi.pl");
422 my $script = $self->{script};
423 my $appprefix = $self->{appprefix};
424 $self->render_sharedir_file( file('script', 'myapp_fastcgi.pl.tt'), file($script, "$appprefix\_fastcgi.pl") );
425 chmod 0700, file($script, "$appprefix\_fastcgi.pl");
430 my $script = $self->{script};
431 my $appprefix = $self->{appprefix};
432 $self->render_sharedir_file( file('script', 'myapp_server.pl.tt'), file($script, "$appprefix\_server.pl") );
433 chmod 0700, file($script, "$appprefix\_server.pl");
438 my $script = $self->{script};
439 my $appprefix = $self->{appprefix};
440 $self->render_sharedir_file( file('script', 'myapp_test.pl.tt'), file($script, "$appprefix\_test.pl") );
441 chmod 0700, file($script, "$appprefix\_test.pl");
446 my $script = $self->{script};
447 my $appprefix = $self->{appprefix};
448 $self->render_sharedir_file( file('script', 'myapp_create.pl.tt'), file($script, "$appprefix\_create.pl") );
449 chmod 0700, file($script, "$appprefix\_create.pl");
454 my $file = $self->{file};
455 return $self->render_sharedir_file( file('lib', 'Helper', 'compclass.pm.tt'), $file );
460 my $test = $self->{test};
461 $self->render_sharedir_file( file('t', 'comptest.tt'), $test ); ## wtf do i rename this to?
466 my $images = $self->{images};
468 qw/catalyst_logo btn_120x50_built btn_120x50_built_shadow
469 btn_120x50_powered btn_120x50_powered_shadow btn_88x31_built
470 btn_88x31_built_shadow btn_88x31_powered btn_88x31_powered_shadow/;
471 for my $name (@images) {
472 my $image = $self->get_sharedir_file("root", "static", "images", "$name.png.bin");
473 $self->mk_file( file( $images, "$name.png" ), $image );
479 my $root = $self->{root};
480 my $favicon = $self->get_sharedir_file( 'root', 'favicon.ico.bin' );
481 my $dest = dir( $root, "favicon.ico" );
482 $self->mk_file( $dest, $favicon );
486 sub _deprecate_file {
487 my ( $self, $file ) = @_;
489 my ($f, $oldcontent);
490 if ( $f = IO::File->new("< $file") ) {
491 $oldcontent = join( '', (<$f>) );
493 my $newfile = $file . '.deprecated';
494 if ( $f = IO::File->new("> $newfile") ) {
496 print $f $oldcontent;
497 print qq/created "$newfile"\n/;
499 print qq/removed "$file"\n/;
502 Catalyst::Exception->throw(
503 message => qq/Couldn't create "$file", "$!"/ );
509 This module is used by B<catalyst.pl> to create a set of scripts for a
510 new catalyst application. The scripts each contain documentation and
511 will output help on how to use them if called incorrectly or in some
512 cases, with no arguments.
514 It also provides some useful methods for a Helper module to call when
515 creating a component. See L</METHODS>.
521 Used to create new components for a catalyst application at the
526 The catalyst test server, starts an HTTPD which outputs debugging to
531 A script for running tests from the command-line.
535 Run your application as a CGI.
539 Run the application as a fastcgi app. Either by hand, or call this
540 from FastCgiServer in your http server config.
544 The L</_create.pl> script creates application components using Helper
545 modules. The Catalyst team provides a good number of Helper modules
546 for you to use. You can also add your own.
548 Helpers are classes that provide two methods.
550 * mk_compclass - creates the Component class
551 * mk_comptest - creates the Component test
553 So when you call C<scripts/myapp_create.pl view MyView TT>, create
554 will try to execute Catalyst::Helper::View::TT->mk_compclass and
555 Catalyst::Helper::View::TT->mk_comptest.
557 See L<Catalyst::Helper::View::TT> and
558 L<Catalyst::Helper::Model::DBIC::Schema> for examples.
560 All helper classes should be under one of the following namespaces.
562 Catalyst::Helper::Model::
563 Catalyst::Helper::View::
564 Catalyst::Helper::Controller::
566 =head2 COMMON HELPERS
572 L<Catalyst::Helper::Model::DBIC::Schema> - DBIx::Class models
576 L<Catalyst::Helper::View::TT> - Template Toolkit view
580 L<Catalyst::Helper::Model::LDAP>
584 L<Catalyst::Helper::Model::Adaptor> - wrap any class into a Catalyst model
590 The helpers will read author name from /etc/passwd by default.
591 To override, please export the AUTHOR variable.
597 This method in your Helper module is called with C<$helper>
598 which is a L<Catalyst::Helper> object, and whichever other arguments
599 the user added to the command-line. You can use the $helper to call methods
602 If the Helper module does not contain a C<mk_compclass> method, it
603 will fall back to calling L</render_file>, with an argument of
608 This method in your Helper module is called with C<$helper>
609 which is a L<Catalyst::Helper> object, and whichever other arguments
610 the user added to the command-line. You can use the $helper to call methods
613 If the Helper module does not contain a C<mk_compclass> method, it
614 will fall back to calling L</render_file>, with an argument of
619 This method is called if the user does not supply any of the usual
620 component types C<view>, C<controller>, C<model>. It is passed the
621 C<$helper> object (an instance of L<Catalyst::Helper>), and any other
622 arguments the user typed.
624 There is no fallback for this method.
626 =head1 INTERNAL METHODS
628 These are the methods that the Helper classes can call on the
629 <$helper> object passed to them.
631 =head2 render_file ($file, $path, $vars)
633 Render and create a file from a template in DATA using Template
634 Toolkit. $file is the relevent chunk of the __DATA__ section, $path is
635 the path to the file and $vars is the hashref as expected by
636 L<Template Toolkit|Template>.
638 =head2 get_file ($class, $file)
640 Fetch file contents from the DATA section. This is used internally by
641 L</render_file>. $class is the name of the class to get the DATA
642 section from. __PACKAGE__ or ( caller(0) )[0] might be sensible
647 Create the main application skeleton. This is called by L<catalyst.pl>.
649 =head2 mk_component ($app)
651 This method is called by L<create.pl> to make new components
652 for your application.
654 =head2 mk_dir ($path)
656 Surprisingly, this function makes a directory.
658 =head2 mk_file ($file, $content)
660 Writes content to a file. Called by L</render_file>.
662 =head2 next_test ($test_name)
664 Calculates the name of the next numbered test file and returns it.
665 Don't give the number or the .t suffix for the test name.
669 =head2 get_sharedir_file
671 Method for getting a file out of share/
675 =head2 render_file_contents
677 Process a L<Template::Toolkit> template.
681 =head2 render_sharedir_file
683 Render a template/image file from our share directory
689 The helpers will read author name from /etc/passwd by default.
690 To override, please export the AUTHOR variable.
694 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
695 L<Catalyst::Response>, L<Catalyst>
699 Catalyst Contributors, see Catalyst.pm
703 This library is free software. You can redistribute it and/or modify
704 it under the same terms as Perl itself.