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