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