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