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