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