no more regex forwards
[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 ) = @_;
148 my $dir = $self->{test_dir};
149 my $num = '01';
150 for my $i (<$dir/*.t>) {
151 $i =~ /(\d+)[^\/]*.t$/;
152 my $j = $1 || $num;
153 $num = $j if $j > $num;
154 }
155 $num++;
156 $num = sprintf '%02d', $num;
157 if ($tname) { $tname = "$num$tname.t" }
158 else {
159 my $name = $self->{name};
160 my $type = $self->{type};
161 my $prefix = $name;
162 $prefix =~ s/::/_/g;
163 $prefix = lc $prefix;
164 $tname = lc( $num . $type . '_' . $prefix . '.t' );
165 $self->{prefix} = $prefix;
166 }
167 return "$dir/$tname";
168}
169
fc7ec1d9 170sub _mk_dirs {
171 my $self = shift;
ad41e777 172 $self->mk_dir( $self->{dir} );
91864987 173 $self->{script} = File::Spec->catdir( $self->{dir}, 'script' );
174 $self->mk_dir( $self->{script} );
fc7ec1d9 175 $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
ad41e777 176 $self->mk_dir( $self->{lib} );
fc7ec1d9 177 $self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
ad41e777 178 $self->mk_dir( $self->{root} );
fc7ec1d9 179 $self->{t} = File::Spec->catdir( $self->{dir}, 't' );
ad41e777 180 $self->mk_dir( $self->{t} );
fc7ec1d9 181 $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
182 $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
ad41e777 183 $self->mk_dir( $self->{mod} );
fc7ec1d9 184 $self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
ad41e777 185 $self->mk_dir( $self->{m} );
fc7ec1d9 186 $self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
ad41e777 187 $self->mk_dir( $self->{v} );
fc7ec1d9 188 $self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
ad41e777 189 $self->mk_dir( $self->{c} );
fc7ec1d9 190 $self->{base} = File::Spec->rel2abs( $self->{dir} );
191}
192
193sub _mk_appclass {
ad41e777 194 my $self = shift;
195 my $mod = $self->{mod};
196 my $name = $self->{name};
197 my $base = $self->{base};
198 $self->mk_file( "$mod.pm", <<"EOF");
fc7ec1d9 199package $name;
200
201use strict;
202use Catalyst qw/-Debug/;
203
204our \$VERSION = '0.01';
205
206$name->config(
207 name => '$name',
208 root => '$base/root',
209);
210
211$name->action(
212
213 '!default' => sub {
214 my ( \$self, \$c ) = \@_;
215 \$c->res->output('Congratulations, $name is on Catalyst!');
216 },
217
218);
219
220=head1 NAME
221
222$name - A very nice application
223
224=head1 SYNOPSIS
225
226 Very simple to use
227
228=head1 DESCRIPTION
229
230Very nice application.
231
232=head1 AUTHOR
233
234Clever guy
235
236=head1 LICENSE
237
238This library is free software . You can redistribute it and/or modify it under
239the same terms as perl itself.
240
241=cut
242
2431;
244EOF
245}
246
247sub _mk_makefile {
ad41e777 248 my $self = shift;
249 my $name = $self->{name};
250 my $dir = $self->{dir};
251 my $class = $self->{class};
252 $self->mk_file( "$dir\/Makefile.PL", <<"EOF");
fc7ec1d9 253use ExtUtils::MakeMaker;
254
255WriteMakefile(
256 NAME => '$name',
257 VERSION_FROM => 'lib/$class.pm',
258 PREREQ_PM => { Catalyst => 0 }
259);
260EOF
261}
262
91864987 263sub _mk_readme {
264 my $self = shift;
265 my $dir = $self->{dir};
266 $self->mk_file( "$dir\/README", <<"EOF");
267Run script/server.pl to test the application.
268EOF
269}
270
271sub _mk_changes {
272 my $self = shift;
273 my $name = $self->{name};
274 my $dir = $self->{dir};
275 my $time = localtime time;
276 $self->mk_file( "$dir\/Changes", <<"EOF");
277This file documents the revision history for Perl extension $name.
278
2790.01 $time
280 - initial revision, generated by Catalyst
281EOF
282}
283
fc7ec1d9 284sub _mk_apptest {
285 my $self = shift;
286 my $t = $self->{t};
287 my $name = $self->{name};
ad41e777 288 $self->mk_file( "$t\/01app.t", <<"EOF");
fc7ec1d9 289use Test::More tests => 2;
290use_ok( Catalyst::Test, '$name' );
291
292ok( request('/')->is_success );
293EOF
ad41e777 294 $self->mk_file( "$t\/02podcoverage.t", <<"EOF");
1df125c9 295use Test::More;
296
297eval "use Test::Pod::Coverage 1.04";
298plan skip_all => 'Test::Pod::Coverage 1.04 required' if \$@;
299plan skip_all => 'set TEST_POD to enable this test' unless \$ENV{TEST_POD};
300
301all_pod_coverage_ok();
302EOF
fc7ec1d9 303}
304
305sub _mk_server {
91864987 306 my $self = shift;
307 my $name = $self->{name};
308 my $script = $self->{script};
309 $self->mk_file( "$script\/server.pl", <<"EOF");
fc7ec1d9 310#!/usr/bin/perl -w
311
312use strict;
313use Getopt::Long;
314use Pod::Usage;
315use FindBin;
316use lib "\$FindBin::Bin/../lib";
317use Catalyst::Test '$name';
318
319my \$help = 0;
320my \$port = 3000;
321
322GetOptions( 'help|?' => \\\$help, 'port=s' => \\\$port );
323
324pod2usage(1) if \$help;
325
326Catalyst::Test::server(\$port);
327
3281;
329__END__
330
331=head1 NAME
332
333server - Catalyst Testserver
334
335=head1 SYNOPSIS
336
91864987 337server.pl [options]
fc7ec1d9 338
339 Options:
ad41e777 340 -? -help display this help and exits
341 -p -port port (defaults to 3000)
fc7ec1d9 342
03a53815 343 See also:
344 perldoc Catalyst::Manual
345 perldoc Catalyst::Manual::Intro
346
fc7ec1d9 347=head1 DESCRIPTION
348
349Run a Catalyst Testserver for this application.
350
351=head1 AUTHOR
352
353Sebastian Riedel, C<sri\@oook.de>
354
355=head1 COPYRIGHT
356
357Copyright 2004 Sebastian Riedel. All rights reserved.
358
359This library is free software. You can redistribute it and/or modify it under
360the same terms as perl itself.
361
362=cut
363EOF
91864987 364 chmod 0700, "$script/server.pl";
fc7ec1d9 365}
366
367sub _mk_test {
91864987 368 my $self = shift;
369 my $name = $self->{name};
370 my $script = $self->{script};
371 $self->mk_file( "$script/test.pl", <<"EOF");
fc7ec1d9 372#!/usr/bin/perl -w
373
374use strict;
375use Getopt::Long;
376use Pod::Usage;
377use FindBin;
378use lib "\$FindBin::Bin/../lib";
379
380my \$help = 0;
381
382GetOptions( 'help|?' => \\\$help );
383
384pod2usage(1) if ( \$help || !\$ARGV[0] );
385
386require Catalyst::Test;
387import Catalyst::Test '$name';
388
389print get(\$ARGV[0]) . "\n";
390
3911;
392__END__
393
394=head1 NAME
395
396test - Catalyst Test
397
398=head1 SYNOPSIS
399
91864987 400test.pl [options] uri
fc7ec1d9 401
402 Options:
403 -help display this help and exits
404
405 Examples:
91864987 406 test.pl http://localhost/some_action
407 test.pl /some_action
fc7ec1d9 408
03a53815 409 See also:
410 perldoc Catalyst::Manual
411 perldoc Catalyst::Manual::Intro
412
fc7ec1d9 413=head1 DESCRIPTION
414
415Run a Catalyst action from the comand line.
416
417=head1 AUTHOR
418
419Sebastian Riedel, C<sri\@oook.de>
420
421=head1 COPYRIGHT
422
423Copyright 2004 Sebastian Riedel. All rights reserved.
424
425This library is free software. You can redistribute it and/or modify it under
426the same terms as perl itself.
427
428=cut
429EOF
91864987 430 chmod 0700, "$script/test.pl";
fc7ec1d9 431}
432
433sub _mk_create {
91864987 434 my $self = shift;
435 my $name = $self->{name};
436 my $script = $self->{script};
437 $self->mk_file( "$script\/create.pl", <<"EOF");
fc7ec1d9 438#!/usr/bin/perl -w
439
440use strict;
441use Getopt::Long;
442use Pod::Usage;
443use Catalyst::Helper;
444
445my \$help = 0;
446
447GetOptions( 'help|?' => \$help );
448
449pod2usage(1) if ( \$help || !\$ARGV[1] );
450
451my \$helper = Catalyst::Helper->new;
452pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV );
453
4541;
455__END__
456
457=head1 NAME
458
459create - Create a new Catalyst Component
460
461=head1 SYNOPSIS
462
91864987 463create.pl [options] model|view|controller name [helper] [options]
fc7ec1d9 464
465 Options:
466 -help display this help and exits
467
468 Examples:
91864987 469 create.pl controller My::Controller
470 create.pl view My::View
471 create.pl view MyView TT
472 create.pl view TT TT
473 create.pl model My::Model
474 create.pl model SomeDB CDBI dbi:SQLite:/tmp/my.db
475 create.pl model AnotherDB CDBI dbi:Pg:dbname=foo root 4321
03a53815 476
477 See also:
478 perldoc Catalyst::Manual
479 perldoc Catalyst::Manual::Intro
fc7ec1d9 480
481=head1 DESCRIPTION
482
483Create a new Catalyst Component.
484
485=head1 AUTHOR
486
487Sebastian Riedel, C<sri\@oook.de>
488
489=head1 COPYRIGHT
490
491Copyright 2004 Sebastian Riedel. All rights reserved.
492
493This library is free software. You can redistribute it and/or modify it under
494the same terms as perl itself.
495
496=cut
497EOF
91864987 498 chmod 0700, "$script/create.pl";
fc7ec1d9 499}
500
fc7ec1d9 501sub _mk_compclass {
502 my $self = shift;
503 my $app = $self->{app};
504 my $class = $self->{class};
505 my $type = $self->{type};
506 my $action = '';
507 $action = <<"EOF" if $type eq 'C';
508
509$app->action(
510
511 '!?default' => sub {
512 my ( \$self, \$c ) = \@_;
513 \$c->res->output('Congratulations, $class is on Catalyst!');
514 },
515
516);
517EOF
518 my $file = $self->{file};
ad41e777 519 return $self->mk_file( "$file", <<"EOF");
fc7ec1d9 520package $class;
521
522use strict;
523use base 'Catalyst::Base';
524$action
525=head1 NAME
526
527$class - A Component
528
529=head1 SYNOPSIS
530
531 Very simple to use
532
533=head1 DESCRIPTION
534
535Very nice component.
536
537=head1 AUTHOR
538
539Clever guy
540
541=head1 LICENSE
542
543This library is free software . You can redistribute it and/or modify it under
544the same terms as perl itself.
545
546=cut
547
5481;
549EOF
550}
551
552sub _mk_comptest {
553 my $self = shift;
554 my $prefix = $self->{prefix};
555 my $type = $self->{type};
556 my $class = $self->{class};
557 my $app = $self->{app};
558 my $test = $self->{test};
fc7ec1d9 559 if ( $self->{type} eq 'C' ) {
ad41e777 560 $self->mk_file( "$test", <<"EOF");
fc7ec1d9 561use Test::More tests => 3;
562use_ok( Catalyst::Test, '$app' );
563use_ok('$class');
564
565ok( request('$prefix')->is_success );
566EOF
567 }
568 else {
ad41e777 569 $self->mk_file( "$test", <<"EOF");
fc7ec1d9 570use Test::More tests => 1;
571use_ok('$class');
572EOF
573 }
574}
575
7833fdfc 576=head1 HELPERS
577
578Helpers are classes that provide two methods.
579
580 * mk_compclass - creates the Component class
581 * mk_comptest - creates the Component test
582
583So when you call C<bin/create view MyView TT>, create would try to execute
584Catalyst::Helper::View::TT->mk_compclass and
585Catalyst::Helper::View::TT->mk_comptest.
586
587See L<Catalyst::Helper::View::TT> and L<Catalyst::Helper::Model::CDBI> for
588examples.
589
590All helper classes should be under one of the following namespaces.
591
592 Catalyst::Helper::Model::
593 Catalyst::Helper::View::
594 Catalyst::Helper::Controller::
595
fc7ec1d9 596=head1 SEE ALSO
597
598L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
599L<Catalyst::Response>, L<Catalyst>
600
601=head1 AUTHOR
602
603Sebastian Riedel, C<sri@oook.de>
604
605=head1 LICENSE
606
607This library is free software . You can redistribute it and/or modify it under
608the same terms as perl itself.
609
610=cut
611
6121;