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     my $dir = $self->{test_dir};
 149     my $num = '01';
 150     for my $i (<$dir/*.t>) {
 151         $i =~ /(\d+)[^\/]*.t$/;
 152         my $j = $1 || $num;
 153         $num = $j if $j > $num;
 154     }
 155     $num++;
 156     $num = sprintf '%02d', $num;
 157     if ($tname) { $tname = "$num$tname.t" }
 158     else {
 159         my $name   = $self->{name};
 160         my $type   = $self->{type};
 161         my $prefix = $name;
 162         $prefix =~ s/::/_/g;
 163         $prefix         = lc $prefix;
 164         $tname          = lc( $num . $type . '_' . $prefix . '.t' );
 165         $self->{prefix} = $prefix;
 166     }
 167     return "$dir/$tname";
 168 }
 169
 170 sub _mk_dirs {
 171     my $self = shift;
 172     $self->mk_dir( $self->{dir} );
 173     $self->{script} = File::Spec->catdir( $self->{dir}, 'script' );
 174     $self->mk_dir( $self->{script} );
 175     $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
 176     $self->mk_dir( $self->{lib} );
 177     $self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
 178     $self->mk_dir( $self->{root} );
 179     $self->{t} = File::Spec->catdir( $self->{dir}, 't' );
 180     $self->mk_dir( $self->{t} );
 181     $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
 182     $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
 183     $self->mk_dir( $self->{mod} );
 184     $self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
 185     $self->mk_dir( $self->{m} );
 186     $self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
 187     $self->mk_dir( $self->{v} );
 188     $self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
 189     $self->mk_dir( $self->{c} );
 190     $self->{base} = File::Spec->rel2abs( $self->{dir} );
 191 }
 192
 193 sub _mk_appclass {
 194     my $self = shift;
 195     my $mod  = $self->{mod};
 196     my $name = $self->{name};
 197     my $base = $self->{base};
 198     $self->mk_file( "$mod.pm", <<"EOF");
 199 package $name;
 200
 201 use strict;
 202 use Catalyst qw/-Debug/;
 203
 204 our \$VERSION = '0.01';
 205
 206 $name->config(
 207     name => '$name',
 208     root => '$base/root',
 209 );
 210
 211 $name->action(
 212
 213     '!default' => sub {
 214         my ( \$self, \$c ) = \@_;
 215         \$c->res->output('Congratulations, $name is on Catalyst!');
 216     },
 217
 218 );
 219
 220 =head1 NAME
 221
 222 $name - A very nice application
 223
 224 =head1 SYNOPSIS
 225
 226     Very simple to use
 227
 228 =head1 DESCRIPTION
 229
 230 Very nice application.
 231
 232 =head1 AUTHOR
 233
 234 Clever guy
 235
 236 =head1 LICENSE
 237
 238 This library is free software . You can redistribute it and/or modify it under
 239 the same terms as perl itself.
 240
 241 =cut
 242
 243 1;
 244 EOF
 245 }
 246
 247 sub _mk_makefile {
 248     my $self  = shift;
 249     my $name  = $self->{name};
 250     my $dir   = $self->{dir};
 251     my $class = $self->{class};
 252     $self->mk_file( "$dir\/Makefile.PL", <<"EOF");
 253 use ExtUtils::MakeMaker;
 254
 255 WriteMakefile(
 256     NAME         => '$name',
 257     VERSION_FROM => 'lib/$class.pm',
 258     PREREQ_PM    => { Catalyst => 0 }
 259 );
 260 EOF
 261 }
 262
 263 sub _mk_readme {
 264     my $self = shift;
 265     my $dir  = $self->{dir};
 266     $self->mk_file( "$dir\/README", <<"EOF");
 267 Run script/server.pl to test the application.
 268 EOF
 269 }
 270
 271 sub _mk_changes {
 272     my $self = shift;
 273     my $name = $self->{name};
 274     my $dir  = $self->{dir};
 275     my $time = localtime time;
 276     $self->mk_file( "$dir\/Changes", <<"EOF");
 277 This file documents the revision history for Perl extension $name.
 278
 279 0.01  $time
 280         - initial revision, generated by Catalyst
 281 EOF
 282 }
 283
 284 sub _mk_apptest {
 285     my $self = shift;
 286     my $t    = $self->{t};
 287     my $name = $self->{name};
 288     $self->mk_file( "$t\/01app.t", <<"EOF");
 289 use Test::More tests => 2;
 290 use_ok( Catalyst::Test, '$name' );
 291
 292 ok( request('/')->is_success );
 293 EOF
 294     $self->mk_file( "$t\/02podcoverage.t", <<"EOF");
 295 use Test::More;
 296
 297 eval "use Test::Pod::Coverage 1.04";
 298 plan skip_all => 'Test::Pod::Coverage 1.04 required' if \$@;
 299 plan skip_all => 'set TEST_POD to enable this test' unless \$ENV{TEST_POD};
 300
 301 all_pod_coverage_ok();
 302 EOF
 303 }
 304
 305 sub _mk_server {
 306     my $self   = shift;
 307     my $name   = $self->{name};
 308     my $script = $self->{script};
 309     $self->mk_file( "$script\/server.pl", <<"EOF");
 310 #!/usr/bin/perl -w
 311
 312 use strict;
 313 use Getopt::Long;
 314 use Pod::Usage;
 315 use FindBin;
 316 use lib "\$FindBin::Bin/../lib";
 317 use Catalyst::Test '$name';
 318
 319 my \$help = 0;
 320 my \$port = 3000;
 321
 322 GetOptions( 'help|?' => \\\$help, 'port=s' => \\\$port );
 323
 324 pod2usage(1) if \$help;
 325
 326 Catalyst::Test::server(\$port);
 327
 328 1;
 329 __END__
 330
 331 =head1 NAME
 332
 333 server - Catalyst Testserver
 334
 335 =head1 SYNOPSIS
 336
 337 server.pl [options]
 338
 339  Options:
 340    -? -help    display this help and exits
 341    -p -port    port (defaults to 3000)
 342
 343  See also:
 344    perldoc Catalyst::Manual
 345    perldoc Catalyst::Manual::Intro
 346
 347 =head1 DESCRIPTION
 348
 349 Run a Catalyst Testserver for this application.
 350
 351 =head1 AUTHOR
 352
 353 Sebastian Riedel, C<sri\@oook.de>
 354
 355 =head1 COPYRIGHT
 356
 357 Copyright 2004 Sebastian Riedel. All rights reserved.
 358
 359 This library is free software. You can redistribute it and/or modify it under
 360 the same terms as perl itself.
 361
 362 =cut
 363 EOF
 364     chmod 0700, "$script/server.pl";
 365 }
 366
 367 sub _mk_test {
 368     my $self   = shift;
 369     my $name   = $self->{name};
 370     my $script = $self->{script};
 371     $self->mk_file( "$script/test.pl", <<"EOF");
 372 #!/usr/bin/perl -w
 373
 374 use strict;
 375 use Getopt::Long;
 376 use Pod::Usage;
 377 use FindBin;
 378 use lib "\$FindBin::Bin/../lib";
 379
 380 my \$help = 0;
 381
 382 GetOptions( 'help|?' => \\\$help );
 383
 384 pod2usage(1) if ( \$help || !\$ARGV[0] );
 385
 386 require Catalyst::Test;
 387 import Catalyst::Test '$name';
 388
 389 print get(\$ARGV[0]) . "\n";
 390
 391 1;
 392 __END__
 393
 394 =head1 NAME
 395
 396 test - Catalyst Test
 397
 398 =head1 SYNOPSIS
 399
 400 test.pl [options] uri
 401
 402  Options:
 403    -help    display this help and exits
 404
 405  Examples:
 406    test.pl http://localhost/some_action
 407    test.pl /some_action
 408
 409  See also:
 410    perldoc Catalyst::Manual
 411    perldoc Catalyst::Manual::Intro
 412
 413 =head1 DESCRIPTION
 414
 415 Run a Catalyst action from the comand line.
 416
 417 =head1 AUTHOR
 418
 419 Sebastian Riedel, C<sri\@oook.de>
 420
 421 =head1 COPYRIGHT
 422
 423 Copyright 2004 Sebastian Riedel. All rights reserved.
 424
 425 This library is free software. You can redistribute it and/or modify it under
 426 the same terms as perl itself.
 427
 428 =cut
 429 EOF
 430     chmod 0700, "$script/test.pl";
 431 }
 432
 433 sub _mk_create {
 434     my $self   = shift;
 435     my $name   = $self->{name};
 436     my $script = $self->{script};
 437     $self->mk_file( "$script\/create.pl", <<"EOF");
 438 #!/usr/bin/perl -w
 439
 440 use strict;
 441 use Getopt::Long;
 442 use Pod::Usage;
 443 use Catalyst::Helper;
 444
 445 my \$help = 0;
 446
 447 GetOptions( 'help|?' => \$help );
 448
 449 pod2usage(1) if ( \$help || !\$ARGV[1] );
 450
 451 my \$helper = Catalyst::Helper->new;
 452 pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV );
 453
 454 1;
 455 __END__
 456
 457 =head1 NAME
 458
 459 create - Create a new Catalyst Component
 460
 461 =head1 SYNOPSIS
 462
 463 create.pl [options] model|view|controller name [helper] [options]
 464
 465  Options:
 466    -help    display this help and exits
 467
 468  Examples:
 469    create.pl controller My::Controller
 470    create.pl view My::View
 471    create.pl view MyView TT
 472    create.pl view TT TT
 473    create.pl model My::Model
 474    create.pl model SomeDB CDBI dbi:SQLite:/tmp/my.db
 475    create.pl model AnotherDB CDBI dbi:Pg:dbname=foo root 4321
 476
 477  See also:
 478    perldoc Catalyst::Manual
 479    perldoc Catalyst::Manual::Intro
 480
 481 =head1 DESCRIPTION
 482
 483 Create a new Catalyst Component.
 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 EOF
 498     chmod 0700, "$script/create.pl";
 499 }
 500
 501 sub _mk_compclass {
 502     my $self   = shift;
 503     my $app    = $self->{app};
 504     my $class  = $self->{class};
 505     my $type   = $self->{type};
 506     my $action = '';
 507     $action = <<"EOF" if $type eq 'C';
 508
 509 $app->action(
 510
 511     '!?default' => sub {
 512         my ( \$self, \$c ) = \@_;
 513         \$c->res->output('Congratulations, $class is on Catalyst!');
 514     },
 515
 516 );
 517 EOF
 518     my $file = $self->{file};
 519     return $self->mk_file( "$file", <<"EOF");
 520 package $class;
 521
 522 use strict;
 523 use base 'Catalyst::Base';
 524 $action
 525 =head1 NAME
 526
 527 $class - A Component
 528
 529 =head1 SYNOPSIS
 530
 531     Very simple to use
 532
 533 =head1 DESCRIPTION
 534
 535 Very nice component.
 536
 537 =head1 AUTHOR
 538
 539 Clever guy
 540
 541 =head1 LICENSE
 542
 543 This library is free software . You can redistribute it and/or modify it under
 544 the same terms as perl itself.
 545
 546 =cut
 547
 548 1;
 549 EOF
 550 }
 551
 552 sub _mk_comptest {
 553     my $self   = shift;
 554     my $prefix = $self->{prefix};
 555     my $type   = $self->{type};
 556     my $class  = $self->{class};
 557     my $app    = $self->{app};
 558     my $test   = $self->{test};
 559     if ( $self->{type} eq 'C' ) {
 560         $self->mk_file( "$test", <<"EOF");
 561 use Test::More tests => 3;
 562 use_ok( Catalyst::Test, '$app' );
 563 use_ok('$class');
 564
 565 ok( request('$prefix')->is_success );
 566 EOF
 567     }
 568     else {
 569         $self->mk_file( "$test", <<"EOF");
 570 use Test::More tests => 1;
 571 use_ok('$class');
 572 EOF
 573     }
 574 }
 575
 576 =head1 HELPERS
 577
 578 Helpers are classes that provide two methods.
 579
 580     * mk_compclass - creates the Component class
 581     * mk_comptest  - creates the Component test
 582
 583 So when you call C<bin/create view MyView TT>, create would try to execute
 584 Catalyst::Helper::View::TT->mk_compclass and
 585 Catalyst::Helper::View::TT->mk_comptest.
 586
 587 See L<Catalyst::Helper::View::TT> and L<Catalyst::Helper::Model::CDBI> for
 588 examples.
 589
 590 All helper classes should be under one of the following namespaces.
 591
 592     Catalyst::Helper::Model::
 593     Catalyst::Helper::View::
 594     Catalyst::Helper::Controller::
 595
 596 =head1 SEE ALSO
 597
 598 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
 599 L<Catalyst::Response>, L<Catalyst>
 600
 601 =head1 AUTHOR
 602
 603 Sebastian Riedel, C<sri@oook.de>
 604
 605 =head1 LICENSE
 606
 607 This library is free software . You can redistribute it and/or modify it under
 608 the same terms as perl itself.
 609
 610 =cut
 611
 612 1;