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_apptest;
  38     $self->_mk_server;
  39     $self->_mk_test;
  40     $self->_mk_create;
  41     return 1;
  42 }
  43
  44 sub _mk_dirs {
  45     my $self = shift;
  46     mkpath $self->{dir} unless -d $self->{dir};
  47     $self->{bin} = File::Spec->catdir( $self->{dir}, 'bin' );
  48     mkpath $self->{bin};
  49     $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
  50     mkpath $self->{lib};
  51     $self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
  52     mkpath $self->{root};
  53     $self->{t} = File::Spec->catdir( $self->{dir}, 't' );
  54     mkpath $self->{t};
  55     $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
  56     $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
  57     mkpath $self->{mod};
  58     $self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
  59     mkpath $self->{m};
  60     $self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
  61     mkpath $self->{v};
  62     $self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
  63     mkpath $self->{c};
  64     $self->{base} = File::Spec->rel2abs( $self->{dir} );
  65 }
  66
  67 sub _mk_appclass {
  68     my $self  = shift;
  69     my $mod   = $self->{mod};
  70     my $name  = $self->{name};
  71     my $base  = $self->{base};
  72     my $class = IO::File->new("> $mod.pm")
  73       or die qq/Couldn't open "$mod.pm", "$!"/;
  74     print $class <<"EOF";
  75 package $name;
  76
  77 use strict;
  78 use Catalyst qw/-Debug/;
  79
  80 our \$VERSION = '0.01';
  81
  82 $name->config(
  83     name => '$name',
  84     root => '$base/root',
  85 );
  86
  87 $name->action(
  88
  89     '!default' => sub {
  90         my ( \$self, \$c ) = \@_;
  91         \$c->res->output('Congratulations, $name is on Catalyst!');
  92     },
  93
  94 );
  95
  96 =head1 NAME
  97
  98 $name - A very nice application
  99
 100 =head1 SYNOPSIS
 101
 102     Very simple to use
 103
 104 =head1 DESCRIPTION
 105
 106 Very nice application.
 107
 108 =head1 AUTHOR
 109
 110 Clever guy
 111
 112 =head1 LICENSE
 113
 114 This library is free software . You can redistribute it and/or modify it under
 115 the same terms as perl itself.
 116
 117 =cut
 118
 119 1;
 120 EOF
 121 }
 122
 123 sub _mk_makefile {
 124     my $self     = shift;
 125     my $name     = $self->{name};
 126     my $dir      = $self->{dir};
 127     my $class    = $self->{class};
 128     my $makefile = IO::File->new("> $dir/Makefile.PL")
 129       or die qq/Couldn't open "$dir\/Makefile.PL", "$!"/;
 130     print $makefile <<"EOF";
 131 use ExtUtils::MakeMaker;
 132
 133 WriteMakefile(
 134     NAME         => '$name',
 135     VERSION_FROM => 'lib/$class.pm',
 136     PREREQ_PM    => { Catalyst => 0 }
 137 );
 138 EOF
 139 }
 140
 141 sub _mk_apptest {
 142     my $self = shift;
 143     my $t    = $self->{t};
 144     my $name = $self->{name};
 145     my $test = IO::File->new("> $t/01app.t")
 146       or die qq/Couldn't open "$t\/01app.t", "$!"/;
 147     print $test <<"EOF";
 148 use Test::More tests => 2;
 149 use_ok( Catalyst::Test, '$name' );
 150
 151 ok( request('/')->is_success );
 152 EOF
 153 }
 154
 155 sub _mk_server {
 156     my $self   = shift;
 157     my $name   = $self->{name};
 158     my $bin    = $self->{bin};
 159     my $server = IO::File->new("> $bin/server")
 160       or die qq/Could't open "$bin\/server", "$!"/;
 161     print $server <<"EOF";
 162 #!/usr/bin/perl -w
 163
 164 use strict;
 165 use Getopt::Long;
 166 use Pod::Usage;
 167 use FindBin;
 168 use lib "\$FindBin::Bin/../lib";
 169 use Catalyst::Test '$name';
 170
 171 my \$help = 0;
 172 my \$port = 3000;
 173
 174 GetOptions( 'help|?' => \\\$help, 'port=s' => \\\$port );
 175
 176 pod2usage(1) if \$help;
 177
 178 Catalyst::Test::server(\$port);
 179
 180 1;
 181 __END__
 182
 183 =head1 NAME
 184
 185 server - Catalyst Testserver
 186
 187 =head1 SYNOPSIS
 188
 189 server [options]
 190
 191  Options:
 192    -help    display this help and exits
 193    -port    port (defaults to 3000)
 194
 195  See also:
 196    perldoc Catalyst::Manual
 197    perldoc Catalyst::Manual::Intro
 198
 199 =head1 DESCRIPTION
 200
 201 Run a Catalyst Testserver for this application.
 202
 203 =head1 AUTHOR
 204
 205 Sebastian Riedel, C<sri\@oook.de>
 206
 207 =head1 COPYRIGHT
 208
 209 Copyright 2004 Sebastian Riedel. All rights reserved.
 210
 211 This library is free software. You can redistribute it and/or modify it under
 212 the same terms as perl itself.
 213
 214 =cut
 215 EOF
 216     chmod 0700, "$bin/server";
 217 }
 218
 219 sub _mk_test {
 220     my $self = shift;
 221     my $name = $self->{name};
 222     my $bin  = $self->{bin};
 223     my $test = IO::File->new("> $bin/test")
 224       or die qq/Could't open "$bin\/test", "$!"/;
 225     print $test <<"EOF";
 226 #!/usr/bin/perl -w
 227
 228 use strict;
 229 use Getopt::Long;
 230 use Pod::Usage;
 231 use FindBin;
 232 use lib "\$FindBin::Bin/../lib";
 233
 234 my \$help = 0;
 235
 236 GetOptions( 'help|?' => \\\$help );
 237
 238 pod2usage(1) if ( \$help || !\$ARGV[0] );
 239
 240 require Catalyst::Test;
 241 import Catalyst::Test '$name';
 242
 243 print get(\$ARGV[0]) . "\n";
 244
 245 1;
 246 __END__
 247
 248 =head1 NAME
 249
 250 test - Catalyst Test
 251
 252 =head1 SYNOPSIS
 253
 254 test [options] uri
 255
 256  Options:
 257    -help    display this help and exits
 258
 259  Examples:
 260    test http://localhost/some_action
 261    test /some_action
 262
 263  See also:
 264    perldoc Catalyst::Manual
 265    perldoc Catalyst::Manual::Intro
 266
 267 =head1 DESCRIPTION
 268
 269 Run a Catalyst action from the comand line.
 270
 271 =head1 AUTHOR
 272
 273 Sebastian Riedel, C<sri\@oook.de>
 274
 275 =head1 COPYRIGHT
 276
 277 Copyright 2004 Sebastian Riedel. All rights reserved.
 278
 279 This library is free software. You can redistribute it and/or modify it under
 280 the same terms as perl itself.
 281
 282 =cut
 283 EOF
 284     chmod 0700, "$bin/test";
 285 }
 286
 287 sub _mk_create {
 288     my $self   = shift;
 289     my $name   = $self->{name};
 290     my $bin    = $self->{bin};
 291     my $create = IO::File->new("> $bin/create")
 292       or die qq/Could't open "$bin\/create", "$!"/;
 293     print $create <<"EOF";
 294 #!/usr/bin/perl -w
 295
 296 use strict;
 297 use Getopt::Long;
 298 use Pod::Usage;
 299 use Catalyst::Helper;
 300
 301 my \$help = 0;
 302
 303 GetOptions( 'help|?' => \$help );
 304
 305 pod2usage(1) if ( \$help || !\$ARGV[1] );
 306
 307 my \$helper = Catalyst::Helper->new;
 308 pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV );
 309
 310 1;
 311 __END__
 312
 313 =head1 NAME
 314
 315 create - Create a new Catalyst Component
 316
 317 =head1 SYNOPSIS
 318
 319 create [options] model|view|controller name [helper] [options]
 320
 321  Options:
 322    -help    display this help and exits
 323
 324  Examples:
 325    create controller My::Controller
 326    create view My::View
 327    create view MyView TT
 328    create view TT TT
 329    create model My::Model
 330    create model SomeDB CDBI dbi:SQLite:/tmp/my.db
 331    create model AnotherDB CDBI dbi:Pg:dbname=foo root 4321
 332
 333  See also:
 334    perldoc Catalyst::Manual
 335    perldoc Catalyst::Manual::Intro
 336
 337 =head1 DESCRIPTION
 338
 339 Create a new Catalyst Component.
 340
 341 =head1 AUTHOR
 342
 343 Sebastian Riedel, C<sri\@oook.de>
 344
 345 =head1 COPYRIGHT
 346
 347 Copyright 2004 Sebastian Riedel. All rights reserved.
 348
 349 This library is free software. You can redistribute it and/or modify it under
 350 the same terms as perl itself.
 351
 352 =cut
 353 EOF
 354     chmod 0700, "$bin/create";
 355 }
 356
 357 =head3 mk_component
 358
 359 =cut
 360
 361 sub mk_component {
 362     my ( $self, $app, $type, $name, $helper, @args ) = @_;
 363     return 0
 364       if ( $name =~ /[^\w\:]/ || !\$type =~ /^model|m|view|v|controller|c\$/i );
 365     return 0 if $name =~ /[^\w\:]/;
 366     $type = 'M' if $type =~ /model|m/i;
 367     $type = 'V' if $type =~ /view|v/i;
 368     $type = 'C' if $type =~ /controller|c/i;
 369     $self->{type}  = $type;
 370     $self->{name}  = $name;
 371     $self->{class} = "$app\::$type\::$name";
 372     $self->{app}   = $app;
 373
 374     # Class
 375     my $appdir = File::Spec->catdir( split /\:\:/, $app );
 376     my $path = File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type );
 377     my $file = $name;
 378     if ( $name =~ /\:/ ) {
 379         my @path = split /\:\:/, $name;
 380         $file = pop @path;
 381         $path = File::Spec->catdir( $path, @path );
 382         mkpath $path;
 383     }
 384     $file = File::Spec->catfile( $path, "$file.pm" );
 385     $self->{file} = $file;
 386
 387     # Test
 388     my $dir = File::Spec->catdir( $FindBin::Bin, '..', 't' );
 389     my $num = '01';
 390     for my $i (<$dir/*.t>) {
 391         $i =~ /(\d+)[^\/]*.t$/;
 392         my $j = $1 || $num;
 393         $num = $j if $j > $num;
 394     }
 395     $num++;
 396     $num = sprintf '%02d', $num;
 397     my $prefix = $name;
 398     $prefix =~ s/::/_/g;
 399     $prefix = lc $prefix;
 400     my $tname = lc( $num . $type . '_' . $prefix . '.t' );
 401     $self->{prefix}   = $prefix;
 402     $self->{test_dir} = $dir;
 403     $self->{test}     = "$dir/$tname";
 404
 405     # Helper
 406     if ($helper) {
 407         my $comp = 'Model';
 408         $comp = 'View'       if $type eq 'V';
 409         $comp = 'Controller' if $type eq 'C';
 410         my $class = "Catalyst::Helper::$comp\::$helper";
 411         eval "require $class";
 412         die qq/Couldn't load helper "$class", "$@"/ if $@;
 413         if ( $class->can('mk_compclass') ) {
 414             $class->mk_compclass( $self, @args );
 415         }
 416         else { $self->_mk_compclass }
 417
 418         if ( $class->can('mk_comptest') ) {
 419             $class->mk_comptest( $self, @args );
 420         }
 421         else { $self->_mk_comptest }
 422     }
 423
 424     # Fallback
 425     else {
 426         $self->_mk_compclass;
 427         $self->_mk_comptest;
 428     }
 429     return 1;
 430 }
 431
 432 sub _mk_compclass {
 433     my $self   = shift;
 434     my $app    = $self->{app};
 435     my $class  = $self->{class};
 436     my $type   = $self->{type};
 437     my $action = '';
 438     $action = <<"EOF" if $type eq 'C';
 439
 440 $app->action(
 441
 442     '!?default' => sub {
 443         my ( \$self, \$c ) = \@_;
 444         \$c->res->output('Congratulations, $class is on Catalyst!');
 445     },
 446
 447 );
 448 EOF
 449     my $file = $self->{file};
 450     my $comp = IO::File->new("> $file")
 451       or die qq/Couldn't open "$file", "$!"/;
 452     print $comp <<"EOF";
 453 package $class;
 454
 455 use strict;
 456 use base 'Catalyst::Base';
 457 $action
 458 =head1 NAME
 459
 460 $class - A Component
 461
 462 =head1 SYNOPSIS
 463
 464     Very simple to use
 465
 466 =head1 DESCRIPTION
 467
 468 Very nice component.
 469
 470 =head1 AUTHOR
 471
 472 Clever guy
 473
 474 =head1 LICENSE
 475
 476 This library is free software . You can redistribute it and/or modify it under
 477 the same terms as perl itself.
 478
 479 =cut
 480
 481 1;
 482 EOF
 483 }
 484
 485 sub _mk_comptest {
 486     my $self   = shift;
 487     my $prefix = $self->{prefix};
 488     my $type   = $self->{type};
 489     my $class  = $self->{class};
 490     my $app    = $self->{app};
 491     my $test   = $self->{test};
 492     my $t = IO::File->new("> $test") or die qq/Couldn't open "$test", "$!"/;
 493
 494     if ( $self->{type} eq 'C' ) {
 495         print $t <<"EOF";
 496 use Test::More tests => 3;
 497 use_ok( Catalyst::Test, '$app' );
 498 use_ok('$class');
 499
 500 ok( request('$prefix')->is_success );
 501 EOF
 502     }
 503     else {
 504         print $t <<"EOF";
 505 use Test::More tests => 1;
 506 use_ok('$class');
 507 EOF
 508     }
 509 }
 510
 511 =head1 SEE ALSO
 512
 513 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
 514 L<Catalyst::Response>, L<Catalyst>
 515
 516 =head1 AUTHOR
 517
 518 Sebastian Riedel, C<sri@oook.de>
 519
 520 =head1 LICENSE
 521
 522 This library is free software . You can redistribute it and/or modify it under
 523 the same terms as perl itself.
 524
 525 =cut
 526
 527 1;