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