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