fixed multiple action problem
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Helper.pm
CommitLineData
fc7ec1d9 1package Catalyst::Helper;
2
3use strict;
4use base 'Class::Accessor::Fast';
f1d0b7ea 5use Config;
fc7ec1d9 6use File::Spec;
7use File::Path;
8use IO::File;
9use FindBin;
10
11=head1 NAME
12
13Catalyst::Helper - Bootstrap a Catalyst application
14
15=head1 SYNOPSIS
16
17See L<Catalyst::Manual::Intro>
18
19=head1 DESCRIPTION
20
21Bootstrap a Catalyst application.
22
23=head2 METHODS
24
25=head3 mk_app
26
27=cut
28
29sub mk_app {
30 my ( $self, $name ) = @_;
31 return 0 if $name =~ /[^\w\:]/;
32 $self->{name} = $name;
33 $self->{dir} = $name;
34 $self->{dir} =~ s/\:\:/-/g;
35 $self->_mk_dirs;
36 $self->_mk_appclass;
37 $self->_mk_makefile;
91864987 38 $self->_mk_readme;
39 $self->_mk_changes;
fc7ec1d9 40 $self->_mk_apptest;
bc024080 41 $self->_mk_cgi;
cb8d90e5 42 $self->_mk_fcgi;
fc7ec1d9 43 $self->_mk_server;
44 $self->_mk_test;
45 $self->_mk_create;
46 return 1;
47}
48
ad41e777 49=head3 mk_component
50
51=cut
52
53sub mk_component {
b5524568 54 my $self = shift;
55 my $app = shift;
56 $self->{app} = $app;
57 $self->{base} = File::Spec->catdir( $FindBin::Bin, '..' );
58 unless ( $_[0] =~ /^model|m|view|v|controller|c\$/i ) {
59 my $helper = shift;
60 my @args = @_;
61 my $class = "Catalyst::Helper::$helper";
ad41e777 62 eval "require $class";
63 die qq/Couldn't load helper "$class", "$@"/ if $@;
b5524568 64 if ( $class->can('mk_stuff') ) {
65 return 1 unless $class->mk_stuff( $self, @args );
ad41e777 66 }
ad41e777 67 }
ad41e777 68 else {
b5524568 69 my $type = shift;
70 my $name = shift;
71 my $helper = shift;
72 my @args = @_;
73 return 0 if $name =~ /[^\w\:]/;
74 $type = 'M' if $type =~ /model|m/i;
75 $type = 'V' if $type =~ /view|v/i;
76 $type = 'C' if $type =~ /controller|c/i;
77 $self->{type} = $type;
78 $self->{name} = $name;
79 $self->{class} = "$app\::$type\::$name";
80
81 # Class
82 my $appdir = File::Spec->catdir( split /\:\:/, $app );
83 my $path =
84 File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type );
85 my $file = $name;
86 if ( $name =~ /\:/ ) {
87 my @path = split /\:\:/, $name;
88 $file = pop @path;
89 $path = File::Spec->catdir( $path, @path );
90 mkpath $path;
91 }
92 $file = File::Spec->catfile( $path, "$file.pm" );
93 $self->{file} = $file;
94
95 # Test
96 $self->{test_dir} = File::Spec->catdir( $FindBin::Bin, '..', 't' );
97 $self->{test} = $self->next_test;
98
99 # Helper
100 if ($helper) {
101 my $comp = 'Model';
102 $comp = 'View' if $type eq 'V';
103 $comp = 'Controller' if $type eq 'C';
104 my $class = "Catalyst::Helper::$comp\::$helper";
105 eval "require $class";
106 die qq/Couldn't load helper "$class", "$@"/ if $@;
107 if ( $class->can('mk_compclass') ) {
108 return 1 unless $class->mk_compclass( $self, @args );
109 }
110 else { return 1 unless $self->_mk_compclass }
111
112 if ( $class->can('mk_comptest') ) {
113 $class->mk_comptest( $self, @args );
114 }
115 else { $self->_mk_comptest }
116 }
117
118 # Fallback
119 else {
120 return 1 unless $self->_mk_compclass;
121 $self->_mk_comptest;
122 }
ad41e777 123 }
124 return 1;
125}
126
127=head3 mk_dir
128
129=cut
130
131sub mk_dir {
132 my ( $self, $dir ) = @_;
133 if ( -d $dir ) {
134 print qq/ exists "$dir"\n/;
135 return 0;
136 }
137 if ( mkpath $dir) {
138 print qq/created "$dir"\n/;
139 return 1;
140 }
141 die qq/Couldn't create "$dir", "$!"/;
142}
143
144=head3 mk_file
145
146=cut
147
148sub mk_file {
149 my ( $self, $file, $content ) = @_;
150 if ( -e $file ) {
151 print qq/ exists "$file"\n/;
152 return 0;
153 }
154 if ( my $f = IO::File->new("> $file") ) {
155 print $f $content;
156 print qq/created "$file"\n/;
157 return 1;
158 }
159 die qq/Couldn't create "$file", "$!"/;
160}
161
162=head3 next_test
163
164=cut
165
166sub next_test {
167 my ( $self, $tname ) = @_;
3cb1db8c 168 if ($tname) { $tname = "$tname.t" }
ad41e777 169 else {
170 my $name = $self->{name};
ad41e777 171 my $prefix = $name;
172 $prefix =~ s/::/_/g;
173 $prefix = lc $prefix;
3cb1db8c 174 $tname = $prefix . '.t';
ad41e777 175 $self->{prefix} = $prefix;
176 }
3cb1db8c 177 my $dir = $self->{test_dir};
178 my $type = lc $self->{type};
179 return File::Spec->catfile( $dir, $type, $tname );
ad41e777 180}
181
fc7ec1d9 182sub _mk_dirs {
183 my $self = shift;
ad41e777 184 $self->mk_dir( $self->{dir} );
91864987 185 $self->{script} = File::Spec->catdir( $self->{dir}, 'script' );
186 $self->mk_dir( $self->{script} );
fc7ec1d9 187 $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
ad41e777 188 $self->mk_dir( $self->{lib} );
fc7ec1d9 189 $self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
ad41e777 190 $self->mk_dir( $self->{root} );
fc7ec1d9 191 $self->{t} = File::Spec->catdir( $self->{dir}, 't' );
ad41e777 192 $self->mk_dir( $self->{t} );
3cb1db8c 193 $self->mk_dir( File::Spec->catdir( $self->{t}, 'm' ) );
194 $self->mk_dir( File::Spec->catdir( $self->{t}, 'v' ) );
195 $self->mk_dir( File::Spec->catdir( $self->{t}, 'c' ) );
fc7ec1d9 196 $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
197 $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
ad41e777 198 $self->mk_dir( $self->{mod} );
fc7ec1d9 199 $self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
ad41e777 200 $self->mk_dir( $self->{m} );
fc7ec1d9 201 $self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
ad41e777 202 $self->mk_dir( $self->{v} );
fc7ec1d9 203 $self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
ad41e777 204 $self->mk_dir( $self->{c} );
fc7ec1d9 205 $self->{base} = File::Spec->rel2abs( $self->{dir} );
206}
207
208sub _mk_appclass {
ad41e777 209 my $self = shift;
210 my $mod = $self->{mod};
211 my $name = $self->{name};
212 my $base = $self->{base};
213 $self->mk_file( "$mod.pm", <<"EOF");
fc7ec1d9 214package $name;
215
216use strict;
217use Catalyst qw/-Debug/;
218
219our \$VERSION = '0.01';
220
221$name->config(
222 name => '$name',
223 root => '$base/root',
224);
225
5a8ed4fe 226sub default : Private {
227 my ( \$self, \$c ) = \@_;
228 \$c->res->output('Congratulations, $name is on Catalyst!');
229}
fc7ec1d9 230
231=head1 NAME
232
233$name - A very nice application
234
235=head1 SYNOPSIS
236
237 Very simple to use
238
239=head1 DESCRIPTION
240
241Very nice application.
242
243=head1 AUTHOR
244
245Clever guy
246
247=head1 LICENSE
248
249This library is free software . You can redistribute it and/or modify it under
250the same terms as perl itself.
251
252=cut
253
2541;
255EOF
256}
257
258sub _mk_makefile {
ad41e777 259 my $self = shift;
260 my $name = $self->{name};
261 my $dir = $self->{dir};
262 my $class = $self->{class};
263 $self->mk_file( "$dir\/Makefile.PL", <<"EOF");
fc7ec1d9 264use ExtUtils::MakeMaker;
265
266WriteMakefile(
267 NAME => '$name',
268 VERSION_FROM => 'lib/$class.pm',
3cb1db8c 269 PREREQ_PM => { Catalyst => 0 },
270 test => { TESTS => join ' ', ( glob('t/*.t'), glob('t/*/*.t') ) }
fc7ec1d9 271);
272EOF
273}
274
91864987 275sub _mk_readme {
276 my $self = shift;
277 my $dir = $self->{dir};
278 $self->mk_file( "$dir\/README", <<"EOF");
279Run script/server.pl to test the application.
280EOF
281}
282
283sub _mk_changes {
284 my $self = shift;
285 my $name = $self->{name};
286 my $dir = $self->{dir};
287 my $time = localtime time;
288 $self->mk_file( "$dir\/Changes", <<"EOF");
289This file documents the revision history for Perl extension $name.
290
2910.01 $time
292 - initial revision, generated by Catalyst
293EOF
294}
295
fc7ec1d9 296sub _mk_apptest {
297 my $self = shift;
298 my $t = $self->{t};
299 my $name = $self->{name};
ad41e777 300 $self->mk_file( "$t\/01app.t", <<"EOF");
fc7ec1d9 301use Test::More tests => 2;
302use_ok( Catalyst::Test, '$name' );
303
304ok( request('/')->is_success );
305EOF
5a8fd7e9 306 $self->mk_file( "$t\/02pod.t", <<"EOF");
307use Test::More;
308
309eval "use Test::Pod 1.14";
a5d4355a 310plan skip_all => 'Test::Pod 1.14 required' if \$@;
311plan skip_all => 'set TEST_POD to enable this test' unless \$ENV{TEST_POD};
5a8fd7e9 312
313all_pod_files_ok();
314EOF
315 $self->mk_file( "$t\/03podcoverage.t", <<"EOF");
1df125c9 316use Test::More;
317
318eval "use Test::Pod::Coverage 1.04";
319plan skip_all => 'Test::Pod::Coverage 1.04 required' if \$@;
320plan skip_all => 'set TEST_POD to enable this test' unless \$ENV{TEST_POD};
321
322all_pod_coverage_ok();
323EOF
fc7ec1d9 324}
325
bc024080 326sub _mk_cgi {
327 my $self = shift;
328 my $name = $self->{name};
329 my $script = $self->{script};
d8ab1b45 330 $self->mk_file( "$script\/cgi.pl", <<"EOF");
331$Config{startperl} -w
332
333BEGIN { \$ENV{CATALYST_ENGINE} = 'CGI' }
334
335use strict;
336use FindBin;
337use lib "\$FindBin::Bin/../lib";
338use $name;
339
340$name->run;
341
3421;
343__END__
344
345=head1 NAME
346
347cgi - Catalyst CGI
348
349=head1 SYNOPSIS
350
351See L<Catalyst::Manual>
352
353=head1 DESCRIPTION
354
355Run a Catalyst application as cgi.
356
357=head1 AUTHOR
358
359Sebastian Riedel, C<sri\@oook.de>
360
361=head1 COPYRIGHT
362
363Copyright 2004 Sebastian Riedel. All rights reserved.
364
365This library is free software. You can redistribute it and/or modify it under
366the same terms as perl itself.
367
368=cut
369EOF
370 chmod 0700, "$script/cgi.pl";
371}
372
cb8d90e5 373sub _mk_fcgi {
374 my $self = shift;
375 my $name = $self->{name};
376 my $script = $self->{script};
377 $self->mk_file( "$script\/fcgi.pl", <<"EOF");
378$Config{startperl} -w
379
ffb41d94 380BEGIN { \$ENV{CATALYST_ENGINE} = 'FCGI' }
cb8d90e5 381
382use strict;
383use FindBin;
384use lib "\$FindBin::Bin/../lib";
cb8d90e5 385use $name;
386
ffb41d94 387$name->run;
cb8d90e5 388
3891;
390__END__
391
392=head1 NAME
393
394fcgi - Catalyst FCGI
395
396=head1 SYNOPSIS
397
398See L<Catalyst::Manual>
399
400=head1 DESCRIPTION
401
402Run a Catalyst application as fcgi.
403
404=head1 AUTHOR
405
406Sebastian Riedel, C<sri\@oook.de>
407
408=head1 COPYRIGHT
409
410Copyright 2004 Sebastian Riedel. All rights reserved.
411
412This library is free software. You can redistribute it and/or modify it under
413the same terms as perl itself.
414
415=cut
416EOF
417 chmod 0700, "$script/fcgi.pl";
418}
419
fc7ec1d9 420sub _mk_server {
91864987 421 my $self = shift;
422 my $name = $self->{name};
423 my $script = $self->{script};
424 $self->mk_file( "$script\/server.pl", <<"EOF");
f1d0b7ea 425$Config{startperl} -w
fc7ec1d9 426
ca61af20 427BEGIN { \$ENV{CATALYST_ENGINE} = 'HTTP' }
585893b9 428
fc7ec1d9 429use strict;
430use Getopt::Long;
431use Pod::Usage;
432use FindBin;
433use lib "\$FindBin::Bin/../lib";
585893b9 434use $name;
fc7ec1d9 435
436my \$help = 0;
437my \$port = 3000;
438
439GetOptions( 'help|?' => \\\$help, 'port=s' => \\\$port );
440
441pod2usage(1) if \$help;
442
585893b9 443$name->run(\$port);
fc7ec1d9 444
4451;
446__END__
447
448=head1 NAME
449
450server - Catalyst Testserver
451
452=head1 SYNOPSIS
453
91864987 454server.pl [options]
fc7ec1d9 455
456 Options:
ad41e777 457 -? -help display this help and exits
458 -p -port port (defaults to 3000)
fc7ec1d9 459
03a53815 460 See also:
461 perldoc Catalyst::Manual
462 perldoc Catalyst::Manual::Intro
463
fc7ec1d9 464=head1 DESCRIPTION
465
466Run a Catalyst Testserver for this application.
467
468=head1 AUTHOR
469
470Sebastian Riedel, C<sri\@oook.de>
471
472=head1 COPYRIGHT
473
474Copyright 2004 Sebastian Riedel. All rights reserved.
475
476This library is free software. You can redistribute it and/or modify it under
477the same terms as perl itself.
478
479=cut
480EOF
91864987 481 chmod 0700, "$script/server.pl";
fc7ec1d9 482}
483
484sub _mk_test {
91864987 485 my $self = shift;
486 my $name = $self->{name};
487 my $script = $self->{script};
488 $self->mk_file( "$script/test.pl", <<"EOF");
f1d0b7ea 489$Config{startperl} -w
fc7ec1d9 490
e646f111 491BEGIN { \$ENV{CATALYST_ENGINE} = 'Test' }
492
fc7ec1d9 493use strict;
494use Getopt::Long;
495use Pod::Usage;
496use FindBin;
497use lib "\$FindBin::Bin/../lib";
e646f111 498use $name;
fc7ec1d9 499
500my \$help = 0;
501
502GetOptions( 'help|?' => \\\$help );
503
504pod2usage(1) if ( \$help || !\$ARGV[0] );
505
e646f111 506print $name->run(\$ARGV[0])->content . "\n";
fc7ec1d9 507
5081;
509__END__
510
511=head1 NAME
512
513test - Catalyst Test
514
515=head1 SYNOPSIS
516
91864987 517test.pl [options] uri
fc7ec1d9 518
519 Options:
520 -help display this help and exits
521
522 Examples:
91864987 523 test.pl http://localhost/some_action
524 test.pl /some_action
fc7ec1d9 525
03a53815 526 See also:
527 perldoc Catalyst::Manual
528 perldoc Catalyst::Manual::Intro
529
fc7ec1d9 530=head1 DESCRIPTION
531
532Run a Catalyst action from the comand line.
533
534=head1 AUTHOR
535
536Sebastian Riedel, C<sri\@oook.de>
537
538=head1 COPYRIGHT
539
540Copyright 2004 Sebastian Riedel. All rights reserved.
541
542This library is free software. You can redistribute it and/or modify it under
543the same terms as perl itself.
544
545=cut
546EOF
91864987 547 chmod 0700, "$script/test.pl";
fc7ec1d9 548}
549
550sub _mk_create {
91864987 551 my $self = shift;
552 my $name = $self->{name};
553 my $script = $self->{script};
554 $self->mk_file( "$script\/create.pl", <<"EOF");
f1d0b7ea 555$Config{startperl} -w
fc7ec1d9 556
557use strict;
558use Getopt::Long;
559use Pod::Usage;
560use Catalyst::Helper;
561
562my \$help = 0;
563
564GetOptions( 'help|?' => \$help );
565
b5524568 566pod2usage(1) if ( \$help || !\$ARGV[0] );
fc7ec1d9 567
568my \$helper = Catalyst::Helper->new;
569pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV );
570
5711;
572__END__
573
574=head1 NAME
575
576create - Create a new Catalyst Component
577
578=head1 SYNOPSIS
579
91864987 580create.pl [options] model|view|controller name [helper] [options]
fc7ec1d9 581
582 Options:
583 -help display this help and exits
584
585 Examples:
91864987 586 create.pl controller My::Controller
587 create.pl view My::View
588 create.pl view MyView TT
589 create.pl view TT TT
590 create.pl model My::Model
591 create.pl model SomeDB CDBI dbi:SQLite:/tmp/my.db
592 create.pl model AnotherDB CDBI dbi:Pg:dbname=foo root 4321
b5524568 593 create.pl Ajax
03a53815 594
595 See also:
596 perldoc Catalyst::Manual
597 perldoc Catalyst::Manual::Intro
fc7ec1d9 598
599=head1 DESCRIPTION
600
601Create a new Catalyst Component.
602
603=head1 AUTHOR
604
605Sebastian Riedel, C<sri\@oook.de>
606
607=head1 COPYRIGHT
608
609Copyright 2004 Sebastian Riedel. All rights reserved.
610
611This library is free software. You can redistribute it and/or modify it under
612the same terms as perl itself.
613
614=cut
615EOF
91864987 616 chmod 0700, "$script/create.pl";
fc7ec1d9 617}
618
fc7ec1d9 619sub _mk_compclass {
620 my $self = shift;
621 my $app = $self->{app};
622 my $class = $self->{class};
623 my $type = $self->{type};
624 my $action = '';
625 $action = <<"EOF" if $type eq 'C';
626
5a8ed4fe 627sub default : Private {
628 my ( \$self, \$c ) = \@_;
629 \$c->res->output('Congratulations, $class is on Catalyst!');
630}
fc7ec1d9 631
fc7ec1d9 632EOF
633 my $file = $self->{file};
ad41e777 634 return $self->mk_file( "$file", <<"EOF");
fc7ec1d9 635package $class;
636
637use strict;
638use base 'Catalyst::Base';
639$action
640=head1 NAME
641
642$class - A Component
643
644=head1 SYNOPSIS
645
646 Very simple to use
647
648=head1 DESCRIPTION
649
650Very nice component.
651
652=head1 AUTHOR
653
654Clever guy
655
656=head1 LICENSE
657
658This library is free software . You can redistribute it and/or modify it under
659the same terms as perl itself.
660
661=cut
662
6631;
664EOF
665}
666
667sub _mk_comptest {
668 my $self = shift;
669 my $prefix = $self->{prefix};
670 my $type = $self->{type};
671 my $class = $self->{class};
672 my $app = $self->{app};
673 my $test = $self->{test};
fc7ec1d9 674 if ( $self->{type} eq 'C' ) {
ad41e777 675 $self->mk_file( "$test", <<"EOF");
fc7ec1d9 676use Test::More tests => 3;
677use_ok( Catalyst::Test, '$app' );
678use_ok('$class');
679
680ok( request('$prefix')->is_success );
681EOF
682 }
683 else {
ad41e777 684 $self->mk_file( "$test", <<"EOF");
fc7ec1d9 685use Test::More tests => 1;
686use_ok('$class');
687EOF
688 }
689}
690
7833fdfc 691=head1 HELPERS
692
693Helpers are classes that provide two methods.
694
695 * mk_compclass - creates the Component class
696 * mk_comptest - creates the Component test
697
698So when you call C<bin/create view MyView TT>, create would try to execute
699Catalyst::Helper::View::TT->mk_compclass and
700Catalyst::Helper::View::TT->mk_comptest.
701
702See L<Catalyst::Helper::View::TT> and L<Catalyst::Helper::Model::CDBI> for
703examples.
704
705All helper classes should be under one of the following namespaces.
706
707 Catalyst::Helper::Model::
708 Catalyst::Helper::View::
709 Catalyst::Helper::Controller::
710
fc7ec1d9 711=head1 SEE ALSO
712
713L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
714L<Catalyst::Response>, L<Catalyst>
715
716=head1 AUTHOR
717
718Sebastian Riedel, C<sri@oook.de>
719
720=head1 LICENSE
721
722This library is free software . You can redistribute it and/or modify it under
723the same terms as perl itself.
724
725=cut
726
7271;