lib/Catalyst/Helper.pm

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