lib/Catalyst/Helper.pm

   1 package Catalyst::Helper;
   2
   3 use Moose;
   4 use Config;
   5 use File::Spec;
   6 use File::Path;
   7 use FindBin;
   8 use IO::File;
   9 use POSIX 'strftime';
  10 use Template;
  11 use Catalyst::Devel;
  12 use Catalyst::Utils;
  13 use Catalyst::Exception;
  14 use Path::Class qw/dir file/;
  15 use File::ShareDir qw/dist_dir/;
  16 use MooseX::Types::Moose qw/Str Bool Int/;
  17
  18 with 'MooseX::Getopt';
  19
  20
  21 my %cache;
  22
  23 =head1 NAME
  24
  25 Catalyst::Helper - Bootstrap a Catalyst application
  26
  27 =head1 SYNOPSIS
  28
  29   catalyst.pl <myappname>
  30
  31 =cut
  32
  33
  34 ## this stays in Helper.pm #####################################################
  35 sub get_sharedir_file {
  36     my ($self, @filename) = @_;
  37     my $dist_dir;
  38     if (-d dir("inc", ".author") { # Can't use sharedir if we're in a checkout
  39                             # this feels horrible, better ideas?
  40         $dist_dir = 'share';
  41     }
  42     else {
  43         $dist_dir = dist_dir('Catalyst-Devel');
  44     }
  45     my $file = file( $dist_dir, @filename);
  46     my $contents = $file->slurp;
  47     return $contents;
  48 }
  49
  50 # Do not touch this method, *EVER*, it is needed for back compat.
  51 sub get_file {
  52     my ( $self, $class, $file ) = @_;
  53     unless ( $cache{$class} ) {
  54         local $/;
  55         $cache{$class} = eval "package $class; <DATA>";
  56     }
  57     my $data = $cache{$class};
  58     Carp::confess("Could not get data from __DATA__ segment for $class")
  59         unless $data;
  60     my @files = split /^__(.+)__\r?\n/m, $data;
  61     shift @files;
  62     while (@files) {
  63         my ( $name, $content ) = splice @files, 0, 2;
  64         return $content if $name eq $file;
  65     }
  66     return 0;
  67 }
  68
  69 ################################################################################
  70
  71
  72 sub mk_dir {
  73     my ( $self, $dir ) = @_;
  74     if ( -d $dir ) {
  75         print qq/ exists "$dir"\n/;
  76         return 0;
  77     }
  78     if ( mkpath [$dir] ) {
  79         print qq/created "$dir"\n/;
  80         return 1;
  81     }
  82
  83     Catalyst::Exception->throw( message => qq/Couldn't create "$dir", "$!"/ );
  84 }
  85
  86 sub mk_file {
  87     my ( $self, $file, $content ) = @_;
  88     if ( -e $file && -s _ ) {
  89         print qq/ exists "$file"\n/;
  90         return 0
  91           unless ( $self->{'.newfiles'}
  92             || $self->{scripts}
  93             || $self->{makefile} );
  94         if ( $self->{'.newfiles'} ) {
  95             if ( my $f = IO::File->new("< $file") ) {
  96                 my $oldcontent = join( '', (<$f>) );
  97                 return 0 if $content eq $oldcontent;
  98             }
  99             $file .= '.new';
 100         }
 101     }
 102     if ( my $f = IO::File->new("> $file") ) {
 103         binmode $f;
 104         print $f $content;
 105         print qq/created "$file"\n/;
 106         return 1;
 107     }
 108
 109     Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ );
 110 }
 111
 112 sub next_test {
 113     my ( $self, $tname ) = @_;
 114     if ($tname) { $tname = "$tname.t" }
 115     else {
 116         my $name   = $self->{name};
 117         my $prefix = $name;
 118         $prefix =~ s/::/-/g;
 119         $prefix         = $prefix;
 120         $tname          = $prefix . '.t';
 121         $self->{prefix} = $prefix;
 122         $prefix         = lc $prefix;
 123         $prefix =~ s/-/\//g;
 124         $self->{uri} = "/$prefix";
 125     }
 126     my $dir  = $self->{test_dir};
 127     my $type = lc $self->{type};
 128     $self->mk_dir($dir);
 129     return File::Spec->catfile( $dir, "$type\_$tname" );
 130 }
 131
 132 # Do not touch this method, *EVER*, it is needed for back compat. ##############
 133 ## addendum: we had to split this method so we could have backwards
 134 ## compatability.  otherwise, we'd have no way to pass stuff from __DATA__
 135 sub render_file {
 136     my ( $self, $file, $path, $vars ) = @_;
 137     my $template = $self->get_file( ( caller(0) )[0], $file );
 138     $self->render_file_contents($template, $path, $vars);
 139 }
 140 ################################################################################
 141
 142 sub render_sharedir_file {
 143     my ( $self, $file, $path, $vars ) = @_;
 144     my $template = $self->get_sharedir_file( $file );
 145     $self->render_file_contents($template, $path, $vars);
 146 }
 147
 148 sub render_file_contents {
 149     my ( $self, $template, $path, $vars ) = @_;
 150     $vars ||= {};
 151     my $t = Template->new;
 152     return 0 unless $template;
 153     my $output;
 154     $t->process( \$template, { %{$self}, %$vars }, \$output )
 155       || Catalyst::Exception->throw(
 156         message => qq/Couldn't process "$template", / . $t->error() );
 157     $self->mk_file( $path, $output );
 158 }
 159
 160 # DIE DIE DIE
 161 sub _mk_information {
 162     my $self = shift;
 163     print qq/Change to application directory and Run "perl Makefile.PL" to make sure your install is complete\n/;
 164 }
 165
 166 sub _mk_dirs {
 167     my $self = shift;
 168     $self->mk_dir( $self->{dir} );
 169     $self->mk_dir( $self->{script} );
 170     $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
 171     $self->mk_dir( $self->{lib} );
 172     $self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
 173     $self->mk_dir( $self->{root} );
 174     $self->{static} = File::Spec->catdir( $self->{root}, 'static' );
 175     $self->mk_dir( $self->{static} );
 176     $self->{images} = File::Spec->catdir( $self->{static}, 'images' );
 177     $self->mk_dir( $self->{images} );
 178     $self->{t} = File::Spec->catdir( $self->{dir}, 't' );
 179     $self->mk_dir( $self->{t} );
 180
 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
 185     if ( $self->{short} ) {
 186         $self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
 187         $self->mk_dir( $self->{m} );
 188         $self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
 189         $self->mk_dir( $self->{v} );
 190         $self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
 191         $self->mk_dir( $self->{c} );
 192     }
 193     else {
 194         $self->{m} = File::Spec->catdir( $self->{mod}, 'Model' );
 195         $self->mk_dir( $self->{m} );
 196         $self->{v} = File::Spec->catdir( $self->{mod}, 'View' );
 197         $self->mk_dir( $self->{v} );
 198         $self->{c} = File::Spec->catdir( $self->{mod}, 'Controller' );
 199         $self->mk_dir( $self->{c} );
 200     }
 201     my $name = $self->{name};
 202     $self->{rootname} =
 203       $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root";
 204     $self->{base} = File::Spec->rel2abs( $self->{dir} );
 205 }
 206
 207 # DIE DIE DIE
 208 sub _mk_appclass {
 209     my $self = shift;
 210     my $mod  = $self->{mod};
 211     $self->render_sharedir_file( File::Spec->catfile('lib', 'MyApp.pm.tt'), "$mod.pm" );
 212 }
 213
 214 # DIE DIE DIE
 215 sub _mk_rootclass {
 216     my $self = shift;
 217     $self->render_sharedir_file( File::Spec->catfile('lib', 'MyApp', 'Controller', 'Root.pm.tt'),
 218         File::Spec->catfile( $self->{c}, "Root.pm" ) );
 219 }
 220
 221 # DIE DIE DIE
 222 sub _mk_makefile {
 223     my $self = shift;
 224     $self->{path} = File::Spec->catfile( 'lib', split( '::', $self->{name} ) );
 225     $self->{path} .= '.pm';
 226     my $dir = $self->{dir};
 227     $self->render_sharedir_file( 'Makefile.PL.tt', "$dir\/Makefile.PL" );
 228
 229     if ( $self->{makefile} ) {
 230
 231         # deprecate the old Build.PL file when regenerating Makefile.PL
 232         $self->_deprecate_file(
 233             File::Spec->catdir( $self->{dir}, 'Build.PL' ) );
 234     }
 235 }
 236
 237 # DIE DIE DIE
 238 sub _mk_config {
 239     my $self      = shift;
 240     my $dir       = $self->{dir};
 241     my $appprefix = $self->{appprefix};
 242     $self->render_sharedir_file( 'myapp.conf.tt',
 243         File::Spec->catfile( $dir, "$appprefix.conf" ) );
 244 }
 245
 246 # DIE DIE DIE
 247 sub _mk_readme {
 248     my $self = shift;
 249     my $dir  = $self->{dir};
 250     $self->render_sharedir_file( 'README.tt', "$dir\/README" );
 251 }
 252
 253 # DIE DIE DIE
 254 sub _mk_changes {
 255     my $self = shift;
 256     my $dir  = $self->{dir};
 257     my $time = strftime('%Y-%m-%d %H:%M:%S', localtime time);
 258     $self->render_sharedir_file( 'Changes.tt', "$dir\/Changes", { time => $time } );
 259 }
 260
 261 sub _mk_apptest {
 262     my $self = shift;
 263     my $t    = $self->{t};
 264     $self->render_sharedir_file( File::Spec->catfile('t', '01app.t.tt'),         "$t\/01app.t" );
 265     $self->render_sharedir_file( File::Spec->catfile('t', '02pod.t.tt'),         "$t\/02pod.t" );
 266     $self->render_sharedir_file( File::Spec->catfile('t', '03podcoverage.t.tt'), "$t\/03podcoverage.t" );
 267 }
 268
 269 sub _mk_cgi {
 270     my $self      = shift;
 271     my $script    = $self->{script};
 272     my $appprefix = $self->{appprefix};
 273     $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_cgi.pl.tt'), "$script\/$appprefix\_cgi.pl" );
 274     chmod 0700, "$script/$appprefix\_cgi.pl";
 275 }
 276
 277 sub _mk_fastcgi {
 278     my $self      = shift;
 279     my $script    = $self->{script};
 280     my $appprefix = $self->{appprefix};
 281     $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_fastcgi.pl.tt'), "$script\/$appprefix\_fastcgi.pl" );
 282     chmod 0700, "$script/$appprefix\_fastcgi.pl";
 283 }
 284
 285 sub _mk_server {
 286     my $self      = shift;
 287     my $script    = $self->{script};
 288     my $appprefix = $self->{appprefix};
 289     $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_server.pl.tt'), "$script\/$appprefix\_server.pl" );
 290     chmod 0700, "$script/$appprefix\_server.pl";
 291 }
 292
 293 sub _mk_test {
 294     my $self      = shift;
 295     my $script    = $self->{script};
 296     my $appprefix = $self->{appprefix};
 297     $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_test.pl.tt'), "$script/$appprefix\_test.pl" );
 298     chmod 0700, "$script/$appprefix\_test.pl";
 299 }
 300
 301 sub _mk_create {
 302     my $self      = shift;
 303     my $script    = $self->{script};
 304     my $appprefix = $self->{appprefix};
 305     $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_create.pl.tt'), "$script\/$appprefix\_create.pl" );
 306     chmod 0700, "$script/$appprefix\_create.pl";
 307 }
 308
 309 # DIE DIE DIE
 310 sub _mk_compclass {
 311     my $self = shift;
 312     my $file = $self->{file};
 313     return $self->render_sharedir_file( 'myapp_compclass.pl.tt', "$file" );
 314 }
 315
 316 # DIE DIE DIE
 317 sub _mk_comptest {
 318     my $self = shift;
 319     my $test = $self->{test};
 320     $self->render_sharedir_file( 'comptest.tt', "$test" );  ## wtf do i rename this to?
 321 }
 322
 323 sub _mk_images {
 324     my $self   = shift;
 325     my $images = $self->{images};
 326     my @images =
 327       qw/catalyst_logo btn_120x50_built btn_120x50_built_shadow
 328       btn_120x50_powered btn_120x50_powered_shadow btn_88x31_built
 329       btn_88x31_built_shadow btn_88x31_powered btn_88x31_powered_shadow/;
 330     for my $name (@images) {
 331         my $image = $self->get_sharedir_file("root", "static", "images", "$name.png.bin");
 332         $self->mk_file( File::Spec->catfile( $images, "$name.png" ), $image );
 333     }
 334 }
 335
 336 # DIE DIE DIE
 337 sub _mk_favicon {
 338     my $self    = shift;
 339     my $root    = $self->{root};
 340     my $favicon = $self->get_sharedir_file( 'root', 'favicon.ico.bin' );
 341     my $dest = File::Spec->catfile( $root, "favicon.ico" );
 342     $self->mk_file( $dest, $favicon );
 343
 344 }
 345
 346 sub _deprecate_file {
 347     my ( $self, $file ) = @_;
 348     if ( -e $file ) {
 349         my $oldcontent;
 350         if ( my $f = IO::File->new("< $file") ) {
 351             $oldcontent = join( '', (<$f>) );
 352         }
 353         my $newfile = $file . '.deprecated';
 354         if ( my $f = IO::File->new("> $newfile") ) {
 355             binmode $f;
 356             print $f $oldcontent;
 357             print qq/created "$newfile"\n/;
 358             unlink $file;
 359             print qq/removed "$file"\n/;
 360             return 1;
 361         }
 362         Catalyst::Exception->throw(
 363             message => qq/Couldn't create "$file", "$!"/ );
 364     }
 365 }
 366
 367 =head1 DESCRIPTION
 368
 369 This module is used by B<catalyst.pl> to create a set of scripts for a
 370 new catalyst application. The scripts each contain documentation and
 371 will output help on how to use them if called incorrectly or in some
 372 cases, with no arguments.
 373
 374 It also provides some useful methods for a Helper module to call when
 375 creating a component. See L</METHODS>.
 376
 377 =head1 SCRIPTS
 378
 379 =head2 _create.pl
 380
 381 Used to create new components for a catalyst application at the
 382 development stage.
 383
 384 =head2 _server.pl
 385
 386 The catalyst test server, starts an HTTPD which outputs debugging to
 387 the terminal.
 388
 389 =head2 _test.pl
 390
 391 A script for running tests from the command-line.
 392
 393 =head2 _cgi.pl
 394
 395 Run your application as a CGI.
 396
 397 =head2 _fastcgi.pl
 398
 399 Run the application as a fastcgi app. Either by hand, or call this
 400 from FastCgiServer in your http server config.
 401
 402 =head1 HELPERS
 403
 404 The L</_create.pl> script creates application components using Helper
 405 modules. The Catalyst team provides a good number of Helper modules
 406 for you to use. You can also add your own.
 407
 408 Helpers are classes that provide two methods.
 409
 410     * mk_compclass - creates the Component class
 411     * mk_comptest  - creates the Component test
 412
 413 So when you call C<scripts/myapp_create.pl view MyView TT>, create
 414 will try to execute Catalyst::Helper::View::TT->mk_compclass and
 415 Catalyst::Helper::View::TT->mk_comptest.
 416
 417 See L<Catalyst::Helper::View::TT> and
 418 L<Catalyst::Helper::Model::DBIC::Schema> for examples.
 419
 420 All helper classes should be under one of the following namespaces.
 421
 422     Catalyst::Helper::Model::
 423     Catalyst::Helper::View::
 424     Catalyst::Helper::Controller::
 425
 426 =head2 COMMON HELPERS
 427
 428 =over
 429
 430 =item *
 431
 432 L<Catalyst::Helper::Model::DBIC::Schema> - DBIx::Class models
 433
 434 =item *
 435
 436 L<Catalyst::Helper::View::TT> - Template Toolkit view
 437
 438 =item *
 439
 440 L<Catalyst::Helper::Model::LDAP>
 441
 442 =item *
 443
 444 L<Catalyst::Helper::Model::Adaptor> - wrap any class into a Catalyst model
 445
 446 =back
 447
 448 =head3 NOTE
 449
 450 The helpers will read author name from /etc/passwd by default. + To override, please export the AUTHOR variable.
 451
 452 =head1 METHODS
 453
 454 =head2 mk_compclass
 455
 456 This method in your Helper module is called with C<$helper>
 457 which is a L<Catalyst::Helper> object, and whichever other arguments
 458 the user added to the command-line. You can use the $helper to call methods
 459 described below.
 460
 461 If the Helper module does not contain a C<mk_compclass> method, it
 462 will fall back to calling L</render_file>, with an argument of
 463 C<compclass>.
 464
 465 =head2 mk_comptest
 466
 467 This method in your Helper module is called with C<$helper>
 468 which is a L<Catalyst::Helper> object, and whichever other arguments
 469 the user added to the command-line. You can use the $helper to call methods
 470 described below.
 471
 472 If the Helper module does not contain a C<mk_compclass> method, it
 473 will fall back to calling L</render_file>, with an argument of
 474 C<comptest>.
 475
 476 =head2 mk_stuff
 477
 478 This method is called if the user does not supply any of the usual
 479 component types C<view>, C<controller>, C<model>. It is passed the
 480 C<$helper> object (an instance of L<Catalyst::Helper>), and any other
 481 arguments the user typed.
 482
 483 There is no fallback for this method.
 484
 485 =head1 INTERNAL METHODS
 486
 487 These are the methods that the Helper classes can call on the
 488 <$helper> object passed to them.
 489
 490 =head2 render_file ($file, $path, $vars)
 491
 492 Render and create a file from a template in DATA using Template
 493 Toolkit. $file is the relevent chunk of the __DATA__ section, $path is
 494 the path to the file and $vars is the hashref as expected by
 495 L<Template Toolkit|Template>.
 496
 497 =head2 get_file ($class, $file)
 498
 499 Fetch file contents from the DATA section. This is used internally by
 500 L</render_file>.  $class is the name of the class to get the DATA
 501 section from.  __PACKAGE__ or ( caller(0) )[0] might be sensible
 502 values for this.
 503
 504 =head2 mk_app
 505
 506 Create the main application skeleton. This is called by L<catalyst.pl>.
 507
 508 =head2 mk_component ($app)
 509
 510 This method is called by L<create.pl> to make new components
 511 for your application.
 512
 513 =head3 mk_dir ($path)
 514
 515 Surprisingly, this function makes a directory.
 516
 517 =head2 mk_file ($file, $content)
 518
 519 Writes content to a file. Called by L</render_file>.
 520
 521 =head2 next_test ($test_name)
 522
 523 Calculates the name of the next numbered test file and returns it.
 524 Don't give the number or the .t suffix for the test name.
 525
 526 =head2 Dir
 527
 528 Alias for L<Path::Class::Dir>
 529
 530 =cut
 531
 532 =head2 get_sharedir_file
 533
 534 Method for getting a file out of share/
 535
 536 =cut
 537
 538 =head2 render_file_contents
 539
 540 Process a L<Template::Toolkit> template.
 541
 542 =cut
 543
 544 =head2 render_sharedir_file
 545
 546 Render a template/image file from our share directory
 547
 548 =cut
 549
 550
 551 =head1 NOTE
 552
 553 The helpers will read author name from /etc/passwd by default.
 554 To override, please export the AUTHOR variable.
 555
 556 =head1 SEE ALSO
 557
 558 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
 559 L<Catalyst::Response>, L<Catalyst>
 560
 561 =head1 AUTHORS
 562
 563 Catalyst Contributors, see Catalyst.pm
 564
 565 =head1 LICENSE
 566
 567 This library is free software. You can redistribute it and/or modify
 568 it under the same terms as Perl itself.
 569
 570 =begin pod_to_ignore
 571
 572 =cut
 573
 574 1;
 575