Added first welcome screen mockup
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Helper.pm
index 6a78bf3..14af0d1 100644 (file)
@@ -9,6 +9,7 @@ use IO::File;
 use FindBin;
 use Template;
 use Catalyst;
+use Catalyst::Exception;
 
 my %cache;
 
@@ -39,7 +40,7 @@ sub get_file {
         $cache{$class} = eval "package $class; <DATA>";
     }
     my $data = $cache{$class};
-    my @files = split /^__(.+)__\n/m, $data;
+    my @files = split /^__(.+)__\r?\n/m, $data;
     shift @files;
     while (@files) {
         my ( $name, $content ) = splice @files, 0, 2;
@@ -63,9 +64,10 @@ sub mk_app {
     $self->{appprefix} = lc $self->{dir};
     $self->{appprefix} =~ s/-/_/g;
     $self->{startperl} = $Config{startperl};
-    $self->{scriptgen} = $Catalyst::CATALYST_SCRIPT_GEN;
+    $self->{scriptgen} = $Catalyst::CATALYST_SCRIPT_GEN || 4;
     $self->{author}    = $self->{author} = $ENV{'AUTHOR'}
-      || eval { @{ [ getpwuid($<) ] }[6] } || 'A clever guy';
+      || eval { @{ [ getpwuid($<) ] }[6] }
+      || 'Catalyst developer';
     $self->_mk_dirs;
     $self->_mk_appclass;
     $self->_mk_build;
@@ -74,7 +76,7 @@ sub mk_app {
     $self->_mk_changes;
     $self->_mk_apptest;
     $self->_mk_cgi;
-    $self->_mk_fcgi;
+    $self->_mk_fastcgi;
     $self->_mk_server;
     $self->_mk_test;
     $self->_mk_create;
@@ -93,14 +95,20 @@ sub mk_component {
     my $app  = shift;
     $self->{app} = $app;
     $self->{author} = $self->{author} = $ENV{'AUTHOR'}
-      || eval { @{ [ getpwuid($<) ] }[6] } || 'A clever guy';
+      || eval { @{ [ getpwuid($<) ] }[6] }
+      || 'A clever guy';
     $self->{base} = File::Spec->catdir( $FindBin::Bin, '..' );
-    unless ( $_[0] =~ /^model|m|view|v|controller|c\$/i ) {
+    unless ( $_[0] =~ /^(?:model|m|view|v|controller|c)$/i ) {
         my $helper = shift;
         my @args   = @_;
         my $class  = "Catalyst::Helper::$helper";
         eval "require $class";
-        die qq/Couldn't load helper "$class", "$@"/ if $@;
+
+        if ($@) {
+            Catalyst::Exception->throw(
+                message => qq/Couldn't load helper "$class", "$@"/ );
+        }
+
         if ( $class->can('mk_stuff') ) {
             return 1 unless $class->mk_stuff( $self, @args );
         }
@@ -108,7 +116,7 @@ sub mk_component {
     else {
         my $type   = shift;
         my $name   = shift || "Missing name for model/view/controller";
-        my $helper = shift ;
+        my $helper = shift;
         my @args   = @_;
         return 0 if $name =~ /[^\w\:]/;
         $type = 'M' if $type =~ /model|m/i;
@@ -127,7 +135,7 @@ sub mk_component {
             my @path = split /\:\:/, $name;
             $file = pop @path;
             $path = File::Spec->catdir( $path, @path );
-            mkpath $path;
+            mkpath [$path];
         }
         $file = File::Spec->catfile( $path, "$file.pm" );
         $self->{file} = $file;
@@ -143,7 +151,12 @@ sub mk_component {
             $comp = 'Controller' if $type eq 'C';
             my $class = "Catalyst::Helper::$comp\::$helper";
             eval "require $class";
-            die qq/Couldn't load helper "$class", "$@"/ if $@;
+
+            if ($@) {
+                Catalyst::Exception->throw(
+                    message => qq/Couldn't load helper "$class", "$@"/ );
+            }
+
             if ( $class->can('mk_compclass') ) {
                 return 1 unless $class->mk_compclass( $self, @args );
             }
@@ -176,11 +189,12 @@ sub mk_dir {
         print qq/ exists "$dir"\n/;
         return 0;
     }
-    if ( mkpath $dir) {
+    if ( mkpath [$dir] ) {
         print qq/created "$dir"\n/;
         return 1;
     }
-    die qq/Couldn't create "$dir", "$!"/;
+
+    Catalyst::Exception->throw( message => qq/Couldn't create "$dir", "$!"/ );
 }
 
 =head3 mk_file
@@ -193,14 +207,20 @@ sub mk_file {
     my ( $self, $file, $content ) = @_;
     if ( -e $file ) {
         print qq/ exists "$file"\n/;
-        return 0;
+        return 0 unless $self->{'.newfiles'};
+        if ( my $f = IO::File->new("< $file") ) {
+            my $oldcontent = join( '', (<$f>) );
+            return 0 if $content eq $oldcontent;
+        }
+        $file .= '.new';
     }
     if ( my $f = IO::File->new("> $file") ) {
         print $f $content;
         print qq/created "$file"\n/;
         return 1;
     }
-    die qq/Couldn't create "$file", "$!"/;
+
+    Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ );
 }
 
 =head3 next_test
@@ -213,13 +233,16 @@ sub next_test {
     else {
         my $name   = $self->{name};
         my $prefix = $name;
-        $prefix =~ s/::/_/g;
-        $prefix         = lc $prefix;
+        $prefix =~ s/::/-/g;
+        $prefix         = $prefix;
         $tname          = $prefix . '.t';
         $self->{prefix} = $prefix;
+        $prefix         = lc $prefix;
+        $prefix =~ s/-/\//g;
+        $self->{uri} = $prefix;
     }
     my $dir  = $self->{test_dir};
-    my $type = lc $self->{type};
+    my $type = $self->{type};
     return File::Spec->catfile( $dir, $type, $tname );
 }
 
@@ -237,7 +260,9 @@ sub render_file {
     my $template = $self->get_file( ( caller(0) )[0], $file );
     return 0 unless $template;
     my $output;
-    $t->process( \$template, { %{$self}, %$vars }, \$output );
+    $t->process( \$template, { %{$self}, %$vars }, \$output )
+      || Catalyst::Exception->throw(
+        message => qq/Couldn't process "$file", / . $t->error() );
     $self->mk_file( $path, $output );
 }
 
@@ -252,9 +277,9 @@ sub _mk_dirs {
     $self->mk_dir( $self->{root} );
     $self->{t} = File::Spec->catdir( $self->{dir}, 't' );
     $self->mk_dir( $self->{t} );
-    $self->mk_dir( File::Spec->catdir( $self->{t}, 'm' ) );
-    $self->mk_dir( File::Spec->catdir( $self->{t}, 'v' ) );
-    $self->mk_dir( File::Spec->catdir( $self->{t}, 'c' ) );
+    $self->mk_dir( File::Spec->catdir( $self->{t}, 'M' ) );
+    $self->mk_dir( File::Spec->catdir( $self->{t}, 'V' ) );
+    $self->mk_dir( File::Spec->catdir( $self->{t}, 'C' ) );
     $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
     $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
     $self->mk_dir( $self->{mod} );
@@ -307,40 +332,40 @@ sub _mk_apptest {
 }
 
 sub _mk_cgi {
-    my $self   = shift;
-    my $script = $self->{script};
+    my $self      = shift;
+    my $script    = $self->{script};
     my $appprefix = $self->{appprefix};
     $self->render_file( 'cgi', "$script\/$appprefix\_cgi.pl" );
     chmod 0700, "$script/$appprefix\_cgi.pl";
 }
 
-sub _mk_fcgi {
-    my $self   = shift;
-    my $script = $self->{script};
+sub _mk_fastcgi {
+    my $self      = shift;
+    my $script    = $self->{script};
     my $appprefix = $self->{appprefix};
-    $self->render_file( 'fcgi', "$script\/$appprefix\_fcgi.pl" );
-    chmod 0700, "$script/$appprefix\_fcgi.pl";
+    $self->render_file( 'fastcgi', "$script\/$appprefix\_fastcgi.pl" );
+    chmod 0700, "$script/$appprefix\_fastcgi.pl";
 }
 
 sub _mk_server {
-    my $self   = shift;
-    my $script = $self->{script};
+    my $self      = shift;
+    my $script    = $self->{script};
     my $appprefix = $self->{appprefix};
     $self->render_file( 'server', "$script\/$appprefix\_server.pl" );
     chmod 0700, "$script/$appprefix\_server.pl";
 }
 
 sub _mk_test {
-    my $self   = shift;
-    my $script = $self->{script};
+    my $self      = shift;
+    my $script    = $self->{script};
     my $appprefix = $self->{appprefix};
     $self->render_file( 'test', "$script/$appprefix\_test.pl" );
     chmod 0700, "$script/$appprefix\_test.pl";
 }
 
 sub _mk_create {
-    my $self   = shift;
-    my $script = $self->{script};
+    my $self      = shift;
+    my $script    = $self->{script};
     my $appprefix = $self->{appprefix};
     $self->render_file( 'create', "$script\/$appprefix\_create.pl" );
     chmod 0700, "$script/$appprefix\_create.pl";
@@ -394,7 +419,7 @@ Sebastian Riedel, C<sri@oook.de>
 
 =head1 LICENSE
 
-This library is free software . You can redistribute it and/or modify 
+This library is free software . You can redistribute it and/or modify
 it under the same terms as perl itself.
 
 =cut
@@ -414,36 +439,88 @@ our $VERSION = '0.01';
 
 [% name %]->setup;
 
-sub default : Private {
-    my ( $self, $c ) = @_;
-    $c->res->output('Congratulations, [% name %] is on Catalyst!');
-}
-
 =head1 NAME
 
-[% name %] - A very nice application
+[% name %] - Catalyst based application
 
 =head1 SYNOPSIS
 
-    Very simple to use
+    script/[% appprefix %]_server.pl
 
 =head1 DESCRIPTION
 
-Very nice application.
+Catalyst based application.
+
+=head1 METHODS
+
+=over 4
+
+=item default
+
+=cut
+
+sub default : Private {
+    my ( $self, $c ) = @_;
+
+    # Hello World
+    $c->response->output( $c->welcome_message );
+}
+
+#=item end
+#
+#=cut
+#
+#sub end : Private {
+#    my ( $self, $c ) = @_;
+#
+#    # Forward to View unless response body is already defined
+#    $c->forward('MyApp::V::') unless $c->response->body;
+#}
+
+=back
 
 =head1 AUTHOR
 
-[%author%]
+[% author %]
 
 =head1 LICENSE
 
-This library is free software . You can redistribute it and/or modify 
+This library is free software . You can redistribute it and/or modify
 it under the same terms as perl itself.
 
 =cut
 
 1;
+__makefile__
+    unless ( eval "use Module::Build::Compat 0.02; 1" ) {
+        print "This module requires Module::Build to install itself.\n";
+
+        require ExtUtils::MakeMaker;
+        my $yn =
+          ExtUtils::MakeMaker::prompt( '  Install Module::Build now from CPAN?',            'y' );
+
+        unless ( $yn =~ /^y/i ) {
+            die " *** Cannot install without Module::Build.  Exiting ...\n";
+        }
 
+        require Cwd;
+        require File::Spec;
+        require CPAN;
+
+        # Save this 'cause CPAN will chdir all over the place.
+        my $cwd      = Cwd::cwd();
+        my $makefile = File::Spec->rel2abs($0);
+
+        CPAN::Shell->install('Module::Build::Compat')
+          or die " *** Cannot install without Module::Build.  Exiting ...\n";
+
+        chdir $cwd or die "Cannot chdir() back to $cwd: $!";
+    }
+    eval "use Module::Build::Compat 0.02; 1" or die $@;
+    use lib '_build/lib';
+    Module::Build::Compat->run_build_pl( args => \@ARGV );
+    require Module::Build;
+    Module::Build::Compat->write_makefile( build_class => 'Module::Build' );
 __build__
 use strict;
 use Catalyst::Build;
@@ -458,22 +535,17 @@ my $build = Catalyst::Build->new(
     test_files         => [ glob('t/*.t'), glob('t/*/*.t') ]
 );
 $build->create_build_script;
-
 __readme__
-Run script/[% apprefix %]_server.pl to test the application.
-
+Run script/[% appprefix %]_server.pl to test the application.
 __changes__
 This file documents the revision history for Perl extension [% name %].
-
 0.01  [% time %]
         - initial revision, generated by Catalyst
-
 __apptest__
 use Test::More tests => 2;
 use_ok( Catalyst::Test, '[% name %]' );
 
 ok( request('/')->is_success );
-
 __podtest__
 use Test::More;
 
@@ -482,7 +554,6 @@ plan skip_all => 'Test::Pod 1.14 required' if $@;
 plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
 
 all_pod_files_ok();
-
 __podcoveragetest__
 use Test::More;
 
@@ -491,10 +562,10 @@ plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
 plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
 
 all_pod_coverage_ok();
-
 __cgi__
 [% startperl %] -w
-BEGIN { $ENV{CATALYST_ENGINE} = 'CGI' }
+
+BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' }
 
 use strict;
 use FindBin;
@@ -507,7 +578,7 @@ use [% name %];
 
 =head1 NAME
 
-cgi - Catalyst CGI
+[% appprefix %]_cgi.pl - Catalyst CGI
 
 =head1 SYNOPSIS
 
@@ -525,15 +596,14 @@ Sebastian Riedel, C<sri@oook.de>
 
 Copyright 2004 Sebastian Riedel. All rights reserved.
 
-This library is free software. You can redistribute it and/or modify 
+This library is free software. You can redistribute it and/or modify
 it under the same terms as perl itself.
 
 =cut
-
-__fcgi__
+__fastcgi__
 [% startperl %] -w
 
-BEGIN { $ENV{CATALYST_ENGINE} = 'FCGI' }
+BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' }
 
 use strict;
 use FindBin;
@@ -546,7 +616,7 @@ use [% name %];
 
 =head1 NAME
 
-fcgi - Catalyst FCGI
+[% appprefix %]_fastcgi.pl - Catalyst FastCGI
 
 =head1 SYNOPSIS
 
@@ -554,7 +624,7 @@ See L<Catalyst::Manual>
 
 =head1 DESCRIPTION
 
-Run a Catalyst application as fcgi.
+Run a Catalyst application as fastcgi.
 
 =head1 AUTHOR
 
@@ -564,16 +634,15 @@ Sebastian Riedel, C<sri@oook.de>
 
 Copyright 2004 Sebastian Riedel. All rights reserved.
 
-This library is free software. You can redistribute it and/or modify 
+This library is free software. You can redistribute it and/or modify
 it under the same terms as perl itself.
 
 =cut
-
 __server__
 [% startperl %] -w
 
 BEGIN { 
-    $ENV{CATALYST_ENGINE} = 'HTTP';
+    $ENV{CATALYST_ENGINE} ||= 'HTTP';
     $ENV{CATALYST_SCRIPT_GEN} = [% scriptgen %];
 }  
 
@@ -584,28 +653,58 @@ use FindBin;
 use lib "$FindBin::Bin/../lib";
 use [% name %];
 
-my $help = 0;
-my $port = 3000;
-
-GetOptions( 'help|?' => \$help, 'port=s' => \$port );
+my $fork          = 0;
+my $help          = 0;
+my $host          = undef;
+my $port          = 3000;
+my $restart       = 0;
+my $restart_delay = 1;
+my $restart_regex = '\.yml$|\.yaml$|\.pm$';
+
+my @argv = @ARGV;
+
+GetOptions(
+    'fork'              => \$fork,
+    'help|?'            => \$help,
+    'host=s'            => \$host,
+    'port=s'            => \$port,
+    'restart|r'         => \$restart,
+    'restartdelay|rd=s' => \$restart_delay,
+    'restartregex|rr=s' => \$restart_regex
+);
 
 pod2usage(1) if $help;
 
-[% name %]->run($port);
+[% name %]->run( $port, $host, {
+    argv   => \@argv,
+    'fork' => $fork,
+    restart => $restart,
+    restart_delay => $restart_delay,
+    restart_regex => qr/$restart_regex/
+} );
 
 1;
 
 =head1 NAME
 
-server - Catalyst Testserver
+[% appprefix %]_server.pl - Catalyst Testserver
 
 =head1 SYNOPSIS
 
-server.pl [options]
+[% appprefix %]_server.pl [options]
 
  Options:
-   -? -help    display this help and exits
-   -p -port    port (defaults to 3000)
+   -f -fork           handle each request in a new process
+                      (defaults to false)
+   -? -help           display this help and exits
+      -host           host (defaults to all)
+   -p -port           port (defaults to 3000)
+   -r -restart        restart when files got modified
+                      (defaults to false)
+   -rd -restartdelay  delay between file checks
+   -rr -restartregex  regex match files that trigger
+                      a restart when modified
+                      (defaults to '\.yml$|\.yaml$|\.pm$')
 
  See also:
    perldoc Catalyst::Manual
@@ -623,15 +722,14 @@ Sebastian Riedel, C<sri@oook.de>
 
 Copyright 2004 Sebastian Riedel. All rights reserved.
 
-This library is free software. You can redistribute it and/or modify 
+This library is free software. You can redistribute it and/or modify
 it under the same terms as perl itself.
 
 =cut
-
 __test__
 [% startperl %] -w
 
-BEGIN { $ENV{CATALYST_ENGINE} = 'Test' }
+BEGIN { $ENV{CATALYST_ENGINE} ||= 'Test' }
 
 use strict;
 use Getopt::Long;
@@ -652,18 +750,18 @@ print [% name %]->run($ARGV[0])->content . "\n";
 
 =head1 NAME
 
-test - Catalyst Test
+[% appprefix %]_test.pl - Catalyst Test
 
 =head1 SYNOPSIS
 
-test.pl [options] uri
+[% appprefix %]_test.pl [options] uri
 
  Options:
    -help    display this help and exits
 
  Examples:
-   test.pl http://localhost/some_action
-   test.pl /some_action
+   [% appprefix %]_test.pl http://localhost/some_action
+   [% appprefix %]_test.pl /some_action
 
  See also:
    perldoc Catalyst::Manual
@@ -671,7 +769,7 @@ test.pl [options] uri
 
 =head1 DESCRIPTION
 
-Run a Catalyst action from the comand line.
+Run a Catalyst action from the command line.
 
 =head1 AUTHOR
 
@@ -681,11 +779,10 @@ Sebastian Riedel, C<sri@oook.de>
 
 Copyright 2004 Sebastian Riedel. All rights reserved.
 
-This library is free software. You can redistribute it and/or modify 
+This library is free software. You can redistribute it and/or modify
 it under the same terms as perl itself.
 
 =cut
-
 __create__
 [% startperl %] -w
 
@@ -695,36 +792,38 @@ use Pod::Usage;
 use Catalyst::Helper;
 
 my $help = 0;
+my $nonew = 0;
 
-GetOptions( 'help|?' => \$help );
+GetOptions( 'help|?' => \$help,
+           'nonew'  => \$nonew );
 
 pod2usage(1) if ( $help || !$ARGV[0] );
 
-my $helper = Catalyst::Helper->new;
+my $helper = Catalyst::Helper->new({'.newfiles' => !$nonew});
 pod2usage(1) unless $helper->mk_component( '[% name %]', @ARGV );
 
 1;
 
 =head1 NAME
 
-create - Create a new Catalyst Component
+[% appprefix %]_create.pl - Create a new Catalyst Component
 
 =head1 SYNOPSIS
 
-create.pl [options] model|view|controller name [helper] [options]
+[% appprefix %]_create.pl [options] model|view|controller name [helper] [options]
 
  Options:
    -help    display this help and exits
+   -nonew   don't create a .new file where a file to be created exists
 
  Examples:
-   create.pl controller My::Controller
-   create.pl view My::View
-   create.pl view MyView TT
-   create.pl view TT TT
-   create.pl model My::Model
-   create.pl model SomeDB CDBI dbi:SQLite:/tmp/my.db
-   create.pl model AnotherDB CDBI dbi:Pg:dbname=foo root 4321
-   create.pl Ajax
+   [% appprefix %]_create.pl controller My::Controller
+   [% appprefix %]_create.pl view My::View
+   [% appprefix %]_create.pl view MyView TT
+   [% appprefix %]_create.pl view TT TT
+   [% appprefix %]_create.pl model My::Model
+   [% appprefix %]_create.pl model SomeDB CDBI dbi:SQLite:/tmp/my.db
+   [% appprefix %]_create.pl model AnotherDB CDBI dbi:Pg:dbname=foo root 4321
 
  See also:
    perldoc Catalyst::Manual
@@ -734,6 +833,10 @@ create.pl [options] model|view|controller name [helper] [options]
 
 Create a new Catalyst Component.
 
+Existing component files are not overwritten.  If any of the component files
+to be created already exist the file will be written with a '.new' suffix.
+This behavior can be suppressed with the C<-nonew> option.
+
 =head1 AUTHOR
 
 Sebastian Riedel, C<sri\@oook.de>
@@ -742,56 +845,65 @@ Sebastian Riedel, C<sri\@oook.de>
 
 Copyright 2004 Sebastian Riedel. All rights reserved.
 
-This library is free software. You can redistribute it and/or modify 
+This library is free software. You can redistribute it and/or modify
 it under the same terms as perl itself.
 
 =cut
-
 __compclass__
 package [% class %];
 
 use strict;
 use base 'Catalyst::Base';
 
-[% IF type == 'C' %]
-sub default : Private {
-    my ( $self, $c ) = @_;
-    $c->res->output('Congratulations, [% class %] is on Catalyst!');
-}
-
-[% END %]
 =head1 NAME
 
-[% class %] - A Component
+[% class %] - Catalyst component
 
 =head1 SYNOPSIS
 
-    Very simple to use
+See L<[% app %]>
 
 =head1 DESCRIPTION
 
-Very nice component.
+Catalyst component.
+[% IF type == 'C' %]
+=head1 METHODS
+
+=over 4
+
+=item default
+
+=cut
 
+sub default : Private {
+    my ( $self, $c ) = @_;
+
+    # Hello World
+    $c->response->output('Congratulations, [% class %] is on Catalyst!');
+}
+
+=back
+
+[% END %]
 =head1 AUTHOR
 
 [%author%]
 
 =head1 LICENSE
 
-This library is free software . You can redistribute it and/or modify 
+This library is free software . You can redistribute it and/or modify
 it under the same terms as perl itself.
 
 =cut
 
 1;
-
 __comptest__
 [% IF type == 'C' %]
 use Test::More tests => 3;
 use_ok( Catalyst::Test, '[% app %]' );
 use_ok('[% class %]');
 
-ok( request('[% prefix %]')->is_success );
+ok( request('[% uri %]')->is_success );
 [% ELSE %]
 use Test::More tests => 1;
 use_ok('[% class %]');