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 =head1 DESCRIPTION
 196
 197 Run a Catalyst Testserver for this application.
 198
 199 =head1 AUTHOR
 200
 201 Sebastian Riedel, C<sri\@oook.de>
 202
 203 =head1 COPYRIGHT
 204
 205 Copyright 2004 Sebastian Riedel. All rights reserved.
 206
 207 This library is free software. You can redistribute it and/or modify it under
 208 the same terms as perl itself.
 209
 210 =cut
 211 EOF
 212     chmod 0700, "$bin/server";
 213 }
 214
 215 sub _mk_test {
 216     my $self = shift;
 217     my $name = $self->{name};
 218     my $bin  = $self->{bin};
 219     my $test = IO::File->new("> $bin/test")
 220       or die qq/Could't open "$bin\/test", "$!"/;
 221     print $test <<"EOF";
 222 #!/usr/bin/perl -w
 223
 224 use strict;
 225 use Getopt::Long;
 226 use Pod::Usage;
 227 use FindBin;
 228 use lib "\$FindBin::Bin/../lib";
 229
 230 my \$help = 0;
 231
 232 GetOptions( 'help|?' => \\\$help );
 233
 234 pod2usage(1) if ( \$help || !\$ARGV[0] );
 235
 236 require Catalyst::Test;
 237 import Catalyst::Test '$name';
 238
 239 print get(\$ARGV[0]) . "\n";
 240
 241 1;
 242 __END__
 243
 244 =head1 NAME
 245
 246 test - Catalyst Test
 247
 248 =head1 SYNOPSIS
 249
 250 test [options] uri
 251
 252  Options:
 253    -help    display this help and exits
 254
 255  Examples:
 256    test http://localhost/some_action
 257    test /some_action
 258
 259 =head1 DESCRIPTION
 260
 261 Run a Catalyst action from the comand line.
 262
 263 =head1 AUTHOR
 264
 265 Sebastian Riedel, C<sri\@oook.de>
 266
 267 =head1 COPYRIGHT
 268
 269 Copyright 2004 Sebastian Riedel. All rights reserved.
 270
 271 This library is free software. You can redistribute it and/or modify it under
 272 the same terms as perl itself.
 273
 274 =cut
 275 EOF
 276     chmod 0700, "$bin/test";
 277 }
 278
 279 sub _mk_create {
 280     my $self   = shift;
 281     my $name   = $self->{name};
 282     my $bin    = $self->{bin};
 283     my $create = IO::File->new("> $bin/create")
 284       or die qq/Could't open "$bin\/create", "$!"/;
 285     print $create <<"EOF";
 286 #!/usr/bin/perl -w
 287
 288 use strict;
 289 use Getopt::Long;
 290 use Pod::Usage;
 291 use Catalyst::Helper;
 292
 293 my \$help = 0;
 294
 295 GetOptions( 'help|?' => \$help );
 296
 297 pod2usage(1) if ( \$help || !\$ARGV[1] );
 298
 299 my \$helper = Catalyst::Helper->new;
 300 pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV );
 301
 302 1;
 303 __END__
 304
 305 =head1 NAME
 306
 307 create - Create a new Catalyst Component
 308
 309 =head1 SYNOPSIS
 310
 311 create [options] model|view|controller name
 312
 313  Options:
 314    -help    display this help and exits
 315
 316  Examples:
 317    create controller My::Controller
 318    create model My::Model
 319    create view My::View
 320
 321 =head1 DESCRIPTION
 322
 323 Create a new Catalyst Component.
 324
 325 =head1 AUTHOR
 326
 327 Sebastian Riedel, C<sri\@oook.de>
 328
 329 =head1 COPYRIGHT
 330
 331 Copyright 2004 Sebastian Riedel. All rights reserved.
 332
 333 This library is free software. You can redistribute it and/or modify it under
 334 the same terms as perl itself.
 335
 336 =cut
 337 EOF
 338     chmod 0700, "$bin/create";
 339 }
 340
 341 =head3 mk_component
 342
 343 =cut
 344
 345 sub mk_component {
 346     my ( $self, $app, $type, $name, $helper, @args ) = @_;
 347     return 0
 348       if ( $name =~ /[^\w\:]/ || !\$type =~ /^model|m|view|v|controller|c\$/i );
 349     return 0 if $name =~ /[^\w\:]/;
 350     $type = 'M' if $type =~ /model|m/i;
 351     $type = 'V' if $type =~ /view|v/i;
 352     $type = 'C' if $type =~ /controller|c/i;
 353     $self->{type}  = $type;
 354     $self->{name}  = $name;
 355     $self->{class} = "$app\::$type\::$name";
 356     $self->{app}   = $app;
 357
 358     # Class
 359     my $appdir = File::Spec->catdir( split /\:\:/, $app );
 360     my $path = File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type );
 361     my $file = $name;
 362     if ( $name =~ /\:/ ) {
 363         my @path = split /\:\:/, $name;
 364         $file = pop @path;
 365         $path = File::Spec->catdir( $path, @path );
 366         mkpath $path;
 367     }
 368     $file = File::Spec->catfile( $path, "$file.pm" );
 369     $self->{file} = $file;
 370
 371     # Test
 372     my $dir = File::Spec->catdir( $FindBin::Bin, '..', 't' );
 373     my $num = '01';
 374     for my $i (<$dir/*.t>) {
 375         $i =~ /(\d+)[^\/]*.t$/;
 376         my $j = $1 || $num;
 377         $num = $j if $j > $num;
 378     }
 379     $num++;
 380     $num = sprintf '%02d', $num;
 381     my $prefix = $name;
 382     $prefix =~ s/::/_/g;
 383     $prefix = lc $prefix;
 384     my $tname = lc( $num . $type . '_' . $prefix . '.t' );
 385     $self->{prefix}   = $prefix;
 386     $self->{test_dir} = $dir;
 387     $self->{test}     = "$dir/$tname";
 388
 389     # Helper
 390     if ($helper) {
 391         my $comp = 'Model';
 392         $comp = 'View'       if $type eq 'V';
 393         $comp = 'Controller' if $type eq 'C';
 394         my $class = "Catalyst::Helper::$comp\::$helper";
 395         eval "require $class";
 396         die qq/Couldn't load helper "$class", "$@"/ if $@;
 397         if ( $class->can('mk_compclass') ) {
 398             $class->mk_compclass( $self, @args );
 399         }
 400         else { $self->_mk_compclass }
 401
 402         if ( $class->can('mk_comptest') ) {
 403             $class->mk_comptest( $self, @args );
 404         }
 405         else { $self->_mk_comptest }
 406     }
 407
 408     # Fallback
 409     else {
 410         $self->_mk_compclass;
 411         $self->_mk_comptest;
 412     }
 413     return 1;
 414 }
 415
 416 sub _mk_compclass {
 417     my $self   = shift;
 418     my $app    = $self->{app};
 419     my $class  = $self->{class};
 420     my $type   = $self->{type};
 421     my $action = '';
 422     $action = <<"EOF" if $type eq 'C';
 423
 424 $app->action(
 425
 426     '!?default' => sub {
 427         my ( \$self, \$c ) = \@_;
 428         \$c->res->output('Congratulations, $class is on Catalyst!');
 429     },
 430
 431 );
 432 EOF
 433     my $file = $self->{file};
 434     my $comp = IO::File->new("> $file")
 435       or die qq/Couldn't open "$file", "$!"/;
 436     print $comp <<"EOF";
 437 package $class;
 438
 439 use strict;
 440 use base 'Catalyst::Base';
 441 $action
 442 =head1 NAME
 443
 444 $class - A Component
 445
 446 =head1 SYNOPSIS
 447
 448     Very simple to use
 449
 450 =head1 DESCRIPTION
 451
 452 Very nice component.
 453
 454 =head1 AUTHOR
 455
 456 Clever guy
 457
 458 =head1 LICENSE
 459
 460 This library is free software . You can redistribute it and/or modify it under
 461 the same terms as perl itself.
 462
 463 =cut
 464
 465 1;
 466 EOF
 467 }
 468
 469 sub _mk_comptest {
 470     my $self   = shift;
 471     my $prefix = $self->{prefix};
 472     my $type   = $self->{type};
 473     my $class  = $self->{class};
 474     my $app    = $self->{app};
 475     my $test   = $self->{test};
 476     my $t = IO::File->new("> $test") or die qq/Couldn't open "$test", "$!"/;
 477
 478     if ( $self->{type} eq 'C' ) {
 479         print $t <<"EOF";
 480 use Test::More tests => 3;
 481 use_ok( Catalyst::Test, '$app' );
 482 use_ok('$class');
 483
 484 ok( request('$prefix')->is_success );
 485 EOF
 486     }
 487     else {
 488         print $t <<"EOF";
 489 use Test::More tests => 1;
 490 use_ok('$class');
 491 EOF
 492     }
 493 }
 494
 495 =head1 SEE ALSO
 496
 497 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
 498 L<Catalyst::Response>, L<Catalyst>
 499
 500 =head1 AUTHOR
 501
 502 Sebastian Riedel, C<sri@oook.de>
 503
 504 =head1 LICENSE
 505
 506 This library is free software . You can redistribute it and/or modify it under
 507 the same terms as perl itself.
 508
 509 =cut
 510
 511 1;