lib/Catalyst/Helper.pm

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