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