5338cd03d21c72f2510a6d165422417812e2a04d
[catagits/Catalyst-Devel.git] / lib / Catalyst / Helper.pm
1 package Catalyst::Helper;
2 use Moose;
3 use Config;
4 use File::Spec;
5 use File::Spec::Unix;
6 use File::Path;
7 use FindBin;
8 use IO::File;
9 use POSIX 'strftime';
10 use Template;
11 use Catalyst::Devel;
12 use Catalyst::Utils;
13 use Catalyst::Exception;
14 use Path::Class qw/dir file/;
15 use File::ShareDir qw/dist_dir/;
16 use YAML::Tiny;
17 use namespace::autoclean;
18
19 with 'MooseX::Emulate::Class::Accessor::Fast';
20
21 # Change Catalyst/Devel.pm also
22 our $VERSION = '1.28';
23
24 my %cache;
25
26 =head1 NAME
27
28 Catalyst::Helper - Bootstrap a Catalyst application
29
30 =head1 SYNOPSIS
31
32   catalyst.pl <myappname>
33
34 =cut
35
36 sub get_sharedir_file {
37     my ($self, @filename) = @_;
38     my $dist_dir;
39     if (exists $ENV{CATALYST_DEVEL_SHAREDIR}) {
40         $dist_dir = $ENV{CATALYST_DEVEL_SHAREDIR};
41     }
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?
45         $dist_dir = 'share';
46     }
47     else {
48         $dist_dir = dist_dir('Catalyst-Devel');
49     }
50     my $file = file( $dist_dir, @filename);
51     Carp::confess("Cannot find $file") unless -r $file;
52     my $contents = $file->slurp;
53     return $contents;
54 }
55
56 # Do not touch this method, *EVER*, it is needed for back compat.
57 sub get_file {
58     my ( $self, $class, $file ) = @_;
59     unless ( $cache{$class} ) {
60         local $/;
61         $cache{$class} = eval "package $class; <DATA>";
62     }
63     my $data = $cache{$class};
64     Carp::confess("Could not get data from __DATA__ segment for $class")
65         unless $data;
66     my @files = split /^__(.+)__\r?\n/m, $data;
67     shift @files;
68     while (@files) {
69         my ( $name, $content ) = splice @files, 0, 2;
70         return $content if $name eq $file;
71     }
72     return 0;
73 }
74
75
76 sub mk_app {
77     my ( $self, $name ) = @_;
78
79     # Needs to be here for PAR
80     require Catalyst;
81
82     if($name eq '.') {
83         if(!-e 'META.yml') {
84             system perl => 'Makefile.PL'
85                 and Catalyst::Exception->throw(message => q(
86                     Failed to run "perl Makefile.PL".
87                 ));
88         }
89
90         $name = YAML::Tiny->read('META.yml')->[0]->{'name'};
91         $name =~ s/-/::/g;
92         $self->{dir} = '.';
93     }
94
95     if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) {
96         warn "Error: Invalid application name.\n";
97         return 0;
98     }
99
100
101     if(!defined $self->{'dir'}) {
102         $self->{dir} = $name;
103         $self->{dir} =~ s/\:\:/-/g;
104     }
105
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          } = $self->{author} = $ENV{'AUTHOR'}
116       || eval { @{ [ getpwuid($<) ] }[6] }
117       || 'Catalyst developer';
118
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;
122
123     if ($gen_app) {
124         for ( qw/ _mk_dirs _mk_config _mk_appclass _mk_rootclass _mk_readme
125               _mk_changes _mk_apptest _mk_images _mk_favicon/ ) {
126             
127             $self->$_;
128         }
129     }
130     if ($gen_makefile) {
131         $self->_mk_makefile;
132     }
133     if ($gen_scripts) {
134         for ( qw/ _mk_cgi _mk_fastcgi _mk_server 
135                   _mk_test _mk_create _mk_information
136         / ) {
137               $self->$_;
138         }
139     }
140     return $self->{dir};
141 }
142
143 ## not much of this can really be changed, mk_compclass must be left for 
144 ## backcompat
145 sub mk_component {
146     my $self = shift;
147     my $app  = shift;
148     $self->{app} = $app;
149     $self->{author} = $self->{author} = $ENV{'AUTHOR'}
150       || eval { @{ [ getpwuid($<) ] }[6] }
151       || 'A clever guy';
152     $self->{base} ||= dir( $FindBin::Bin, '..' );
153     unless ( $_[0] =~ /^(?:model|view|controller)$/i ) {
154         my $helper = shift;
155         my @args   = @_;
156         my $class  = "Catalyst::Helper::$helper";
157         eval "require $class";
158
159         if ($@) {
160             Catalyst::Exception->throw(
161                 message => qq/Couldn't load helper "$class", "$@"/ );
162         }
163
164         if ( $class->can('mk_stuff') ) {
165             return 1 unless $class->mk_stuff( $self, @args );
166         }
167     }
168     else {
169         my $type   = shift;
170         my $name   = shift || "Missing name for model/view/controller";
171         my $helper = shift;
172         my @args   = @_;
173        return 0 if $name =~ /[^\w\:]/;
174         $type              = lc $type;
175         $self->{long_type} = ucfirst $type;
176         $type              = 'M' if $type =~ /model/i;
177         $type              = 'V' if $type =~ /view/i;
178         $type              = 'C' if $type =~ /controller/i;
179         my $appdir = dir( split /\:\:/, $app );
180         my $test_path =
181           dir( $self->{base}, 'lib', $appdir, 'C' );
182         $type = $self->{long_type} unless -d $test_path;
183         $self->{type}  = $type;
184         $self->{name}  = $name;
185         $self->{class} = "$app\::$type\::$name";
186
187         # Class
188         my $path =
189           dir( $self->{base}, 'lib', $appdir, $type );
190         my $file = $name;
191         if ( $name =~ /\:/ ) {
192             my @path = split /\:\:/, $name;
193             $file = pop @path;
194             $path = dir( $path, @path );
195         }
196         $self->mk_dir($path);
197         $file = file( $path, "$file.pm" );
198         $self->{file} = $file;
199
200         # Test
201         $self->{test_dir} = dir( $self->{base}, 't' );
202         $self->{test}     = $self->next_test;
203
204         # Helper
205         if ($helper) {
206             my $comp  = $self->{long_type};
207             my $class = "Catalyst::Helper::$comp\::$helper";
208             eval "require $class";
209
210             if ($@) {
211                 Catalyst::Exception->throw(
212                     message => qq/Couldn't load helper "$class", "$@"/ );
213             }
214
215             if ( $class->can('mk_compclass') ) {
216                 return 1 unless $class->mk_compclass( $self, @args );
217             }
218             else {
219                 return 1 unless $self->_mk_compclass
220             }
221
222             if ( $class->can('mk_comptest') ) {
223                 $class->mk_comptest( $self, @args );
224             }
225             else {
226                 $self->_mk_comptest
227             }
228         }
229
230         # Fallback
231         else {
232             return 1 unless $self->_mk_compclass;
233             $self->_mk_comptest;
234         }
235     }
236     return 1;
237 }
238
239 sub mk_dir {
240     my ( $self, $dir ) = @_;
241     if ( -d $dir ) {
242         print qq/ exists "$dir"\n/;
243         return 0;
244     }
245     if ( mkpath [$dir] ) {
246         print qq/created "$dir"\n/;
247         return 1;
248     }
249
250     Catalyst::Exception->throw( message => qq/Couldn't create "$dir", "$!"/ );
251 }
252
253 sub mk_file {
254     my ( $self, $file, $content ) = @_;
255     if ( -e $file && -s _ ) {
256         print qq/ exists "$file"\n/;
257         return 0
258           unless ( $self->{'.newfiles'}
259             || $self->{scripts}
260             || $self->{makefile} );
261         if ( $self->{'.newfiles'} ) {
262             if ( my $f = IO::File->new("< $file") ) {
263                 my $oldcontent = join( '', (<$f>) );
264                 return 0 if $content eq $oldcontent;
265             }
266             $file .= '.new';
267         }
268     }
269     
270     if ( my $f = IO::File->new("> $file") ) {
271         binmode $f;
272         print $f $content;
273         print qq/created "$file"\n/;
274         return 1;
275     }
276
277     Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ );
278 }
279
280 sub next_test {
281     my ( $self, $tname ) = @_;
282     if ($tname) { $tname = "$tname.t" }
283     else {
284         my $name   = $self->{name};
285         my $prefix = $name;
286         $prefix =~ s/::/-/g;
287         $prefix         = $prefix;
288         $tname          = $prefix . '.t';
289         $self->{prefix} = $prefix;
290         $prefix         = lc $prefix;
291         $prefix =~ s/-/\//g;
292         $self->{uri} = "/$prefix";
293     }
294     my $dir  = $self->{test_dir};
295     my $type = lc $self->{type};
296     $self->mk_dir($dir);
297     return file( $dir, "$type\_$tname" );
298 }
299
300 # Do not touch this method, *EVER*, it is needed for back compat.
301 ## addendum: we had to split this method so we could have backwards
302 ## compatability.  otherwise, we'd have no way to pass stuff from __DATA__
303
304 sub render_file {
305     my ( $self, $file, $path, $vars ) = @_;
306     my $template = $self->get_file( ( caller(0) )[0], $file );
307     $self->render_file_contents($template, $path, $vars);
308 }
309
310 sub render_sharedir_file {
311     my ( $self, $file, $path, $vars ) = @_;
312     my $template = $self->get_sharedir_file( $file );
313     die("Cannot get template from $file for $self\n") unless $template;
314     $self->render_file_contents($template, $path, $vars);
315 }
316
317 sub render_file_contents {
318     my ( $self, $template, $path, $vars ) = @_;
319     $vars ||= {};
320     my $t = Template->new;
321     return 0 unless $template;
322     my $output;
323     $t->process( \$template, { %{$self}, %$vars }, \$output )
324       || Catalyst::Exception->throw(
325         message => qq/Couldn't process "$template", / . $t->error() );
326     $self->mk_file( $path, $output );
327 }
328
329 sub _mk_information {
330     my $self = shift;
331     print qq/Change to application directory and Run "perl Makefile.PL" to make sure your install is complete\n/;
332 }
333
334 sub _mk_dirs {
335     my $self = shift;
336     $self->mk_dir( $self->{dir} );
337     $self->mk_dir( $self->{script} );
338     $self->{lib} = dir( $self->{dir}, 'lib' );
339     $self->mk_dir( $self->{lib} );
340     $self->{root} = dir( $self->{dir}, 'root' );
341     $self->mk_dir( $self->{root} );
342     $self->{static} = dir( $self->{root}, 'static' );
343     $self->mk_dir( $self->{static} );
344     $self->{images} = dir( $self->{static}, 'images' );
345     $self->mk_dir( $self->{images} );
346     $self->{t} = dir( $self->{dir}, 't' );
347     $self->mk_dir( $self->{t} );
348
349     $self->{class} = dir( split( /\:\:/, $self->{name} ) );
350     $self->{mod} = dir( $self->{lib}, $self->{class} );
351     $self->mk_dir( $self->{mod} );
352
353     if ( $self->{short} ) {
354         $self->{m} = dir( $self->{mod}, 'M' );
355         $self->mk_dir( $self->{m} );
356         $self->{v} = dir( $self->{mod}, 'V' );
357         $self->mk_dir( $self->{v} );
358         $self->{c} = dir( $self->{mod}, 'C' );
359         $self->mk_dir( $self->{c} );
360     }
361     else {
362         $self->{m} = dir( $self->{mod}, 'Model' );
363         $self->mk_dir( $self->{m} );
364         $self->{v} = dir( $self->{mod}, 'View' );
365         $self->mk_dir( $self->{v} );
366         $self->{c} = dir( $self->{mod}, 'Controller' );
367         $self->mk_dir( $self->{c} );
368     }
369     my $name = $self->{name};
370     $self->{rootname} =
371       $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root";
372     $self->{base} = dir( $self->{dir} )->absolute;
373 }
374
375 sub _mk_appclass {
376     my $self = shift;
377     my $mod  = $self->{mod};
378     $self->render_sharedir_file( file('lib', 'MyApp.pm.tt'), "$mod.pm" );
379 }
380
381 sub _mk_rootclass {
382     my $self = shift;
383     $self->render_sharedir_file( file('lib', 'MyApp', 'Controller', 'Root.pm.tt'),
384         file( $self->{c}, "Root.pm" ) );
385 }
386
387 sub _mk_makefile {
388     my $self = shift;
389     $self->{path} = dir( 'lib', split( '::', $self->{name} ) );
390     $self->{path} .= '.pm';
391     my $dir = $self->{dir};
392     $self->render_sharedir_file( 'Makefile.PL.tt', file($dir, "Makefile.PL") );
393
394     if ( $self->{makefile} ) {
395
396         # deprecate the old Build.PL file when regenerating Makefile.PL
397         $self->_deprecate_file(
398             file( $self->{dir}, 'Build.PL' ) );
399     }
400 }
401
402 sub _mk_config {
403     my $self      = shift;
404     my $dir       = $self->{dir};
405     my $appprefix = $self->{appprefix};
406     $self->render_sharedir_file( 'myapp.conf.tt',
407         file( $dir, "$appprefix.conf" ) );
408 }
409
410 sub _mk_readme {
411     my $self = shift;
412     my $dir  = $self->{dir};
413     $self->render_sharedir_file( 'README.tt', file($dir, "README") );
414 }
415
416 sub _mk_changes {
417     my $self = shift;
418     my $dir  = $self->{dir};
419     my $time = strftime('%Y-%m-%d %H:%M:%S', localtime time);
420     $self->render_sharedir_file( 'Changes.tt', file($dir, "Changes"), { time => $time } );
421 }
422
423 sub _mk_apptest {
424     my $self = shift;
425     my $t    = $self->{t};
426     $self->render_sharedir_file( file('t', '01app.t.tt'),         file($t, "01app.t") );
427     $self->render_sharedir_file( file('t', '02pod.t.tt'),         file($t, "02pod.t") );
428     $self->render_sharedir_file( file('t', '03podcoverage.t.tt'), file($t, "03podcoverage.t") );
429 }
430
431 sub _mk_cgi {
432     my $self      = shift;
433     my $script    = $self->{script};
434     my $appprefix = $self->{appprefix};
435     $self->render_sharedir_file( file('script', 'myapp_cgi.pl.tt'), file($script,"$appprefix\_cgi.pl") );
436     chmod 0700, file($script,"$appprefix\_cgi.pl");
437 }
438
439 sub _mk_fastcgi {
440     my $self      = shift;
441     my $script    = $self->{script};
442     my $appprefix = $self->{appprefix};
443     $self->render_sharedir_file( file('script', 'myapp_fastcgi.pl.tt'), file($script, "$appprefix\_fastcgi.pl") );
444     chmod 0700, file($script, "$appprefix\_fastcgi.pl");
445 }
446
447 sub _mk_server {
448     my $self      = shift;
449     my $script    = $self->{script};
450     my $appprefix = $self->{appprefix};
451     $self->render_sharedir_file( file('script', 'myapp_server.pl.tt'), file($script, "$appprefix\_server.pl") );
452     chmod 0700, file($script, "$appprefix\_server.pl");
453 }
454
455 sub _mk_test {
456     my $self      = shift;
457     my $script    = $self->{script};
458     my $appprefix = $self->{appprefix};
459     $self->render_sharedir_file( file('script', 'myapp_test.pl.tt'), file($script, "$appprefix\_test.pl") );
460     chmod 0700, file($script, "$appprefix\_test.pl");
461 }
462
463 sub _mk_create {
464     my $self      = shift;
465     my $script    = $self->{script};
466     my $appprefix = $self->{appprefix};
467     $self->render_sharedir_file( file('script', 'myapp_create.pl.tt'), file($script, "$appprefix\_create.pl") );
468     chmod 0700, file($script, "$appprefix\_create.pl");
469 }
470
471 sub _mk_compclass {
472     my $self = shift;
473     my $file = $self->{file};
474     return $self->render_sharedir_file( file('lib', 'Helper', 'compclass.pm.tt'), $file );
475 }
476
477 sub _mk_comptest {
478     my $self = shift;
479     my $test = $self->{test};
480     $self->render_sharedir_file( file('t', 'comptest.tt'), $test );  ## wtf do i rename this to?
481 }
482
483 sub _mk_images {
484     my $self   = shift;
485     my $images = $self->{images};
486     my @images =
487       qw/catalyst_logo btn_120x50_built btn_120x50_built_shadow
488       btn_120x50_powered btn_120x50_powered_shadow btn_88x31_built
489       btn_88x31_built_shadow btn_88x31_powered btn_88x31_powered_shadow/;
490     for my $name (@images) {
491         my $image = $self->get_sharedir_file("root", "static", "images", "$name.png.bin");
492         $self->mk_file( file( $images, "$name.png" ), $image );
493     }
494 }
495
496 sub _mk_favicon {
497     my $self    = shift;
498     my $root    = $self->{root};
499     my $favicon = $self->get_sharedir_file( 'root', 'favicon.ico.bin' );
500     my $dest = dir( $root, "favicon.ico" );
501     $self->mk_file( $dest, $favicon );
502
503 }
504
505 sub _deprecate_file {
506     my ( $self, $file ) = @_;
507     if ( -e $file ) {
508         my ($f, $oldcontent);
509         if ( $f = IO::File->new("< $file") ) {
510             $oldcontent = join( '', (<$f>) );
511         }
512         my $newfile = $file . '.deprecated';
513         if ( $f = IO::File->new("> $newfile") ) {
514             binmode $f;
515             print $f $oldcontent;
516             print qq/created "$newfile"\n/;
517             unlink $file;
518             print qq/removed "$file"\n/;
519             return 1;
520         }
521         Catalyst::Exception->throw(
522             message => qq/Couldn't create "$file", "$!"/ );
523     }
524 }
525
526 =head1 DESCRIPTION
527
528 This module is used by B<catalyst.pl> to create a set of scripts for a
529 new catalyst application. The scripts each contain documentation and
530 will output help on how to use them if called incorrectly or in some
531 cases, with no arguments.
532
533 It also provides some useful methods for a Helper module to call when
534 creating a component. See L</METHODS>.
535
536 =head1 SCRIPTS
537
538 =head2 _create.pl
539
540 Used to create new components for a catalyst application at the
541 development stage.
542
543 =head2 _server.pl
544
545 The catalyst test server, starts an HTTPD which outputs debugging to
546 the terminal.
547
548 =head2 _test.pl
549
550 A script for running tests from the command-line.
551
552 =head2 _cgi.pl
553
554 Run your application as a CGI.
555
556 =head2 _fastcgi.pl
557
558 Run the application as a fastcgi app. Either by hand, or call this
559 from FastCgiServer in your http server config.
560
561 =head1 HELPERS
562
563 The L</_create.pl> script creates application components using Helper
564 modules. The Catalyst team provides a good number of Helper modules
565 for you to use. You can also add your own.
566
567 Helpers are classes that provide two methods.
568
569     * mk_compclass - creates the Component class
570     * mk_comptest  - creates the Component test
571
572 So when you call C<scripts/myapp_create.pl view MyView TT>, create
573 will try to execute Catalyst::Helper::View::TT->mk_compclass and
574 Catalyst::Helper::View::TT->mk_comptest.
575
576 See L<Catalyst::Helper::View::TT> and
577 L<Catalyst::Helper::Model::DBIC::Schema> for examples.
578
579 All helper classes should be under one of the following namespaces.
580
581     Catalyst::Helper::Model::
582     Catalyst::Helper::View::
583     Catalyst::Helper::Controller::
584
585 =head2 COMMON HELPERS
586
587 =over
588
589 =item *
590
591 L<Catalyst::Helper::Model::DBIC::Schema> - DBIx::Class models
592
593 =item *
594
595 L<Catalyst::Helper::View::TT> - Template Toolkit view
596
597 =item *
598
599 L<Catalyst::Helper::Model::LDAP>
600
601 =item *
602
603 L<Catalyst::Helper::Model::Adaptor> - wrap any class into a Catalyst model
604
605 =back
606
607 =head3 NOTE
608
609 The helpers will read author name from /etc/passwd by default.
610 To override, please export the AUTHOR variable.
611
612 =head1 METHODS
613
614 =head2 mk_compclass
615
616 This method in your Helper module is called with C<$helper>
617 which is a L<Catalyst::Helper> object, and whichever other arguments
618 the user added to the command-line. You can use the $helper to call methods
619 described below.
620
621 If the Helper module does not contain a C<mk_compclass> method, it
622 will fall back to calling L</render_file>, with an argument of
623 C<compclass>.
624
625 =head2 mk_comptest
626
627 This method in your Helper module is called with C<$helper>
628 which is a L<Catalyst::Helper> object, and whichever other arguments
629 the user added to the command-line. You can use the $helper to call methods
630 described below.
631
632 If the Helper module does not contain a C<mk_compclass> method, it
633 will fall back to calling L</render_file>, with an argument of
634 C<comptest>.
635
636 =head2 mk_stuff
637
638 This method is called if the user does not supply any of the usual
639 component types C<view>, C<controller>, C<model>. It is passed the
640 C<$helper> object (an instance of L<Catalyst::Helper>), and any other
641 arguments the user typed.
642
643 There is no fallback for this method.
644
645 =head1 INTERNAL METHODS
646
647 These are the methods that the Helper classes can call on the
648 <$helper> object passed to them.
649
650 =head2 render_file ($file, $path, $vars)
651
652 Render and create a file from a template in DATA using Template
653 Toolkit. $file is the relevent chunk of the __DATA__ section, $path is
654 the path to the file and $vars is the hashref as expected by
655 L<Template Toolkit|Template>.
656
657 =head2 get_file ($class, $file)
658
659 Fetch file contents from the DATA section. This is used internally by
660 L</render_file>.  $class is the name of the class to get the DATA
661 section from.  __PACKAGE__ or ( caller(0) )[0] might be sensible
662 values for this.
663
664 =head2 mk_app
665
666 Create the main application skeleton. This is called by L<catalyst.pl>.
667
668 =head2 mk_component ($app)
669
670 This method is called by L<create.pl> to make new components
671 for your application.
672
673 =head2 mk_dir ($path)
674
675 Surprisingly, this function makes a directory.
676
677 =head2 mk_file ($file, $content)
678
679 Writes content to a file. Called by L</render_file>.
680
681 =head2 next_test ($test_name)
682
683 Calculates the name of the next numbered test file and returns it.
684 Don't give the number or the .t suffix for the test name.
685
686 =cut
687
688 =head2 get_sharedir_file
689
690 Method for getting a file out of share/
691
692 =cut
693
694 =head2 render_file_contents
695
696 Process a L<Template::Toolkit> template.
697
698 =cut
699
700 =head2 render_sharedir_file
701
702 Render a template/image file from our share directory
703
704 =cut
705
706 =head1 NOTE
707
708 The helpers will read author name from /etc/passwd by default.
709 To override, please export the AUTHOR variable.
710
711 =head1 SEE ALSO
712
713 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
714 L<Catalyst::Response>, L<Catalyst>
715
716 =head1 AUTHORS
717
718 Catalyst Contributors, see Catalyst.pm
719
720 =head1 LICENSE
721
722 This library is free software. You can redistribute it and/or modify
723 it under the same terms as Perl itself.
724
725 =cut
726
727 1;
728