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 } = dir( $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;
97 for ( qw/ _mk_dirs _mk_config _mk_appclass _mk_rootclass _mk_readme
98 _mk_changes _mk_apptest _mk_images _mk_favicon/ ) {
108 for ( qw/ _mk_cgi _mk_fastcgi _mk_server
109 _mk_test _mk_create _mk_information / ) {
111 # probably want to only do this if a DBIC schema is specified, or move it
112 # to C::H::Model::DBIC::Schema
113 # $self->_mk_dbic_deploy;
120 ## not much of this can really be changed, mk_compclass must be left for
126 $self->{author} = $self->{author} = $ENV{'AUTHOR'}
127 || eval { @{ [ getpwuid($<) ] }[6] }
129 $self->{base} ||= dir( $FindBin::Bin, '..' );
130 unless ( $_[0] =~ /^(?:model|view|controller)$/i ) {
133 my $class = "Catalyst::Helper::$helper";
134 eval "require $class";
137 Catalyst::Exception->throw(
138 message => qq/Couldn't load helper "$class", "$@"/ );
141 if ( $class->can('mk_stuff') ) {
142 return 1 unless $class->mk_stuff( $self, @args );
147 my $name = shift || "Missing name for model/view/controller";
150 return 0 if $name =~ /[^\w\:]/;
152 $self->{long_type} = ucfirst $type;
153 $type = 'M' if $type =~ /model/i;
154 $type = 'V' if $type =~ /view/i;
155 $type = 'C' if $type =~ /controller/i;
156 my $appdir = dir( split /\:\:/, $app );
158 dir( $self->{base}, 'lib', $appdir, 'C' );
159 $type = $self->{long_type} unless -d $test_path;
160 $self->{type} = $type;
161 $self->{name} = $name;
162 $self->{class} = "$app\::$type\::$name";
166 dir( $self->{base}, 'lib', $appdir, $type );
168 if ( $name =~ /\:/ ) {
169 my @path = split /\:\:/, $name;
171 $path = dir( $path, @path );
173 $self->mk_dir($path);
174 $file = file( $path, "$file.pm" );
175 $self->{file} = $file;
178 $self->{test_dir} = dir( $self->{base}, 't' );
179 $self->{test} = $self->next_test;
183 my $comp = $self->{long_type};
184 my $class = "Catalyst::Helper::$comp\::$helper";
185 eval "require $class";
188 Catalyst::Exception->throw(
189 message => qq/Couldn't load helper "$class", "$@"/ );
192 ## must be left for back compat! ###################################
193 if ( $class->can('mk_compclass') ) {
194 return 1 unless $class->mk_compclass( $self, @args );
196 else { return 1 unless $self->_mk_compclass }
198 if ( $class->can('mk_comptest') ) {
199 $class->mk_comptest( $self, @args );
201 else { $self->_mk_comptest }
202 ####################################################################
207 return 1 unless $self->_mk_compclass;
215 my ( $self, $dir ) = @_;
217 print qq/ exists "$dir"\n/;
220 if ( mkpath [$dir] ) {
221 print qq/created "$dir"\n/;
225 Catalyst::Exception->throw( message => qq/Couldn't create "$dir", "$!"/ );
229 my ( $self, $file, $content ) = @_;
230 if ( -e $file && -s _ ) {
231 print qq/ exists "$file"\n/;
233 unless ( $self->{'.newfiles'}
235 || $self->{makefile} );
236 if ( $self->{'.newfiles'} ) {
237 if ( my $f = IO::File->new("< $file") ) {
238 my $oldcontent = join( '', (<$f>) );
239 return 0 if $content eq $oldcontent;
245 if ( my $f = IO::File->new("> $file") ) {
248 print qq/created "$file"\n/;
252 Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ );
256 my ( $self, $tname ) = @_;
257 if ($tname) { $tname = "$tname.t" }
259 my $name = $self->{name};
263 $tname = $prefix . '.t';
264 $self->{prefix} = $prefix;
265 $prefix = lc $prefix;
267 $self->{uri} = "/$prefix";
269 my $dir = $self->{test_dir};
270 my $type = lc $self->{type};
272 return file( $dir, "$type\_$tname" );
275 # Do not touch this method, *EVER*, it is needed for back compat.
276 ## addendum: we had to split this method so we could have backwards
277 ## compatability. otherwise, we'd have no way to pass stuff from __DATA__
280 my ( $self, $file, $path, $vars ) = @_;
281 my $template = $self->get_file( ( caller(0) )[0], $file );
282 $self->render_file_contents($template, $path, $vars);
285 sub render_sharedir_file {
286 my ( $self, $file, $path, $vars ) = @_;
287 my $template = $self->get_sharedir_file( $file );
288 die("Cannot get template from $file for $self\n") unless $template;
289 $self->render_file_contents($template, $path, $vars);
292 sub render_file_contents {
293 my ( $self, $template, $path, $vars ) = @_;
295 my $t = Template->new;
296 return 0 unless $template;
298 $t->process( \$template, { %{$self}, %$vars }, \$output )
299 || Catalyst::Exception->throw(
300 message => qq/Couldn't process "$template", / . $t->error() );
301 $self->mk_file( $path, $output );
304 sub _mk_information {
306 print qq/Change to application directory and Run "perl Makefile.PL" to make sure your install is complete\n/;
311 $self->mk_dir( $self->{dir} );
312 $self->mk_dir( $self->{script} );
313 $self->{lib} = dir( $self->{dir}, 'lib' );
314 $self->mk_dir( $self->{lib} );
315 $self->{root} = dir( $self->{dir}, 'root' );
316 $self->mk_dir( $self->{root} );
317 $self->{static} = dir( $self->{root}, 'static' );
318 $self->mk_dir( $self->{static} );
319 $self->{images} = dir( $self->{static}, 'images' );
320 $self->mk_dir( $self->{images} );
321 $self->{t} = dir( $self->{dir}, 't' );
322 $self->mk_dir( $self->{t} );
324 $self->{class} = dir( split( /\:\:/, $self->{name} ) );
325 $self->{mod} = dir( $self->{lib}, $self->{class} );
326 $self->mk_dir( $self->{mod} );
328 if ( $self->{short} ) {
329 $self->{m} = dir( $self->{mod}, 'M' );
330 $self->mk_dir( $self->{m} );
331 $self->{v} = dir( $self->{mod}, 'V' );
332 $self->mk_dir( $self->{v} );
333 $self->{c} = dir( $self->{mod}, 'C' );
334 $self->mk_dir( $self->{c} );
337 $self->{m} = dir( $self->{mod}, 'Model' );
338 $self->mk_dir( $self->{m} );
339 $self->{v} = dir( $self->{mod}, 'View' );
340 $self->mk_dir( $self->{v} );
341 $self->{c} = dir( $self->{mod}, 'Controller' );
342 $self->mk_dir( $self->{c} );
344 my $name = $self->{name};
346 $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root";
347 $self->{base} = dir( $self->{dir} )->absolute;
352 my $mod = $self->{mod};
353 $self->render_sharedir_file( file('lib', 'MyApp.pm.tt'), "$mod.pm" );
358 $self->render_sharedir_file( file('lib', 'MyApp', 'Controller', 'Root.pm.tt'),
359 file( $self->{c}, "Root.pm" ) );
364 $self->{path} = dir( 'lib', split( '::', $self->{name} ) );
365 $self->{path} .= '.pm';
366 my $dir = $self->{dir};
367 $self->render_sharedir_file( 'Makefile.PL.tt', file($dir, "Makefile.PL") );
369 if ( $self->{makefile} ) {
371 # deprecate the old Build.PL file when regenerating Makefile.PL
372 $self->_deprecate_file(
373 file( $self->{dir}, 'Build.PL' ) );
379 my $dir = $self->{dir};
380 my $appprefix = $self->{appprefix};
381 $self->render_sharedir_file( 'myapp.conf.tt',
382 file( $dir, "$appprefix.conf" ) );
387 my $dir = $self->{dir};
388 $self->render_sharedir_file( 'README.tt', file($dir, "README") );
393 my $dir = $self->{dir};
394 my $time = strftime('%Y-%m-%d %H:%M:%S', localtime time);
395 $self->render_sharedir_file( 'Changes.tt', file($dir, "Changes", { time => $time } );
401 $self->render_sharedir_file( file('t', '01app.t.tt'), file($t, "01app.t") );
402 $self->render_sharedir_file( file('t', '02pod.t.tt'), file($t, "02pod.t") );
403 $self->render_sharedir_file( file('t', '03podcoverage.t.tt'), file($t, "03podcoverage.t") );
408 my $script = $self->{script};
409 my $appprefix = $self->{appprefix};
410 $self->render_sharedir_file( file('script', 'myapp_cgi.pl.tt'), file($script,"$appprefix\_cgi.pl") );
411 chmod 0700, file($script,"$appprefix\_cgi.pl");
416 my $script = $self->{script};
417 my $appprefix = $self->{appprefix};
418 $self->render_sharedir_file( file('script', 'myapp_fastcgi.pl.tt'), file($script, "$appprefix\_fastcgi.pl") );
419 chmod 0700, file($script, "$appprefix\_fastcgi.pl");
424 my $script = $self->{script};
425 my $appprefix = $self->{appprefix};
426 $self->render_sharedir_file( file('script', 'myapp_server.pl.tt'), file($script, "$appprefix\_server.pl") );
427 chmod 0700, file($script, "$appprefix\_server.pl");
432 my $script = $self->{script};
433 my $appprefix = $self->{appprefix};
434 $self->render_sharedir_file( file('script', 'myapp_test.pl.tt'), file($script, "$appprefix\_test.pl") );
435 chmod 0700, file($script, "$appprefix\_test.pl");
440 my $script = $self->{script};
441 my $appprefix = $self->{appprefix};
442 $self->render_sharedir_file( file('script', 'myapp_create.pl.tt'), file($script, "$appprefix\_create.pl") );
443 chmod 0700, file($script, "$appprefix\_create.pl");
448 my $file = $self->{file};
449 return $self->render_sharedir_file( file('lib', 'Helper', 'compclass.pm.tt'), $file );
454 my $test = $self->{test};
455 $self->render_sharedir_file( file('t', 'comptest.tt'), $test ); ## wtf do i rename this to?
460 my $images = $self->{images};
462 qw/catalyst_logo btn_120x50_built btn_120x50_built_shadow
463 btn_120x50_powered btn_120x50_powered_shadow btn_88x31_built
464 btn_88x31_built_shadow btn_88x31_powered btn_88x31_powered_shadow/;
465 for my $name (@images) {
466 my $image = $self->get_sharedir_file("root", "static", "images", "$name.png.bin");
467 $self->mk_file( file( $images, "$name.png" ), $image );
473 my $root = $self->{root};
474 my $favicon = $self->get_sharedir_file( 'root', 'favicon.ico.bin' );
475 my $dest = dir( $root, "favicon.ico" );
476 $self->mk_file( $dest, $favicon );
480 sub _mk_dbic_deploy {
482 my $script = $self->{script};
483 my $appprefix = $self->{appprefix};
484 $self->render_sharedir_file( file('script', 'myapp_deploy_schema.pl.tt'), file($script, "$appprefix\_deploy_schema.pl") );
485 chmod 0700, file($script, "$appprefix\_deploy_schema.pl");
488 sub _deprecate_file {
489 my ( $self, $file ) = @_;
492 if ( my $f = IO::File->new("< $file") ) {
493 $oldcontent = join( '', (<$f>) );
495 my $newfile = $file . '.deprecated';
496 if ( my $f = IO::File->new("> $newfile") ) {
498 print $f $oldcontent;
499 print qq/created "$newfile"\n/;
501 print qq/removed "$file"\n/;
504 Catalyst::Exception->throw(
505 message => qq/Couldn't create "$file", "$!"/ );
511 This module is used by B<catalyst.pl> to create a set of scripts for a
512 new catalyst application. The scripts each contain documentation and
513 will output help on how to use them if called incorrectly or in some
514 cases, with no arguments.
516 It also provides some useful methods for a Helper module to call when
517 creating a component. See L</METHODS>.
523 Used to create new components for a catalyst application at the
528 The catalyst test server, starts an HTTPD which outputs debugging to
531 =head2 _deploy_dbic.pl
533 Deploy a L<DBIx::Class> schema to the database of your choice.
537 A script for running tests from the command-line.
541 Run your application as a CGI.
545 Run the application as a fastcgi app. Either by hand, or call this
546 from FastCgiServer in your http server config.
550 The L</_create.pl> script creates application components using Helper
551 modules. The Catalyst team provides a good number of Helper modules
552 for you to use. You can also add your own.
554 Helpers are classes that provide two methods.
556 * mk_compclass - creates the Component class
557 * mk_comptest - creates the Component test
559 So when you call C<scripts/myapp_create.pl view MyView TT>, create
560 will try to execute Catalyst::Helper::View::TT->mk_compclass and
561 Catalyst::Helper::View::TT->mk_comptest.
563 See L<Catalyst::Helper::View::TT> and
564 L<Catalyst::Helper::Model::DBIC::Schema> for examples.
566 All helper classes should be under one of the following namespaces.
568 Catalyst::Helper::Model::
569 Catalyst::Helper::View::
570 Catalyst::Helper::Controller::
572 =head2 COMMON HELPERS
578 L<Catalyst::Helper::Model::DBIC::Schema> - DBIx::Class models
582 L<Catalyst::Helper::View::TT> - Template Toolkit view
586 L<Catalyst::Helper::Model::LDAP>
590 L<Catalyst::Helper::Model::Adaptor> - wrap any class into a Catalyst model
596 The helpers will read author name from /etc/passwd by default. + To override, please export the AUTHOR variable.
602 This method in your Helper module is called with C<$helper>
603 which is a L<Catalyst::Helper> object, and whichever other arguments
604 the user added to the command-line. You can use the $helper to call methods
607 If the Helper module does not contain a C<mk_compclass> method, it
608 will fall back to calling L</render_file>, with an argument of
613 This method in your Helper module is called with C<$helper>
614 which is a L<Catalyst::Helper> object, and whichever other arguments
615 the user added to the command-line. You can use the $helper to call methods
618 If the Helper module does not contain a C<mk_compclass> method, it
619 will fall back to calling L</render_file>, with an argument of
624 This method is called if the user does not supply any of the usual
625 component types C<view>, C<controller>, C<model>. It is passed the
626 C<$helper> object (an instance of L<Catalyst::Helper>), and any other
627 arguments the user typed.
629 There is no fallback for this method.
631 =head1 INTERNAL METHODS
633 These are the methods that the Helper classes can call on the
634 <$helper> object passed to them.
636 =head2 render_file ($file, $path, $vars)
638 Render and create a file from a template in DATA using Template
639 Toolkit. $file is the relevent chunk of the __DATA__ section, $path is
640 the path to the file and $vars is the hashref as expected by
641 L<Template Toolkit|Template>.
643 =head2 get_file ($class, $file)
645 Fetch file contents from the DATA section. This is used internally by
646 L</render_file>. $class is the name of the class to get the DATA
647 section from. __PACKAGE__ or ( caller(0) )[0] might be sensible
652 Create the main application skeleton. This is called by L<catalyst.pl>.
654 =head2 mk_component ($app)
656 This method is called by L<create.pl> to make new components
657 for your application.
659 =head3 mk_dir ($path)
661 Surprisingly, this function makes a directory.
663 =head2 mk_file ($file, $content)
665 Writes content to a file. Called by L</render_file>.
667 =head2 next_test ($test_name)
669 Calculates the name of the next numbered test file and returns it.
670 Don't give the number or the .t suffix for the test name.
674 =head2 get_sharedir_file
676 Method for getting a file out of share/
680 =head2 render_file_contents
682 Process a L<Template::Toolkit> template.
686 =head2 render_sharedir_file
688 Render a template/image file from our share directory
695 The helpers will read author name from /etc/passwd by default.
696 To override, please export the AUTHOR variable.
700 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
701 L<Catalyst::Response>, L<Catalyst>
705 Catalyst Contributors, see Catalyst.pm
709 This library is free software. You can redistribute it and/or modify
710 it under the same terms as Perl itself.