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