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