fixed base
[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;
fc7ec1d9 42 $self->_mk_server;
bc024080 43 $self->_mk_cgiserver;
fc7ec1d9 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
226$name->action(
227
228 '!default' => sub {
229 my ( \$self, \$c ) = \@_;
230 \$c->res->output('Congratulations, $name is on Catalyst!');
231 },
232
233);
234
235=head1 NAME
236
237$name - A very nice application
238
239=head1 SYNOPSIS
240
241 Very simple to use
242
243=head1 DESCRIPTION
244
245Very nice application.
246
247=head1 AUTHOR
248
249Clever guy
250
251=head1 LICENSE
252
253This library is free software . You can redistribute it and/or modify it under
254the same terms as perl itself.
255
256=cut
257
2581;
259EOF
260}
261
262sub _mk_makefile {
ad41e777 263 my $self = shift;
264 my $name = $self->{name};
265 my $dir = $self->{dir};
266 my $class = $self->{class};
267 $self->mk_file( "$dir\/Makefile.PL", <<"EOF");
fc7ec1d9 268use ExtUtils::MakeMaker;
269
270WriteMakefile(
271 NAME => '$name',
272 VERSION_FROM => 'lib/$class.pm',
3cb1db8c 273 PREREQ_PM => { Catalyst => 0 },
274 test => { TESTS => join ' ', ( glob('t/*.t'), glob('t/*/*.t') ) }
fc7ec1d9 275);
276EOF
277}
278
91864987 279sub _mk_readme {
280 my $self = shift;
281 my $dir = $self->{dir};
282 $self->mk_file( "$dir\/README", <<"EOF");
283Run script/server.pl to test the application.
284EOF
285}
286
287sub _mk_changes {
288 my $self = shift;
289 my $name = $self->{name};
290 my $dir = $self->{dir};
291 my $time = localtime time;
292 $self->mk_file( "$dir\/Changes", <<"EOF");
293This file documents the revision history for Perl extension $name.
294
2950.01 $time
296 - initial revision, generated by Catalyst
297EOF
298}
299
fc7ec1d9 300sub _mk_apptest {
301 my $self = shift;
302 my $t = $self->{t};
303 my $name = $self->{name};
ad41e777 304 $self->mk_file( "$t\/01app.t", <<"EOF");
fc7ec1d9 305use Test::More tests => 2;
306use_ok( Catalyst::Test, '$name' );
307
308ok( request('/')->is_success );
309EOF
ad41e777 310 $self->mk_file( "$t\/02podcoverage.t", <<"EOF");
1df125c9 311use Test::More;
312
313eval "use Test::Pod::Coverage 1.04";
314plan skip_all => 'Test::Pod::Coverage 1.04 required' if \$@;
315plan skip_all => 'set TEST_POD to enable this test' unless \$ENV{TEST_POD};
316
317all_pod_coverage_ok();
318EOF
fc7ec1d9 319}
320
bc024080 321sub _mk_cgi {
322 my $self = shift;
323 my $name = $self->{name};
324 my $script = $self->{script};
3fde004f 325 $self->mk_file( "$script\/nph-cgi.pl", <<"EOF");
bc024080 326$Config{startperl} -w
327
c0d174dc 328BEGIN {
329 \$ENV{CATALYST_ENGINE} = 'CGI';
330 \$ENV{CATALYST_TEST = 1;
331}
e4b4c2b6 332
bc024080 333use strict;
334use FindBin;
335use lib "\$FindBin::Bin/../lib";
336use $name;
337
338$name->run;
339
3401;
341__END__
342
343=head1 NAME
344
3fde004f 345nph-cgi - Catalyst CGI
bc024080 346
347=head1 SYNOPSIS
348
349See L<Catalyst::Manual>
350
351=head1 DESCRIPTION
352
353Run a Catalyst application as cgi.
354
355=head1 AUTHOR
356
357Sebastian Riedel, C<sri\@oook.de>
358
359=head1 COPYRIGHT
360
361Copyright 2004 Sebastian Riedel. All rights reserved.
362
363This library is free software. You can redistribute it and/or modify it under
364the same terms as perl itself.
365
366=cut
367EOF
3fde004f 368 chmod 0700, "$script/nph-cgi.pl";
bc024080 369}
370
fc7ec1d9 371sub _mk_server {
91864987 372 my $self = shift;
373 my $name = $self->{name};
374 my $script = $self->{script};
375 $self->mk_file( "$script\/server.pl", <<"EOF");
f1d0b7ea 376$Config{startperl} -w
fc7ec1d9 377
585893b9 378BEGIN {
379 \$ENV{CATALYST_ENGINE} = 'Server';
c0d174dc 380 \$ENV{CATALYST_TEST} = 1;
585893b9 381}
382
fc7ec1d9 383use strict;
384use Getopt::Long;
385use Pod::Usage;
386use FindBin;
387use lib "\$FindBin::Bin/../lib";
585893b9 388use $name;
fc7ec1d9 389
390my \$help = 0;
391my \$port = 3000;
392
393GetOptions( 'help|?' => \\\$help, 'port=s' => \\\$port );
394
395pod2usage(1) if \$help;
396
585893b9 397$name->run(\$port);
fc7ec1d9 398
3991;
400__END__
401
402=head1 NAME
403
404server - Catalyst Testserver
405
406=head1 SYNOPSIS
407
91864987 408server.pl [options]
fc7ec1d9 409
410 Options:
ad41e777 411 -? -help display this help and exits
412 -p -port port (defaults to 3000)
fc7ec1d9 413
03a53815 414 See also:
415 perldoc Catalyst::Manual
416 perldoc Catalyst::Manual::Intro
417
fc7ec1d9 418=head1 DESCRIPTION
419
420Run a Catalyst Testserver for this application.
421
422=head1 AUTHOR
423
424Sebastian Riedel, C<sri\@oook.de>
425
426=head1 COPYRIGHT
427
428Copyright 2004 Sebastian Riedel. All rights reserved.
429
430This library is free software. You can redistribute it and/or modify it under
431the same terms as perl itself.
432
433=cut
434EOF
91864987 435 chmod 0700, "$script/server.pl";
fc7ec1d9 436}
437
bc024080 438sub _mk_cgiserver {
439 my $self = shift;
440 my $name = $self->{name};
441 my $script = $self->{script};
442 $self->mk_file( "$script\/cgi-server.pl", <<"EOF");
443$Config{startperl} -w
444
585893b9 445BEGIN {
446 \$ENV{CATALYST_ENGINE} = 'Server';
c0d174dc 447 \$ENV{CATALYST_TEST} = 1;
585893b9 448}
449
bc024080 450use strict;
451use Getopt::Long;
452use Pod::Usage;
453use FindBin;
585893b9 454use lib "\$FindBin::Bin/../lib";
bc024080 455use File::Spec;
585893b9 456use $name;
bc024080 457
458my \$help = 0;
459my \$port = 3000;
460
461GetOptions( 'help|?' => \\\$help, 'port=s' => \\\$port );
462
463pod2usage(1) if \$help;
464
585893b9 465$name->run( \$port, File::Spec->catfile( \$FindBin::Bin, 'nph-cgi.pl' ) );
bc024080 466
4671;
468__END__
469
470=head1 NAME
471
472cgi-server - Catalyst CGI Testserver
473
474=head1 SYNOPSIS
475
476cgi-server.pl [options]
477
478 Options:
479 -? -help display this help and exits
480 -p -port port (defaults to 3000)
481
482 See also:
483 perldoc Catalyst::Manual
484 perldoc Catalyst::Manual::Intro
485
486=head1 DESCRIPTION
487
488Run a Catalyst CGI Testserver for this application.
489
490Similar to the regular server but doesn't require a restart
491after code changes!
492
493=head1 AUTHOR
494
495Sebastian Riedel, C<sri\@oook.de>
496
497=head1 COPYRIGHT
498
499Copyright 2004 Sebastian Riedel. All rights reserved.
500
501This library is free software. You can redistribute it and/or modify it under
502the same terms as perl itself.
503
504=cut
505EOF
506 chmod 0700, "$script/cgi-server.pl";
507}
508
fc7ec1d9 509sub _mk_test {
91864987 510 my $self = shift;
511 my $name = $self->{name};
512 my $script = $self->{script};
513 $self->mk_file( "$script/test.pl", <<"EOF");
f1d0b7ea 514$Config{startperl} -w
fc7ec1d9 515
516use strict;
517use Getopt::Long;
518use Pod::Usage;
519use FindBin;
520use lib "\$FindBin::Bin/../lib";
521
522my \$help = 0;
523
524GetOptions( 'help|?' => \\\$help );
525
526pod2usage(1) if ( \$help || !\$ARGV[0] );
527
528require Catalyst::Test;
529import Catalyst::Test '$name';
530
531print get(\$ARGV[0]) . "\n";
532
5331;
534__END__
535
536=head1 NAME
537
538test - Catalyst Test
539
540=head1 SYNOPSIS
541
91864987 542test.pl [options] uri
fc7ec1d9 543
544 Options:
545 -help display this help and exits
546
547 Examples:
91864987 548 test.pl http://localhost/some_action
549 test.pl /some_action
fc7ec1d9 550
03a53815 551 See also:
552 perldoc Catalyst::Manual
553 perldoc Catalyst::Manual::Intro
554
fc7ec1d9 555=head1 DESCRIPTION
556
557Run a Catalyst action from the comand line.
558
559=head1 AUTHOR
560
561Sebastian Riedel, C<sri\@oook.de>
562
563=head1 COPYRIGHT
564
565Copyright 2004 Sebastian Riedel. All rights reserved.
566
567This library is free software. You can redistribute it and/or modify it under
568the same terms as perl itself.
569
570=cut
571EOF
91864987 572 chmod 0700, "$script/test.pl";
fc7ec1d9 573}
574
575sub _mk_create {
91864987 576 my $self = shift;
577 my $name = $self->{name};
578 my $script = $self->{script};
579 $self->mk_file( "$script\/create.pl", <<"EOF");
f1d0b7ea 580$Config{startperl} -w
fc7ec1d9 581
582use strict;
583use Getopt::Long;
584use Pod::Usage;
585use Catalyst::Helper;
586
587my \$help = 0;
588
589GetOptions( 'help|?' => \$help );
590
b5524568 591pod2usage(1) if ( \$help || !\$ARGV[0] );
fc7ec1d9 592
593my \$helper = Catalyst::Helper->new;
594pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV );
595
5961;
597__END__
598
599=head1 NAME
600
601create - Create a new Catalyst Component
602
603=head1 SYNOPSIS
604
91864987 605create.pl [options] model|view|controller name [helper] [options]
fc7ec1d9 606
607 Options:
608 -help display this help and exits
609
610 Examples:
91864987 611 create.pl controller My::Controller
612 create.pl view My::View
613 create.pl view MyView TT
614 create.pl view TT TT
615 create.pl model My::Model
616 create.pl model SomeDB CDBI dbi:SQLite:/tmp/my.db
617 create.pl model AnotherDB CDBI dbi:Pg:dbname=foo root 4321
b5524568 618 create.pl Ajax
03a53815 619
620 See also:
621 perldoc Catalyst::Manual
622 perldoc Catalyst::Manual::Intro
fc7ec1d9 623
624=head1 DESCRIPTION
625
626Create a new Catalyst Component.
627
628=head1 AUTHOR
629
630Sebastian Riedel, C<sri\@oook.de>
631
632=head1 COPYRIGHT
633
634Copyright 2004 Sebastian Riedel. All rights reserved.
635
636This library is free software. You can redistribute it and/or modify it under
637the same terms as perl itself.
638
639=cut
640EOF
91864987 641 chmod 0700, "$script/create.pl";
fc7ec1d9 642}
643
fc7ec1d9 644sub _mk_compclass {
645 my $self = shift;
646 my $app = $self->{app};
647 my $class = $self->{class};
648 my $type = $self->{type};
649 my $action = '';
650 $action = <<"EOF" if $type eq 'C';
651
652$app->action(
653
654 '!?default' => sub {
655 my ( \$self, \$c ) = \@_;
656 \$c->res->output('Congratulations, $class is on Catalyst!');
657 },
658
659);
660EOF
661 my $file = $self->{file};
ad41e777 662 return $self->mk_file( "$file", <<"EOF");
fc7ec1d9 663package $class;
664
665use strict;
666use base 'Catalyst::Base';
667$action
668=head1 NAME
669
670$class - A Component
671
672=head1 SYNOPSIS
673
674 Very simple to use
675
676=head1 DESCRIPTION
677
678Very nice component.
679
680=head1 AUTHOR
681
682Clever guy
683
684=head1 LICENSE
685
686This library is free software . You can redistribute it and/or modify it under
687the same terms as perl itself.
688
689=cut
690
6911;
692EOF
693}
694
695sub _mk_comptest {
696 my $self = shift;
697 my $prefix = $self->{prefix};
698 my $type = $self->{type};
699 my $class = $self->{class};
700 my $app = $self->{app};
701 my $test = $self->{test};
fc7ec1d9 702 if ( $self->{type} eq 'C' ) {
ad41e777 703 $self->mk_file( "$test", <<"EOF");
fc7ec1d9 704use Test::More tests => 3;
705use_ok( Catalyst::Test, '$app' );
706use_ok('$class');
707
708ok( request('$prefix')->is_success );
709EOF
710 }
711 else {
ad41e777 712 $self->mk_file( "$test", <<"EOF");
fc7ec1d9 713use Test::More tests => 1;
714use_ok('$class');
715EOF
716 }
717}
718
7833fdfc 719=head1 HELPERS
720
721Helpers are classes that provide two methods.
722
723 * mk_compclass - creates the Component class
724 * mk_comptest - creates the Component test
725
726So when you call C<bin/create view MyView TT>, create would try to execute
727Catalyst::Helper::View::TT->mk_compclass and
728Catalyst::Helper::View::TT->mk_comptest.
729
730See L<Catalyst::Helper::View::TT> and L<Catalyst::Helper::Model::CDBI> for
731examples.
732
733All helper classes should be under one of the following namespaces.
734
735 Catalyst::Helper::Model::
736 Catalyst::Helper::View::
737 Catalyst::Helper::Controller::
738
fc7ec1d9 739=head1 SEE ALSO
740
741L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
742L<Catalyst::Response>, L<Catalyst>
743
744=head1 AUTHOR
745
746Sebastian Riedel, C<sri@oook.de>
747
748=head1 LICENSE
749
750This library is free software . You can redistribute it and/or modify it under
751the same terms as perl itself.
752
753=cut
754
7551;