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