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