lib/Catalyst/Helper.pm

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