lib/Catalyst/Helper.pm

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