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