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
 136 sub render_file {
 137     my ( $self, $file, $path, $vars ) = @_;
 138     my $template = $self->get_file( ( caller(0) )[0], $file );
 139     $self->render_file_contents($template, $path, $vars);
 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 sub _mk_information {
 161     my $self = shift;
 162     print qq/Change to application directory and Run "perl Makefile.PL" to make sure your install is complete\n/;
 163 }
 164
 165 sub _mk_dirs {
 166     my $self = shift;
 167     $self->mk_dir( $self->{dir} );
 168     $self->mk_dir( $self->{script} );
 169     $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
 170     $self->mk_dir( $self->{lib} );
 171     $self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
 172     $self->mk_dir( $self->{root} );
 173     $self->{static} = File::Spec->catdir( $self->{root}, 'static' );
 174     $self->mk_dir( $self->{static} );
 175     $self->{images} = File::Spec->catdir( $self->{static}, 'images' );
 176     $self->mk_dir( $self->{images} );
 177     $self->{t} = File::Spec->catdir( $self->{dir}, 't' );
 178     $self->mk_dir( $self->{t} );
 179
 180     $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
 181     $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
 182     $self->mk_dir( $self->{mod} );
 183
 184     if ( $self->{short} ) {
 185         $self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
 186         $self->mk_dir( $self->{m} );
 187         $self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
 188         $self->mk_dir( $self->{v} );
 189         $self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
 190         $self->mk_dir( $self->{c} );
 191     }
 192     else {
 193         $self->{m} = File::Spec->catdir( $self->{mod}, 'Model' );
 194         $self->mk_dir( $self->{m} );
 195         $self->{v} = File::Spec->catdir( $self->{mod}, 'View' );
 196         $self->mk_dir( $self->{v} );
 197         $self->{c} = File::Spec->catdir( $self->{mod}, 'Controller' );
 198         $self->mk_dir( $self->{c} );
 199     }
 200     my $name = $self->{name};
 201     $self->{rootname} =
 202       $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root";
 203     $self->{base} = File::Spec->rel2abs( $self->{dir} );
 204 }
 205
 206 sub _mk_appclass {
 207     my $self = shift;
 208     my $mod  = $self->{mod};
 209     $self->render_sharedir_file( File::Spec->catfile('lib', 'MyApp.pm.tt'), "$mod.pm" );
 210 }
 211
 212 sub _mk_rootclass {
 213     my $self = shift;
 214     $self->render_sharedir_file( File::Spec->catfile('lib', 'MyApp', 'Controller', 'Root.pm.tt'),
 215         File::Spec->catfile( $self->{c}, "Root.pm" ) );
 216 }
 217
 218 sub _mk_makefile {
 219     my $self = shift;
 220     $self->{path} = File::Spec->catfile( 'lib', split( '::', $self->{name} ) );
 221     $self->{path} .= '.pm';
 222     my $dir = $self->{dir};
 223     $self->render_sharedir_file( 'Makefile.PL.tt', "$dir\/Makefile.PL" );
 224
 225     if ( $self->{makefile} ) {
 226
 227         # deprecate the old Build.PL file when regenerating Makefile.PL
 228         $self->_deprecate_file(
 229             File::Spec->catdir( $self->{dir}, 'Build.PL' ) );
 230     }
 231 }
 232
 233 sub _mk_config {
 234     my $self      = shift;
 235     my $dir       = $self->{dir};
 236     my $appprefix = $self->{appprefix};
 237     $self->render_sharedir_file( 'myapp.conf.tt',
 238         File::Spec->catfile( $dir, "$appprefix.conf" ) );
 239 }
 240
 241 sub _mk_readme {
 242     my $self = shift;
 243     my $dir  = $self->{dir};
 244     $self->render_sharedir_file( 'README.tt', "$dir\/README" );
 245 }
 246
 247 sub _mk_changes {
 248     my $self = shift;
 249     my $dir  = $self->{dir};
 250     my $time = strftime('%Y-%m-%d %H:%M:%S', localtime time);
 251     $self->render_sharedir_file( 'Changes.tt', "$dir\/Changes", { time => $time } );
 252 }
 253
 254 sub _mk_apptest {
 255     my $self = shift;
 256     my $t    = $self->{t};
 257     $self->render_sharedir_file( File::Spec->catfile('t', '01app.t.tt'),         "$t\/01app.t" );
 258     $self->render_sharedir_file( File::Spec->catfile('t', '02pod.t.tt'),         "$t\/02pod.t" );
 259     $self->render_sharedir_file( File::Spec->catfile('t', '03podcoverage.t.tt'), "$t\/03podcoverage.t" );
 260 }
 261
 262 sub _mk_cgi {
 263     my $self      = shift;
 264     my $script    = $self->{script};
 265     my $appprefix = $self->{appprefix};
 266     $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_cgi.pl.tt'), "$script\/$appprefix\_cgi.pl" );
 267     chmod 0700, "$script/$appprefix\_cgi.pl";
 268 }
 269
 270 sub _mk_fastcgi {
 271     my $self      = shift;
 272     my $script    = $self->{script};
 273     my $appprefix = $self->{appprefix};
 274     $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_fastcgi.pl.tt'), "$script\/$appprefix\_fastcgi.pl" );
 275     chmod 0700, "$script/$appprefix\_fastcgi.pl";
 276 }
 277
 278 sub _mk_server {
 279     my $self      = shift;
 280     my $script    = $self->{script};
 281     my $appprefix = $self->{appprefix};
 282     $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_server.pl.tt'), "$script\/$appprefix\_server.pl" );
 283     chmod 0700, "$script/$appprefix\_server.pl";
 284 }
 285
 286 sub _mk_test {
 287     my $self      = shift;
 288     my $script    = $self->{script};
 289     my $appprefix = $self->{appprefix};
 290     $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_test.pl.tt'), "$script/$appprefix\_test.pl" );
 291     chmod 0700, "$script/$appprefix\_test.pl";
 292 }
 293
 294 sub _mk_create {
 295     my $self      = shift;
 296     my $script    = $self->{script};
 297     my $appprefix = $self->{appprefix};
 298     $self->render_sharedir_file( File::Spec->catfile('script', 'myapp_create.pl.tt'), "$script\/$appprefix\_create.pl" );
 299     chmod 0700, "$script/$appprefix\_create.pl";
 300 }
 301
 302 sub _mk_compclass {
 303     my $self = shift;
 304     my $file = $self->{file};
 305     return $self->render_sharedir_file( 'myapp_compclass.pl.tt', "$file" );
 306 }
 307
 308 sub _mk_comptest {
 309     my $self = shift;
 310     my $test = $self->{test};
 311     $self->render_sharedir_file( 'comptest.tt', "$test" );  ## wtf do i rename this to?
 312 }
 313
 314 sub _mk_images {
 315     my $self   = shift;
 316     my $images = $self->{images};
 317     my @images =
 318       qw/catalyst_logo btn_120x50_built btn_120x50_built_shadow
 319       btn_120x50_powered btn_120x50_powered_shadow btn_88x31_built
 320       btn_88x31_built_shadow btn_88x31_powered btn_88x31_powered_shadow/;
 321     for my $name (@images) {
 322         my $image = $self->get_sharedir_file("root", "static", "images", "$name.png.bin");
 323         $self->mk_file( File::Spec->catfile( $images, "$name.png" ), $image );
 324     }
 325 }
 326
 327 sub _mk_favicon {
 328     my $self    = shift;
 329     my $root    = $self->{root};
 330     my $favicon = $self->get_sharedir_file( 'root', 'favicon.ico.bin' );
 331     my $dest = File::Spec->catfile( $root, "favicon.ico" );
 332     $self->mk_file( $dest, $favicon );
 333
 334 }
 335
 336 sub _deprecate_file {
 337     my ( $self, $file ) = @_;
 338     if ( -e $file ) {
 339         my $oldcontent;
 340         if ( my $f = IO::File->new("< $file") ) {
 341             $oldcontent = join( '', (<$f>) );
 342         }
 343         my $newfile = $file . '.deprecated';
 344         if ( my $f = IO::File->new("> $newfile") ) {
 345             binmode $f;
 346             print $f $oldcontent;
 347             print qq/created "$newfile"\n/;
 348             unlink $file;
 349             print qq/removed "$file"\n/;
 350             return 1;
 351         }
 352         Catalyst::Exception->throw(
 353             message => qq/Couldn't create "$file", "$!"/ );
 354     }
 355 }
 356
 357
 358 ## this is so you don't have to do make install after every change to test
 359 sub _find_share_dir {
 360   my ($self, $args) = @_;
 361   my $share_name = $self->name;
 362   if ($share_name =~ s!^/(.*?)/!!) {
 363     my $dist = $1;
 364     $args->{share_base_dir} = eval {
 365         Dir->new(File::ShareDir::dist_dir($dist))
 366            ->subdir('share');
 367     };
 368     if ($@) {
 369         # not installed
 370         my $file = __FILE__;
 371         my $dir = Dir->new(dirname($file));
 372         my $share_base;
 373         while ($dir->parent) {
 374             if (-d $dir->subdir('share') && -d $dir->subdir('share')->subdir('root')) {
 375                 $share_base = $dir->subdir('share')->subdir('root');
 376                 last;
 377             }
 378             $dir = $dir->parent;
 379         }
 380         confess "could not find sharebase by recursion. ended up at $dir, from $file"
 381           unless $share_base;
 382         $args->{share_base_dir} = $share_base;
 383     }
 384   }
 385   my $base = $args->{share_base_dir}->subdir($share_name);
 386   confess "No such share base directory ${base}"
 387     unless -d $base;
 388   $self->share_dir($base);
 389 };
 390
 391
 392
 393 =head1 DESCRIPTION
 394
 395 This module is used by B<catalyst.pl> to create a set of scripts for a
 396 new catalyst application. The scripts each contain documentation and
 397 will output help on how to use them if called incorrectly or in some
 398 cases, with no arguments.
 399
 400 It also provides some useful methods for a Helper module to call when
 401 creating a component. See L</METHODS>.
 402
 403 =head1 SCRIPTS
 404
 405 =head2 _create.pl
 406
 407 Used to create new components for a catalyst application at the
 408 development stage.
 409
 410 =head2 _server.pl
 411
 412 The catalyst test server, starts an HTTPD which outputs debugging to
 413 the terminal.
 414
 415 =head2 _test.pl
 416
 417 A script for running tests from the command-line.
 418
 419 =head2 _cgi.pl
 420
 421 Run your application as a CGI.
 422
 423 =head2 _fastcgi.pl
 424
 425 Run the application as a fastcgi app. Either by hand, or call this
 426 from FastCgiServer in your http server config.
 427
 428 =head1 HELPERS
 429
 430 The L</_create.pl> script creates application components using Helper
 431 modules. The Catalyst team provides a good number of Helper modules
 432 for you to use. You can also add your own.
 433
 434 Helpers are classes that provide two methods.
 435
 436     * mk_compclass - creates the Component class
 437     * mk_comptest  - creates the Component test
 438
 439 So when you call C<scripts/myapp_create.pl view MyView TT>, create
 440 will try to execute Catalyst::Helper::View::TT->mk_compclass and
 441 Catalyst::Helper::View::TT->mk_comptest.
 442
 443 See L<Catalyst::Helper::View::TT> and
 444 L<Catalyst::Helper::Model::DBIC::Schema> for examples.
 445
 446 All helper classes should be under one of the following namespaces.
 447
 448     Catalyst::Helper::Model::
 449     Catalyst::Helper::View::
 450     Catalyst::Helper::Controller::
 451
 452 =head2 COMMON HELPERS
 453
 454 =over
 455
 456 =item *
 457
 458 L<Catalyst::Helper::Model::DBIC::Schema> - DBIx::Class models
 459
 460 =item *
 461
 462 L<Catalyst::Helper::View::TT> - Template Toolkit view
 463
 464 =item *
 465
 466 L<Catalyst::Helper::Model::LDAP>
 467
 468 =item *
 469
 470 L<Catalyst::Helper::Model::Adaptor> - wrap any class into a Catalyst model
 471
 472 =back
 473
 474 =head3 NOTE
 475
 476 The helpers will read author name from /etc/passwd by default. + To override, please export the AUTHOR variable.
 477
 478 =head1 METHODS
 479
 480 =head2 mk_compclass
 481
 482 This method in your Helper module is called with C<$helper>
 483 which is a L<Catalyst::Helper> object, and whichever other arguments
 484 the user added to the command-line. You can use the $helper to call methods
 485 described below.
 486
 487 If the Helper module does not contain a C<mk_compclass> method, it
 488 will fall back to calling L</render_file>, with an argument of
 489 C<compclass>.
 490
 491 =head2 mk_comptest
 492
 493 This method in your Helper module is called with C<$helper>
 494 which is a L<Catalyst::Helper> object, and whichever other arguments
 495 the user added to the command-line. You can use the $helper to call methods
 496 described below.
 497
 498 If the Helper module does not contain a C<mk_compclass> method, it
 499 will fall back to calling L</render_file>, with an argument of
 500 C<comptest>.
 501
 502 =head2 mk_stuff
 503
 504 This method is called if the user does not supply any of the usual
 505 component types C<view>, C<controller>, C<model>. It is passed the
 506 C<$helper> object (an instance of L<Catalyst::Helper>), and any other
 507 arguments the user typed.
 508
 509 There is no fallback for this method.
 510
 511 =head1 INTERNAL METHODS
 512
 513 These are the methods that the Helper classes can call on the
 514 <$helper> object passed to them.
 515
 516 =head2 render_file ($file, $path, $vars)
 517
 518 Render and create a file from a template in DATA using Template
 519 Toolkit. $file is the relevent chunk of the __DATA__ section, $path is
 520 the path to the file and $vars is the hashref as expected by
 521 L<Template Toolkit|Template>.
 522
 523 =head2 get_file ($class, $file)
 524
 525 Fetch file contents from the DATA section. This is used internally by
 526 L</render_file>.  $class is the name of the class to get the DATA
 527 section from.  __PACKAGE__ or ( caller(0) )[0] might be sensible
 528 values for this.
 529
 530 =head2 mk_app
 531
 532 Create the main application skeleton. This is called by L<catalyst.pl>.
 533
 534 =head2 mk_component ($app)
 535
 536 This method is called by L<create.pl> to make new components
 537 for your application.
 538
 539 =head3 mk_dir ($path)
 540
 541 Surprisingly, this function makes a directory.
 542
 543 =head2 mk_file ($file, $content)
 544
 545 Writes content to a file. Called by L</render_file>.
 546
 547 =head2 next_test ($test_name)
 548
 549 Calculates the name of the next numbered test file and returns it.
 550 Don't give the number or the .t suffix for the test name.
 551
 552 =head2 Dir
 553
 554 Alias for L<Path::Class::Dir>
 555
 556 =cut
 557
 558 =head2 get_sharedir_file
 559
 560 Method for getting a file out of share/
 561
 562 =cut
 563
 564 =head2 render_file_contents
 565
 566 Process a L<Template::Toolkit> template.
 567
 568 =cut
 569
 570 =head2 render_sharedir_file
 571
 572 Render a template/image file from our share directory
 573
 574 =cut
 575
 576
 577 =head1 NOTE
 578
 579 The helpers will read author name from /etc/passwd by default.
 580 To override, please export the AUTHOR variable.
 581
 582 =head1 SEE ALSO
 583
 584 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
 585 L<Catalyst::Response>, L<Catalyst>
 586
 587 =head1 AUTHORS
 588
 589 Catalyst Contributors, see Catalyst.pm
 590
 591 =head1 LICENSE
 592
 593 This library is free software. You can redistribute it and/or modify
 594 it under the same terms as Perl itself.
 595
 596 =begin pod_to_ignore
 597
 598 =cut
 599
 600 1;
 601