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