lib/Catalyst/Helper.pm

   1 package Catalyst::Helper;
   2
   3 use strict;
   4 use warnings;
   5 use base 'Class::Accessor::Fast';
   6 use Config;
   7 use File::Spec;
   8 use File::Path;
   9 use FindBin;
  10 use IO::File;
  11 use POSIX 'strftime';
  12 use Template;
  13 use Catalyst::Devel;
  14 use Catalyst::Utils;
  15 use Catalyst::Exception;
  16 use Path::Class qw/dir file/;
  17 use File::ShareDir qw/dist_dir/;
  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
  32
  33 sub get_sharedir_file {
  34     my ($self, @filename) = @_;
  35     my $file = file( dist_dir('Catalyst-Devel'), @filename);
  36     warn $file;
  37     my $contents = $file->slurp;
  38     return $contents;
  39 }
  40
  41 # Do not touch this method, *EVER*, it is needed for back compat.
  42 sub get_file {
  43     my ( $self, $class, $file ) = @_;
  44     unless ( $cache{$class} ) {
  45         local $/;
  46         $cache{$class} = eval "package $class; <DATA>";
  47     }
  48     my $data = $cache{$class};
  49     my @files = split /^__(.+)__\r?\n/m, $data;
  50     shift @files;
  51     while (@files) {
  52         my ( $name, $content ) = splice @files, 0, 2;
  53         return $content if $name eq $file;
  54     }
  55     return 0;
  56 }
  57
  58
  59 sub mk_app {
  60     my ( $self, $name ) = @_;
  61
  62     # Needs to be here for PAR
  63     require Catalyst;
  64
  65     if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) {
  66         warn "Error: Invalid application name.\n";
  67         return 0;
  68     }
  69     $self->{name            } = $name;
  70     $self->{dir             } = $name;
  71     $self->{dir             } =~ s/\:\:/-/g;
  72     $self->{script          } = File::Spec->catdir( $self->{dir}, 'script' );
  73     $self->{appprefix       } = Catalyst::Utils::appprefix($name);
  74     $self->{appenv          } = Catalyst::Utils::class2env($name);
  75     $self->{startperl       } = -r '/usr/bin/env'
  76                                 ? '#!/usr/bin/env perl'
  77                                 : "#!$Config{perlpath} -w";
  78     $self->{scriptgen       } = $Catalyst::Devel::CATALYST_SCRIPT_GEN || 4;
  79     $self->{catalyst_version} = $Catalyst::VERSION;
  80     $self->{author          } = $self->{author} = $ENV{'AUTHOR'}
  81       || eval { @{ [ getpwuid($<) ] }[6] }
  82       || 'Catalyst developer';
  83
  84     my $gen_scripts  = ( $self->{makefile} ) ? 0 : 1;
  85     my $gen_makefile = ( $self->{scripts} )  ? 0 : 1;
  86     my $gen_app = ( $self->{scripts} || $self->{makefile} ) ? 0 : 1;
  87
  88     if ($gen_app) {
  89         $self->_mk_dirs;
  90         $self->_mk_config;
  91         $self->_mk_appclass;
  92         $self->_mk_rootclass;
  93         $self->_mk_readme;
  94         $self->_mk_changes;
  95         $self->_mk_apptest;
  96         $self->_mk_images;
  97         $self->_mk_favicon;
  98     }
  99     if ($gen_makefile) {
 100         $self->_mk_makefile;
 101     }
 102     if ($gen_scripts) {
 103         $self->_mk_cgi;
 104         $self->_mk_fastcgi;
 105         $self->_mk_server;
 106         $self->_mk_test;
 107         $self->_mk_create;
 108         $self->_mk_information;
 109     }
 110     return $self->{dir};
 111 }
 112
 113 sub mk_component {
 114     my $self = shift;
 115     my $app  = shift;
 116     $self->{app} = $app;
 117     $self->{author} = $self->{author} = $ENV{'AUTHOR'}
 118       || eval { @{ [ getpwuid($<) ] }[6] }
 119       || 'A clever guy';
 120     $self->{base} ||= File::Spec->catdir( $FindBin::Bin, '..' );
 121     unless ( $_[0] =~ /^(?:model|view|controller)$/i ) {
 122         my $helper = shift;
 123         my @args   = @_;
 124         my $class  = "Catalyst::Helper::$helper";
 125         eval "require $class";
 126
 127         if ($@) {
 128             Catalyst::Exception->throw(
 129                 message => qq/Couldn't load helper "$class", "$@"/ );
 130         }
 131
 132         if ( $class->can('mk_stuff') ) {
 133             return 1 unless $class->mk_stuff( $self, @args );
 134         }
 135     }
 136     else {
 137         my $type   = shift;
 138         my $name   = shift || "Missing name for model/view/controller";
 139         my $helper = shift;
 140         my @args   = @_;
 141        return 0 if $name =~ /[^\w\:]/;
 142         $type              = lc $type;
 143         $self->{long_type} = ucfirst $type;
 144         $type              = 'M' if $type =~ /model/i;
 145         $type              = 'V' if $type =~ /view/i;
 146         $type              = 'C' if $type =~ /controller/i;
 147         my $appdir = File::Spec->catdir( split /\:\:/, $app );
 148         my $test_path =
 149           File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, 'C' );
 150         $type = $self->{long_type} unless -d $test_path;
 151         $self->{type}  = $type;
 152         $self->{name}  = $name;
 153         $self->{class} = "$app\::$type\::$name";
 154
 155         # Class
 156         my $path =
 157           File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type );
 158         my $file = $name;
 159         if ( $name =~ /\:/ ) {
 160             my @path = split /\:\:/, $name;
 161             $file = pop @path;
 162             $path = File::Spec->catdir( $path, @path );
 163         }
 164         $self->mk_dir($path);
 165         $file = File::Spec->catfile( $path, "$file.pm" );
 166         $self->{file} = $file;
 167
 168         # Test
 169         $self->{test_dir} = File::Spec->catdir( $FindBin::Bin, '..', 't' );
 170         $self->{test}     = $self->next_test;
 171
 172         # Helper
 173         if ($helper) {
 174             my $comp  = $self->{long_type};
 175             my $class = "Catalyst::Helper::$comp\::$helper";
 176             eval "require $class";
 177
 178             if ($@) {
 179                 Catalyst::Exception->throw(
 180                     message => qq/Couldn't load helper "$class", "$@"/ );
 181             }
 182
 183             if ( $class->can('mk_compclass') ) {
 184                 return 1 unless $class->mk_compclass( $self, @args );
 185             }
 186             else { return 1 unless $self->_mk_compclass }
 187
 188             if ( $class->can('mk_comptest') ) {
 189                 $class->mk_comptest( $self, @args );
 190             }
 191             else { $self->_mk_comptest }
 192         }
 193
 194         # Fallback
 195         else {
 196             return 1 unless $self->_mk_compclass;
 197             $self->_mk_comptest;
 198         }
 199     }
 200     return 1;
 201 }
 202
 203 sub mk_dir {
 204     my ( $self, $dir ) = @_;
 205     if ( -d $dir ) {
 206         print qq/ exists "$dir"\n/;
 207         return 0;
 208     }
 209     if ( mkpath [$dir] ) {
 210         print qq/created "$dir"\n/;
 211         return 1;
 212     }
 213
 214     Catalyst::Exception->throw( message => qq/Couldn't create "$dir", "$!"/ );
 215 }
 216
 217 sub mk_file {
 218     my ( $self, $file, $content ) = @_;
 219     if ( -e $file ) {
 220         print qq/ exists "$file"\n/;
 221         return 0
 222           unless ( $self->{'.newfiles'}
 223             || $self->{scripts}
 224             || $self->{makefile} );
 225         if ( $self->{'.newfiles'} ) {
 226             if ( my $f = IO::File->new("< $file") ) {
 227                 my $oldcontent = join( '', (<$f>) );
 228                 return 0 if $content eq $oldcontent;
 229             }
 230             $file .= '.new';
 231         }
 232     }
 233     if ( my $f = IO::File->new("> $file") ) {
 234         binmode $f;
 235         print $f $content;
 236         print qq/created "$file"\n/;
 237         return 1;
 238     }
 239
 240     Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ );
 241 }
 242
 243 sub next_test {
 244     my ( $self, $tname ) = @_;
 245     if ($tname) { $tname = "$tname.t" }
 246     else {
 247         my $name   = $self->{name};
 248         my $prefix = $name;
 249         $prefix =~ s/::/-/g;
 250         $prefix         = $prefix;
 251         $tname          = $prefix . '.t';
 252         $self->{prefix} = $prefix;
 253         $prefix         = lc $prefix;
 254         $prefix =~ s/-/\//g;
 255         $self->{uri} = "/$prefix";
 256     }
 257     my $dir  = $self->{test_dir};
 258     my $type = lc $self->{type};
 259     $self->mk_dir($dir);
 260     return File::Spec->catfile( $dir, "$type\_$tname" );
 261 }
 262
 263 # Do not touch this method, *EVER*, it is needed for back compat.
 264
 265 sub render_file {
 266     my ( $self, $file, $path, $vars ) = @_;
 267     $vars ||= {};
 268     my $t = Template->new;
 269     my $template = $self->get_sharedir_file( 'root', $file );
 270     return 0 unless $template;
 271     my $output;
 272     $t->process( \$template, { %{$self}, %$vars }, \$output )
 273       || Catalyst::Exception->throw(
 274         message => qq/Couldn't process "$file", / . $t->error() );
 275     $self->mk_file( $path, $output );
 276 }
 277
 278 sub _mk_information {
 279     my $self = shift;
 280     print qq/Change to application directory and Run "perl Makefile.PL" to make sure your install is complete\n/;
 281 }
 282
 283 sub _mk_dirs {
 284     my $self = shift;
 285     $self->mk_dir( $self->{dir} );
 286     $self->mk_dir( $self->{script} );
 287     $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
 288     $self->mk_dir( $self->{lib} );
 289     $self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
 290     $self->mk_dir( $self->{root} );
 291     $self->{static} = File::Spec->catdir( $self->{root}, 'static' );
 292     $self->mk_dir( $self->{static} );
 293     $self->{images} = File::Spec->catdir( $self->{static}, 'images' );
 294     $self->mk_dir( $self->{images} );
 295     $self->{t} = File::Spec->catdir( $self->{dir}, 't' );
 296     $self->mk_dir( $self->{t} );
 297
 298     $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
 299     $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
 300     $self->mk_dir( $self->{mod} );
 301
 302     if ( $self->{short} ) {
 303         $self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
 304         $self->mk_dir( $self->{m} );
 305         $self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
 306         $self->mk_dir( $self->{v} );
 307         $self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
 308         $self->mk_dir( $self->{c} );
 309     }
 310     else {
 311         $self->{m} = File::Spec->catdir( $self->{mod}, 'Model' );
 312         $self->mk_dir( $self->{m} );
 313         $self->{v} = File::Spec->catdir( $self->{mod}, 'View' );
 314         $self->mk_dir( $self->{v} );
 315         $self->{c} = File::Spec->catdir( $self->{mod}, 'Controller' );
 316         $self->mk_dir( $self->{c} );
 317     }
 318     my $name = $self->{name};
 319     $self->{rootname} =
 320       $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root";
 321     $self->{base} = File::Spec->rel2abs( $self->{dir} );
 322 }
 323
 324 sub _mk_appclass {
 325     my $self = shift;
 326     my $mod  = $self->{mod};
 327     $self->render_file( 'appclass.tt', "$mod.pm" );
 328 }
 329
 330 sub _mk_rootclass {
 331     my $self = shift;
 332     $self->render_file( 'rootclass.tt',
 333         File::Spec->catfile( $self->{c}, "Root.pm" ) );
 334 }
 335
 336 sub _mk_makefile {
 337     my $self = shift;
 338     $self->{path} = File::Spec->catfile( 'lib', split( '::', $self->{name} ) );
 339     $self->{path} .= '.pm';
 340     my $dir = $self->{dir};
 341     $self->render_file( 'makefile.tt', "$dir\/Makefile.PL" );
 342
 343     if ( $self->{makefile} ) {
 344
 345         # deprecate the old Build.PL file when regenerating Makefile.PL
 346         $self->_deprecate_file(
 347             File::Spec->catdir( $self->{dir}, 'Build.PL' ) );
 348     }
 349 }
 350
 351 sub _mk_config {
 352     my $self      = shift;
 353     my $dir       = $self->{dir};
 354     my $appprefix = $self->{appprefix};
 355     $self->render_file( 'config.tt',
 356         File::Spec->catfile( $dir, "$appprefix.conf" ) );
 357 }
 358
 359 sub _mk_readme {
 360     my $self = shift;
 361     my $dir  = $self->{dir};
 362     $self->render_file( 'readme.tt', "$dir\/README" );
 363 }
 364
 365 sub _mk_changes {
 366     my $self = shift;
 367     my $dir  = $self->{dir};
 368     my $time = strftime('%Y-%m-%d %H:%M:%S', localtime time);
 369     $self->render_file( 'changes.tt', "$dir\/Changes", { time => $time } );
 370 }
 371
 372 sub _mk_apptest {
 373     my $self = shift;
 374     my $t    = $self->{t};
 375     $self->render_file( 'apptest.tt',         "$t\/01app.t" );
 376     $self->render_file( 'podtest.tt',         "$t\/02pod.t" );
 377     $self->render_file( 'podcoveragetest.tt', "$t\/03podcoverage.t" );
 378 }
 379
 380 sub _mk_cgi {
 381     my $self      = shift;
 382     my $script    = $self->{script};
 383     my $appprefix = $self->{appprefix};
 384     $self->render_file( 'cgi.tt', "$script\/$appprefix\_cgi.pl" );
 385     chmod 0700, "$script/$appprefix\_cgi.pl";
 386 }
 387
 388 sub _mk_fastcgi {
 389     my $self      = shift;
 390     my $script    = $self->{script};
 391     my $appprefix = $self->{appprefix};
 392     $self->render_file( 'fastcgi.tt', "$script\/$appprefix\_fastcgi.pl" );
 393     chmod 0700, "$script/$appprefix\_fastcgi.pl";
 394 }
 395
 396 sub _mk_server {
 397     my $self      = shift;
 398     my $script    = $self->{script};
 399     my $appprefix = $self->{appprefix};
 400     $self->render_file( 'server.tt', "$script\/$appprefix\_server.pl" );
 401     chmod 0700, "$script/$appprefix\_server.pl";
 402 }
 403
 404 sub _mk_test {
 405     my $self      = shift;
 406     my $script    = $self->{script};
 407     my $appprefix = $self->{appprefix};
 408     $self->render_file( 'test.tt', "$script/$appprefix\_test.pl" );
 409     chmod 0700, "$script/$appprefix\_test.pl";
 410 }
 411
 412 sub _mk_create {
 413     my $self      = shift;
 414     my $script    = $self->{script};
 415     my $appprefix = $self->{appprefix};
 416     $self->render_file( 'create.tt', "$script\/$appprefix\_create.pl" );
 417     chmod 0700, "$script/$appprefix\_create.pl";
 418 }
 419
 420 sub _mk_compclass {
 421     my $self = shift;
 422     my $file = $self->{file};
 423     return $self->render_file( 'compclass.tt', "$file" );
 424 }
 425
 426 sub _mk_comptest {
 427     my $self = shift;
 428     my $test = $self->{test};
 429     $self->render_file( 'comptest.tt', "$test" );
 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", "$name.png");
 441         $self->mk_file( File::Spec->catfile( $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' );
 449     my $dest = File::Spec->catfile( $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 $oldcontent;
 458         if ( my $f = IO::File->new("< $file") ) {
 459             $oldcontent = join( '', (<$f>) );
 460         }
 461         my $newfile = $file . '.deprecated';
 462         if ( my $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. + To override, please export the AUTHOR variable.
 559
 560 =head1 METHODS
 561
 562 =head2 mk_compclass
 563
 564 This method in your Helper module is called with C<$helper>
 565 which is a L<Catalyst::Helper> object, and whichever other arguments
 566 the user added to the command-line. You can use the $helper to call methods
 567 described below.
 568
 569 If the Helper module does not contain a C<mk_compclass> method, it
 570 will fall back to calling L</render_file>, with an argument of
 571 C<compclass>.
 572
 573 =head2 mk_comptest
 574
 575 This method in your Helper module is called with C<$helper>
 576 which is a L<Catalyst::Helper> object, and whichever other arguments
 577 the user added to the command-line. You can use the $helper to call methods
 578 described below.
 579
 580 If the Helper module does not contain a C<mk_compclass> method, it
 581 will fall back to calling L</render_file>, with an argument of
 582 C<comptest>.
 583
 584 =head2 mk_stuff
 585
 586 This method is called if the user does not supply any of the usual
 587 component types C<view>, C<controller>, C<model>. It is passed the
 588 C<$helper> object (an instance of L<Catalyst::Helper>), and any other
 589 arguments the user typed.
 590
 591 There is no fallback for this method.
 592
 593 =head1 INTERNAL METHODS
 594
 595 These are the methods that the Helper classes can call on the
 596 <$helper> object passed to them.
 597
 598 =head2 render_file ($file, $path, $vars)
 599
 600 Render and create a file from a template in DATA using Template
 601 Toolkit. $file is the relevent chunk of the __DATA__ section, $path is
 602 the path to the file and $vars is the hashref as expected by
 603 L<Template Toolkit|Template>.
 604
 605 =head2 get_file ($class, $file)
 606
 607 Fetch file contents from the DATA section. This is used internally by
 608 L</render_file>.  $class is the name of the class to get the DATA
 609 section from.  __PACKAGE__ or ( caller(0) )[0] might be sensible
 610 values for this.
 611
 612 =head2 mk_app
 613
 614 Create the main application skeleton. This is called by L<catalyst.pl>.
 615
 616 =head2 mk_component ($app)
 617
 618 This method is called by L<create.pl> to make new components
 619 for your application.
 620
 621 =head3 mk_dir ($path)
 622
 623 Surprisingly, this function makes a directory.
 624
 625 =head2 mk_file ($file, $content)
 626
 627 Writes content to a file. Called by L</render_file>.
 628
 629 =head2 next_test ($test_name)
 630
 631 Calculates the name of the next numbered test file and returns it.
 632 Don't give the number or the .t suffix for the test name.
 633
 634 =head1 NOTE
 635
 636 The helpers will read author name from /etc/passwd by default.
 637 To override, please export the AUTHOR variable.
 638
 639 =head1 SEE ALSO
 640
 641 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
 642 L<Catalyst::Response>, L<Catalyst>
 643
 644 =head1 AUTHORS
 645
 646 Catalyst Contributors, see Catalyst.pm
 647
 648 =head1 LICENSE
 649
 650 This library is free software. You can redistribute it and/or modify
 651 it under the same terms as Perl itself.
 652
 653 =begin pod_to_ignore
 654
 655 =cut
 656
 657 1;
 658