1 package Catalyst::Helper;
12 use Catalyst::Exception;
13 use Path::Class qw/dir file/;
14 use File::ShareDir qw/dist_dir/;
15 use namespace::autoclean;
21 Catalyst::Helper - Bootstrap a Catalyst application
25 catalyst.pl <myappname>
29 sub get_sharedir_file {
30 my ($self, @filename) = @_;
32 if (-d "inc/.author" && -f "lib/Catalyst/Helper.pm"
33 ) { # Can't use sharedir if we're in a checkout
34 # this feels horrible, better ideas?
38 $dist_dir = dist_dir('Catalyst-Devel');
40 my $file = file( $dist_dir, @filename);
41 Carp::confess("Cannot find $file") unless -r $file;
42 my $contents = $file->slurp;
46 # Do not touch this method, *EVER*, it is needed for back compat.
48 my ( $self, $class, $file ) = @_;
49 unless ( $cache{$class} ) {
51 $cache{$class} = eval "package $class; <DATA>";
53 my $data = $cache{$class};
54 Carp::confess("Could not get data from __DATA__ segment for $class")
56 my @files = split /^__(.+)__\r?\n/m, $data;
59 my ( $name, $content ) = splice @files, 0, 2;
60 return $content if $name eq $file;
67 my ( $self, $name ) = @_;
69 # Needs to be here for PAR
72 if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) {
73 warn "Error: Invalid application name.\n";
76 $self->{name } = $name;
77 $self->{dir } = $name;
78 $self->{dir } =~ s/\:\:/-/g;
79 $self->{script } = File::Spec->catdir( $self->{dir}, 'script' );
80 $self->{appprefix } = Catalyst::Utils::appprefix($name);
81 $self->{appenv } = Catalyst::Utils::class2env($name);
82 $self->{startperl } = -r '/usr/bin/env'
83 ? '#!/usr/bin/env perl'
84 : "#!$Config{perlpath} -w";
85 $self->{scriptgen } = $Catalyst::Devel::CATALYST_SCRIPT_GEN || 4;
86 $self->{catalyst_version} = $Catalyst::VERSION;
87 $self->{author } = $self->{author} = $ENV{'AUTHOR'}
88 || eval { @{ [ getpwuid($<) ] }[6] }
89 || 'Catalyst developer';
91 my $gen_scripts = ( $self->{makefile} ) ? 0 : 1;
92 my $gen_makefile = ( $self->{scripts} ) ? 0 : 1;
93 my $gen_app = ( $self->{scripts} || $self->{makefile} ) ? 0 : 1;
113 $self->_mk_dbic_deploy;
116 $self->_mk_information;
125 $self->{author} = $self->{author} = $ENV{'AUTHOR'}
126 || eval { @{ [ getpwuid($<) ] }[6] }
128 $self->{base} ||= File::Spec->catdir( $FindBin::Bin, '..' );
129 unless ( $_[0] =~ /^(?:model|view|controller)$/i ) {
132 my $class = "Catalyst::Helper::$helper";
133 eval "require $class";
136 Catalyst::Exception->throw(
137 message => qq/Couldn't load helper "$class", "$@"/ );
140 if ( $class->can('mk_stuff') ) {
141 return 1 unless $class->mk_stuff( $self, @args );
146 my $name = shift || "Missing name for model/view/controller";
149 return 0 if $name =~ /[^\w\:]/;
151 $self->{long_type} = ucfirst $type;
152 $type = 'M' if $type =~ /model/i;
153 $type = 'V' if $type =~ /view/i;
154 $type = 'C' if $type =~ /controller/i;
155 my $appdir = File::Spec->catdir( split /\:\:/, $app );
157 File::Spec->catdir( $self->{base}, 'lib', $appdir, 'C' );
158 $type = $self->{long_type} unless -d $test_path;
159 $self->{type} = $type;
160 $self->{name} = $name;
161 $self->{class} = "$app\::$type\::$name";
165 File::Spec->catdir( $self->{base}, 'lib', $appdir, $type );
167 if ( $name =~ /\:/ ) {
168 my @path = split /\:\:/, $name;
170 $path = File::Spec->catdir( $path, @path );
172 $self->mk_dir($path);
173 $file = File::Spec->catfile( $path, "$file.pm" );
174 $self->{file} = $file;
177 $self->{test_dir} = File::Spec->catdir( $self->{base}, 't' );
178 $self->{test} = $self->next_test;
182 my $comp = $self->{long_type};
183 my $class = "Catalyst::Helper::$comp\::$helper";
184 eval "require $class";
187 Catalyst::Exception->throw(
188 message => qq/Couldn't load helper "$class", "$@"/ );
191 if ( $class->can('mk_compclass') ) {
192 return 1 unless $class->mk_compclass( $self, @args );
194 else { return 1 unless $self->_mk_compclass }
196 if ( $class->can('mk_comptest') ) {
197 $class->mk_comptest( $self, @args );
199 else { $self->_mk_comptest }
204 return 1 unless $self->_mk_compclass;
212 my ( $self, $dir ) = @_;
214 print qq/ exists "$dir"\n/;
217 if ( mkpath [$dir] ) {
218 print qq/created "$dir"\n/;
222 Catalyst::Exception->throw( message => qq/Couldn't create "$dir", "$!"/ );
226 my ( $self, $file, $content ) = @_;
227 if ( -e $file && -s _ ) {
228 print qq/ exists "$file"\n/;
230 unless ( $self->{'.newfiles'}
232 || $self->{makefile} );
233 if ( $self->{'.newfiles'} ) {
234 if ( my $f = IO::File->new("< $file") ) {
235 my $oldcontent = join( '', (<$f>) );
236 return 0 if $content eq $oldcontent;
242 if ( my $f = IO::File->new("> $file") ) {
245 print qq/created "$file"\n/;
249 Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ );
253 my ( $self, $tname ) = @_;
254 if ($tname) { $tname = "$tname.t" }
256 my $name = $self->{name};
260 $tname = $prefix . '.t';
261 $self->{prefix} = $prefix;
262 $prefix = lc $prefix;
264 $self->{uri} = "/$prefix";
266 my $dir = $self->{test_dir};
267 my $type = lc $self->{type};
269 return File::Spec->catfile( $dir, "$type\_$tname" );
272 # Do not touch this method, *EVER*, it is needed for back compat.
273 ## addendum: we had to split this method so we could have backwards
274 ## compatability. otherwise, we'd have no way to pass stuff from __DATA__
277 my ( $self, $file, $path, $vars ) = @_;
278 my $template = $self->get_file( ( caller(0) )[0], $file );
279 $self->render_file_contents($template, $path, $vars);
282 sub render_sharedir_file {
283 my ( $self, $file, $path, $vars ) = @_;
284 my $template = $self->get_sharedir_file( $file );
285 die("Cannot get template from $file for $self\n") unless $template;
286 $self->render_file_contents($template, $path, $vars);
289 sub render_file_contents {
290 my ( $self, $template, $path, $vars ) = @_;
292 my $t = Template->new;
293 return 0 unless $template;
295 $t->process( \$template, { %{$self}, %$vars }, \$output )
296 || Catalyst::Exception->throw(
297 message => qq/Couldn't process "$template", / . $t->error() );
298 $self->mk_file( $path, $output );
301 sub _mk_information {
303 print qq/Change to application directory and Run "perl Makefile.PL" to make sure your install is complete\n/;
308 $self->mk_dir( $self->{dir} );
309 $self->mk_dir( $self->{script} );
310 $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
311 $self->mk_dir( $self->{lib} );
312 $self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
313 $self->mk_dir( $self->{root} );
314 $self->{static} = File::Spec->catdir( $self->{root}, 'static' );
315 $self->mk_dir( $self->{static} );
316 $self->{images} = File::Spec->catdir( $self->{static}, 'images' );
317 $self->mk_dir( $self->{images} );
318 $self->{t} = File::Spec->catdir( $self->{dir}, 't' );
319 $self->mk_dir( $self->{t} );
321 $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
322 $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
323 $self->mk_dir( $self->{mod} );
325 if ( $self->{short} ) {
326 $self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
327 $self->mk_dir( $self->{m} );
328 $self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
329 $self->mk_dir( $self->{v} );
330 $self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
331 $self->mk_dir( $self->{c} );
334 $self->{m} = File::Spec->catdir( $self->{mod}, 'Model' );
335 $self->mk_dir( $self->{m} );
336 $self->{v} = File::Spec->catdir( $self->{mod}, 'View' );
337 $self->mk_dir( $self->{v} );
338 $self->{c} = File::Spec->catdir( $self->{mod}, 'Controller' );
339 $self->mk_dir( $self->{c} );
341 my $name = $self->{name};
343 $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root";
344 $self->{base} = File::Spec->rel2abs( $self->{dir} );
349 my $mod = $self->{mod};
350 $self->render_sharedir_file( File::Spec->catfile('lib', 'MyApp.pm.tt'), "$mod.pm" );
355 $self->render_sharedir_file( File::Spec->catfile('lib', 'MyApp', 'Controller', 'Root.pm.tt'),
356 File::Spec->catfile( $self->{c}, "Root.pm" ) );
361 $self->{path} = File::Spec->catfile( 'lib', split( '::', $self->{name} ) );
362 $self->{path} .= '.pm';
363 my $dir = $self->{dir};
364 $self->render_sharedir_file( 'Makefile.PL.tt', "$dir\/Makefile.PL" );
366 if ( $self->{makefile} ) {
368 # deprecate the old Build.PL file when regenerating Makefile.PL
369 $self->_deprecate_file(
370 File::Spec->catdir( $self->{dir}, 'Build.PL' ) );
376 my $dir = $self->{dir};
377 my $appprefix = $self->{appprefix};
378 $self->render_sharedir_file( 'myapp.conf.tt',
379 File::Spec->catfile( $dir, "$appprefix.conf" ) );
384 my $dir = $self->{dir};
385 $self->render_sharedir_file( 'README.tt', "$dir\/README" );
390 my $dir = $self->{dir};
391 my $time = strftime('%Y-%m-%d %H:%M:%S', localtime time);
392 $self->render_sharedir_file( 'Changes.tt', "$dir\/Changes", { time => $time } );
398 $self->render_sharedir_file( File::Spec->catfile('t', '01app.t.tt'), "$t\/01app.t" );
399 $self->render_sharedir_file( File::Spec->catfile('t', '02pod.t.tt'), "$t\/02pod.t" );
400 $self->render_sharedir_file( File::Spec->catfile('t', '03podcoverage.t.tt'), "$t\/03podcoverage.t" );
405 my $script = $self->{script};
406 my $appprefix = $self->{appprefix};
407 $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_cgi.pl.tt'), "$script\/$appprefix\_cgi.pl" );
408 chmod 0700, "$script/$appprefix\_cgi.pl";
413 my $script = $self->{script};
414 my $appprefix = $self->{appprefix};
415 $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_fastcgi.pl.tt'), "$script\/$appprefix\_fastcgi.pl" );
416 chmod 0700, "$script/$appprefix\_fastcgi.pl";
421 my $script = $self->{script};
422 my $appprefix = $self->{appprefix};
423 $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_server.pl.tt'), "$script\/$appprefix\_server.pl" );
424 chmod 0700, "$script/$appprefix\_server.pl";
429 my $script = $self->{script};
430 my $appprefix = $self->{appprefix};
431 $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_test.pl.tt'), "$script/$appprefix\_test.pl" );
432 chmod 0700, "$script/$appprefix\_test.pl";
437 my $script = $self->{script};
438 my $appprefix = $self->{appprefix};
439 $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_create.pl.tt'), "$script\/$appprefix\_create.pl" );
440 chmod 0700, "$script/$appprefix\_create.pl";
445 my $file = $self->{file};
446 return $self->render_sharedir_file( File::Spec->catfile('lib', 'Helper', 'compclass.pm.tt'), $file );
451 my $test = $self->{test};
452 $self->render_sharedir_file( File::Spec->catfile('t', 'comptest.tt'), $test ); ## wtf do i rename this to?
457 my $images = $self->{images};
459 qw/catalyst_logo btn_120x50_built btn_120x50_built_shadow
460 btn_120x50_powered btn_120x50_powered_shadow btn_88x31_built
461 btn_88x31_built_shadow btn_88x31_powered btn_88x31_powered_shadow/;
462 for my $name (@images) {
463 my $image = $self->get_sharedir_file("root", "static", "images", "$name.png.bin");
464 $self->mk_file( File::Spec->catfile( $images, "$name.png" ), $image );
470 my $root = $self->{root};
471 my $favicon = $self->get_sharedir_file( 'root', 'favicon.ico.bin' );
472 my $dest = File::Spec->catfile( $root, "favicon.ico" );
473 $self->mk_file( $dest, $favicon );
477 sub _mk_dbic_deploy {
479 my $script = $self->{script};
480 my $appprefix = $self->{appprefix};
481 $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_deploy_schema.pl.tt'), "$script\/$appprefix\_deploy_schema.pl" );
482 chmod 0700, "$script/$appprefix\_deploy_schema.pl";
485 sub _deprecate_file {
486 my ( $self, $file ) = @_;
489 if ( my $f = IO::File->new("< $file") ) {
490 $oldcontent = join( '', (<$f>) );
492 my $newfile = $file . '.deprecated';
493 if ( my $f = IO::File->new("> $newfile") ) {
495 print $f $oldcontent;
496 print qq/created "$newfile"\n/;
498 print qq/removed "$file"\n/;
501 Catalyst::Exception->throw(
502 message => qq/Couldn't create "$file", "$!"/ );
508 This module is used by B<catalyst.pl> to create a set of scripts for a
509 new catalyst application. The scripts each contain documentation and
510 will output help on how to use them if called incorrectly or in some
511 cases, with no arguments.
513 It also provides some useful methods for a Helper module to call when
514 creating a component. See L</METHODS>.
520 Used to create new components for a catalyst application at the
525 The catalyst test server, starts an HTTPD which outputs debugging to
528 =head2 _deploy_dbic.pl
530 Deploy a L<DBIx::Class> schema to the database of your choice.
534 A script for running tests from the command-line.
538 Run your application as a CGI.
542 Run the application as a fastcgi app. Either by hand, or call this
543 from FastCgiServer in your http server config.
547 The L</_create.pl> script creates application components using Helper
548 modules. The Catalyst team provides a good number of Helper modules
549 for you to use. You can also add your own.
551 Helpers are classes that provide two methods.
553 * mk_compclass - creates the Component class
554 * mk_comptest - creates the Component test
556 So when you call C<scripts/myapp_create.pl view MyView TT>, create
557 will try to execute Catalyst::Helper::View::TT->mk_compclass and
558 Catalyst::Helper::View::TT->mk_comptest.
560 See L<Catalyst::Helper::View::TT> and
561 L<Catalyst::Helper::Model::DBIC::Schema> for examples.
563 All helper classes should be under one of the following namespaces.
565 Catalyst::Helper::Model::
566 Catalyst::Helper::View::
567 Catalyst::Helper::Controller::
569 =head2 COMMON HELPERS
575 L<Catalyst::Helper::Model::DBIC::Schema> - DBIx::Class models
579 L<Catalyst::Helper::View::TT> - Template Toolkit view
583 L<Catalyst::Helper::Model::LDAP>
587 L<Catalyst::Helper::Model::Adaptor> - wrap any class into a Catalyst model
593 The helpers will read author name from /etc/passwd by default. + To override, please export the AUTHOR variable.
599 This method in your Helper module is called with C<$helper>
600 which is a L<Catalyst::Helper> object, and whichever other arguments
601 the user added to the command-line. You can use the $helper to call methods
604 If the Helper module does not contain a C<mk_compclass> method, it
605 will fall back to calling L</render_file>, with an argument of
610 This method in your Helper module is called with C<$helper>
611 which is a L<Catalyst::Helper> object, and whichever other arguments
612 the user added to the command-line. You can use the $helper to call methods
615 If the Helper module does not contain a C<mk_compclass> method, it
616 will fall back to calling L</render_file>, with an argument of
621 This method is called if the user does not supply any of the usual
622 component types C<view>, C<controller>, C<model>. It is passed the
623 C<$helper> object (an instance of L<Catalyst::Helper>), and any other
624 arguments the user typed.
626 There is no fallback for this method.
628 =head1 INTERNAL METHODS
630 These are the methods that the Helper classes can call on the
631 <$helper> object passed to them.
633 =head2 render_file ($file, $path, $vars)
635 Render and create a file from a template in DATA using Template
636 Toolkit. $file is the relevent chunk of the __DATA__ section, $path is
637 the path to the file and $vars is the hashref as expected by
638 L<Template Toolkit|Template>.
640 =head2 get_file ($class, $file)
642 Fetch file contents from the DATA section. This is used internally by
643 L</render_file>. $class is the name of the class to get the DATA
644 section from. __PACKAGE__ or ( caller(0) )[0] might be sensible
649 Create the main application skeleton. This is called by L<catalyst.pl>.
651 =head2 mk_component ($app)
653 This method is called by L<create.pl> to make new components
654 for your application.
656 =head3 mk_dir ($path)
658 Surprisingly, this function makes a directory.
660 =head2 mk_file ($file, $content)
662 Writes content to a file. Called by L</render_file>.
664 =head2 next_test ($test_name)
666 Calculates the name of the next numbered test file and returns it.
667 Don't give the number or the .t suffix for the test name.
671 =head2 get_sharedir_file
673 Method for getting a file out of share/
677 =head2 render_file_contents
679 Process a L<Template::Toolkit> template.
683 =head2 render_sharedir_file
685 Render a template/image file from our share directory
692 The helpers will read author name from /etc/passwd by default.
693 To override, please export the AUTHOR variable.
697 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
698 L<Catalyst::Response>, L<Catalyst>
702 Catalyst Contributors, see Catalyst.pm
706 This library is free software. You can redistribute it and/or modify
707 it under the same terms as Perl itself.