[catagits/Catalyst-Runtime.git] / lib / Catalyst / Helper.pm

package Catalyst::Helper;

use strict;
use base 'Class::Accessor::Fast';
use Config;
use File::Spec;
use File::Path;
use IO::File;
use FindBin;

=head1 NAME

Catalyst::Helper - Bootstrap a Catalyst application

=head1 SYNOPSIS

See L<Catalyst::Manual::Intro>

=head1 DESCRIPTION

Bootstrap a Catalyst application.

=head2 METHODS

=head3 mk_app

=cut

sub mk_app {
    my ( $self, $name ) = @_;
    return 0 if $name =~ /[^\w\:]/;
    $self->{name} = $name;
    $self->{dir}  = $name;
    $self->{dir} =~ s/\:\:/-/g;
    $self->_mk_dirs;
    $self->_mk_appclass;
    $self->_mk_makefile;
    $self->_mk_readme;
    $self->_mk_changes;
    $self->_mk_apptest;
    $self->_mk_cgi;
    $self->_mk_nphcgi;
    $self->_mk_fcgi;
    $self->_mk_server;
    $self->_mk_test;
    $self->_mk_create;
    return 1;
}

=head3 mk_component

=cut

sub mk_component {
    my $self = shift;
    my $app  = shift;
    $self->{app} = $app;
    $self->{base} = File::Spec->catdir( $FindBin::Bin, '..' );
    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 ( $class->can('mk_stuff') ) {
            return 1 unless $class->mk_stuff( $self, @args );
        }
    }
    else {
        my $type   = shift;
        my $name   = shift;
        my $helper = shift;
        my @args   = @_;
        return 0 if $name =~ /[^\w\:]/;
        $type = 'M' if $type =~ /model|m/i;
        $type = 'V' if $type =~ /view|v/i;
        $type = 'C' if $type =~ /controller|c/i;
        $self->{type}  = $type;
        $self->{name}  = $name;
        $self->{class} = "$app\::$type\::$name";

        # Class
        my $appdir = File::Spec->catdir( split /\:\:/, $app );
        my $path =
          File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type );
        my $file = $name;
        if ( $name =~ /\:/ ) {
            my @path = split /\:\:/, $name;
            $file = pop @path;
            $path = File::Spec->catdir( $path, @path );
            mkpath $path;
        }
        $file = File::Spec->catfile( $path, "$file.pm" );
        $self->{file} = $file;

        # Test
        $self->{test_dir} = File::Spec->catdir( $FindBin::Bin, '..', 't' );
        $self->{test}     = $self->next_test;

        # Helper
        if ($helper) {
            my $comp = 'Model';
            $comp = 'View'       if $type eq 'V';
            $comp = 'Controller' if $type eq 'C';
            my $class = "Catalyst::Helper::$comp\::$helper";
            eval "require $class";
            die qq/Couldn't load helper "$class", "$@"/ if $@;
            if ( $class->can('mk_compclass') ) {
                return 1 unless $class->mk_compclass( $self, @args );
            }
            else { return 1 unless $self->_mk_compclass }

            if ( $class->can('mk_comptest') ) {
                $class->mk_comptest( $self, @args );
            }
            else { $self->_mk_comptest }
        }

        # Fallback
        else {
            return 1 unless $self->_mk_compclass;
            $self->_mk_comptest;
        }
    }
    return 1;
}

=head3 mk_dir

=cut

sub mk_dir {
    my ( $self, $dir ) = @_;
    if ( -d $dir ) {
        print qq/ exists "$dir"\n/;
        return 0;
    }
    if ( mkpath $dir) {
        print qq/created "$dir"\n/;
        return 1;
    }
    die qq/Couldn't create "$dir", "$!"/;
}

=head3 mk_file

=cut

sub mk_file {
    my ( $self, $file, $content ) = @_;
    if ( -e $file ) {
        print qq/ exists "$file"\n/;
        return 0;
    }
    if ( my $f = IO::File->new("> $file") ) {
        print $f $content;
        print qq/created "$file"\n/;
        return 1;
    }
    die qq/Couldn't create "$file", "$!"/;
}

=head3 next_test

=cut

sub next_test {
    my ( $self, $tname ) = @_;
    if ($tname) { $tname = "$tname.t" }
    else {
        my $name   = $self->{name};
        my $prefix = $name;
        $prefix =~ s/::/_/g;
        $prefix         = lc $prefix;
        $tname          = $prefix . '.t';
        $self->{prefix} = $prefix;
    }
    my $dir  = $self->{test_dir};
    my $type = lc $self->{type};
    return File::Spec->catfile( $dir, $type, $tname );
}

sub _mk_dirs {
    my $self = shift;
    $self->mk_dir( $self->{dir} );
    $self->{script} = File::Spec->catdir( $self->{dir}, 'script' );
    $self->mk_dir( $self->{script} );
    $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
    $self->mk_dir( $self->{lib} );
    $self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
    $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->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
    $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
    $self->mk_dir( $self->{mod} );
    $self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
    $self->mk_dir( $self->{m} );
    $self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
    $self->mk_dir( $self->{v} );
    $self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
    $self->mk_dir( $self->{c} );
    $self->{base} = File::Spec->rel2abs( $self->{dir} );
}

sub _mk_appclass {
    my $self = shift;
    my $mod  = $self->{mod};
    my $name = $self->{name};
    my $base = $self->{base};
    $self->mk_file( "$mod.pm", <<"EOF");
package $name;

use strict;
use Catalyst qw/-Debug/;

our \$VERSION = '0.01';

$name->config(
    name => '$name',
    root => '$base/root',
);

$name->action(

    '!default' => sub {
        my ( \$self, \$c ) = \@_;
        \$c->res->output('Congratulations, $name is on Catalyst!');
    },

);

=head1 NAME

$name - A very nice application

=head1 SYNOPSIS

    Very simple to use

=head1 DESCRIPTION

Very nice application.

=head1 AUTHOR

Clever guy

=head1 LICENSE

This library is free software . You can redistribute it and/or modify it under
the same terms as perl itself.

=cut

1;
EOF
}

sub _mk_makefile {
    my $self  = shift;
    my $name  = $self->{name};
    my $dir   = $self->{dir};
    my $class = $self->{class};
    $self->mk_file( "$dir\/Makefile.PL", <<"EOF");
use ExtUtils::MakeMaker;

WriteMakefile(
    NAME         => '$name',
    VERSION_FROM => 'lib/$class.pm',
    PREREQ_PM    => { Catalyst => 0 },
    test         => { TESTS => join ' ', ( glob('t/*.t'), glob('t/*/*.t') ) }
);
EOF
}

sub _mk_readme {
    my $self = shift;
    my $dir  = $self->{dir};
    $self->mk_file( "$dir\/README", <<"EOF");
Run script/server.pl to test the application.
EOF
}

sub _mk_changes {
    my $self = shift;
    my $name = $self->{name};
    my $dir  = $self->{dir};
    my $time = localtime time;
    $self->mk_file( "$dir\/Changes", <<"EOF");
This file documents the revision history for Perl extension $name.

0.01  $time
        - initial revision, generated by Catalyst
EOF
}

sub _mk_apptest {
    my $self = shift;
    my $t    = $self->{t};
    my $name = $self->{name};
    $self->mk_file( "$t\/01app.t", <<"EOF");
use Test::More tests => 2;
use_ok( Catalyst::Test, '$name' );

ok( request('/')->is_success );
EOF
    $self->mk_file( "$t\/02pod.t", <<"EOF");
use Test::More;

eval "use Test::Pod 1.14";
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();
EOF
    $self->mk_file( "$t\/03podcoverage.t", <<"EOF");
use Test::More;

eval "use Test::Pod::Coverage 1.04";
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();
EOF
}

sub _mk_cgi {
    my $self   = shift;
    my $name   = $self->{name};
    my $script = $self->{script};
    $self->mk_file( "$script\/cgi.pl", <<"EOF");
$Config{startperl} -w

BEGIN { \$ENV{CATALYST_ENGINE} = 'CGI' }

use strict;
use FindBin;
use lib "\$FindBin::Bin/../lib";
use $name;

$name->run;

1;
__END__

=head1 NAME

cgi - Catalyst CGI

=head1 SYNOPSIS

See L<Catalyst::Manual>

=head1 DESCRIPTION

Run a Catalyst application as cgi.

=head1 AUTHOR

Sebastian Riedel, C<sri\@oook.de>

=head1 COPYRIGHT

Copyright 2004 Sebastian Riedel. All rights reserved.

This library is free software. You can redistribute it and/or modify it under
the same terms as perl itself.

=cut
EOF
    chmod 0700, "$script/cgi.pl";
}

sub _mk_nphcgi {
    my $self   = shift;
    my $name   = $self->{name};
    my $script = $self->{script};
    $self->mk_file( "$script\/nph-cgi.pl", <<"EOF");
$Config{startperl} -w

BEGIN { \$ENV{CATALYST_ENGINE} = 'CGI::NPH' }

use strict;
use FindBin;
use lib "\$FindBin::Bin/../lib";
use $name;

$name->run;

1;
__END__

=head1 NAME

nph-cgi - Catalyst CGI

=head1 SYNOPSIS

See L<Catalyst::Manual>

=head1 DESCRIPTION

Run a Catalyst application as nph cgi.

=head1 AUTHOR

Sebastian Riedel, C<sri\@oook.de>

=head1 COPYRIGHT

Copyright 2004 Sebastian Riedel. All rights reserved.

This library is free software. You can redistribute it and/or modify it under
the same terms as perl itself.

=cut
EOF
    chmod 0700, "$script/nph-cgi.pl";
}

sub _mk_fcgi {
    my $self   = shift;
    my $name   = $self->{name};
    my $script = $self->{script};
    $self->mk_file( "$script\/fcgi.pl", <<"EOF");
$Config{startperl} -w

BEGIN { \$ENV{CATALYST_ENGINE} = 'FCGI' }

use strict;
use FindBin;
use lib "\$FindBin::Bin/../lib";
use $name;

$name->run;

1;
__END__

=head1 NAME

fcgi - Catalyst FCGI

=head1 SYNOPSIS

See L<Catalyst::Manual>

=head1 DESCRIPTION

Run a Catalyst application as fcgi.

=head1 AUTHOR

Sebastian Riedel, C<sri\@oook.de>

=head1 COPYRIGHT

Copyright 2004 Sebastian Riedel. All rights reserved.

This library is free software. You can redistribute it and/or modify it under
the same terms as perl itself.

=cut
EOF
    chmod 0700, "$script/fcgi.pl";
}

sub _mk_server {
    my $self   = shift;
    my $name   = $self->{name};
    my $script = $self->{script};
    $self->mk_file( "$script\/server.pl", <<"EOF");
$Config{startperl} -w

BEGIN { \$ENV{CATALYST_ENGINE} = 'Server' }

use strict;
use Getopt::Long;
use Pod::Usage;
use FindBin;
use lib "\$FindBin::Bin/../lib";
use $name;

my \$help = 0;
my \$port = 3000;

GetOptions( 'help|?' => \\\$help, 'port=s' => \\\$port );

pod2usage(1) if \$help;

$name->run(\$port);

1;
__END__

=head1 NAME

server - Catalyst Testserver

=head1 SYNOPSIS

server.pl [options]

 Options:
   -? -help    display this help and exits
   -p -port    port (defaults to 3000)

 See also:
   perldoc Catalyst::Manual
   perldoc Catalyst::Manual::Intro

=head1 DESCRIPTION

Run a Catalyst Testserver for this application.

=head1 AUTHOR

Sebastian Riedel, C<sri\@oook.de>

=head1 COPYRIGHT

Copyright 2004 Sebastian Riedel. All rights reserved.

This library is free software. You can redistribute it and/or modify it under
the same terms as perl itself.

=cut
EOF
    chmod 0700, "$script/server.pl";
}

sub _mk_test {
    my $self   = shift;
    my $name   = $self->{name};
    my $script = $self->{script};
    $self->mk_file( "$script/test.pl", <<"EOF");
$Config{startperl} -w

BEGIN { \$ENV{CATALYST_ENGINE} = 'Test' }

use strict;
use Getopt::Long;
use Pod::Usage;
use FindBin;
use lib "\$FindBin::Bin/../lib";
use $name;

my \$help = 0;

GetOptions( 'help|?' => \\\$help );

pod2usage(1) if ( \$help || !\$ARGV[0] );

print $name->run(\$ARGV[0])->content . "\n";

1;
__END__

=head1 NAME

test - Catalyst Test

=head1 SYNOPSIS

test.pl [options] uri

 Options:
   -help    display this help and exits

 Examples:
   test.pl http://localhost/some_action
   test.pl /some_action

 See also:
   perldoc Catalyst::Manual
   perldoc Catalyst::Manual::Intro

=head1 DESCRIPTION

Run a Catalyst action from the comand line.

=head1 AUTHOR

Sebastian Riedel, C<sri\@oook.de>

=head1 COPYRIGHT

Copyright 2004 Sebastian Riedel. All rights reserved.

This library is free software. You can redistribute it and/or modify it under
the same terms as perl itself.

=cut
EOF
    chmod 0700, "$script/test.pl";
}

sub _mk_create {
    my $self   = shift;
    my $name   = $self->{name};
    my $script = $self->{script};
    $self->mk_file( "$script\/create.pl", <<"EOF");
$Config{startperl} -w

use strict;
use Getopt::Long;
use Pod::Usage;
use Catalyst::Helper;

my \$help = 0;

GetOptions( 'help|?' => \$help );

pod2usage(1) if ( \$help || !\$ARGV[0] );

my \$helper = Catalyst::Helper->new;
pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV );

1;
__END__

=head1 NAME

create - Create a new Catalyst Component

=head1 SYNOPSIS

create.pl [options] model|view|controller name [helper] [options]

 Options:
   -help    display this help and exits

 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

 See also:
   perldoc Catalyst::Manual
   perldoc Catalyst::Manual::Intro

=head1 DESCRIPTION

Create a new Catalyst Component.

=head1 AUTHOR

Sebastian Riedel, C<sri\@oook.de>

=head1 COPYRIGHT

Copyright 2004 Sebastian Riedel. All rights reserved.

This library is free software. You can redistribute it and/or modify it under
the same terms as perl itself.

=cut
EOF
    chmod 0700, "$script/create.pl";
}

sub _mk_compclass {
    my $self   = shift;
    my $app    = $self->{app};
    my $class  = $self->{class};
    my $type   = $self->{type};
    my $action = '';
    $action = <<"EOF" if $type eq 'C';

$app->action(

    '!?default' => sub {
        my ( \$self, \$c ) = \@_;
        \$c->res->output('Congratulations, $class is on Catalyst!');
    },

);
EOF
    my $file = $self->{file};
    return $self->mk_file( "$file", <<"EOF");
package $class;

use strict;
use base 'Catalyst::Base';
$action
=head1 NAME

$class - A Component

=head1 SYNOPSIS

    Very simple to use

=head1 DESCRIPTION

Very nice component.

=head1 AUTHOR

Clever guy

=head1 LICENSE

This library is free software . You can redistribute it and/or modify it under
the same terms as perl itself.

=cut

1;
EOF
}

sub _mk_comptest {
    my $self   = shift;
    my $prefix = $self->{prefix};
    my $type   = $self->{type};
    my $class  = $self->{class};
    my $app    = $self->{app};
    my $test   = $self->{test};
    if ( $self->{type} eq 'C' ) {
        $self->mk_file( "$test", <<"EOF");
use Test::More tests => 3;
use_ok( Catalyst::Test, '$app' );
use_ok('$class');

ok( request('$prefix')->is_success );
EOF
    }
    else {
        $self->mk_file( "$test", <<"EOF");
use Test::More tests => 1;
use_ok('$class');
EOF
    }
}

=head1 HELPERS

Helpers are classes that provide two methods.

    * mk_compclass - creates the Component class
    * mk_comptest  - creates the Component test

So when you call C<bin/create view MyView TT>, create would try to execute
Catalyst::Helper::View::TT->mk_compclass and
Catalyst::Helper::View::TT->mk_comptest.

See L<Catalyst::Helper::View::TT> and L<Catalyst::Helper::Model::CDBI> for
examples.

All helper classes should be under one of the following namespaces.

    Catalyst::Helper::Model::
    Catalyst::Helper::View::
    Catalyst::Helper::Controller::

=head1 SEE ALSO

L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
L<Catalyst::Response>, L<Catalyst>

=head1 AUTHOR

Sebastian Riedel, C<sri@oook.de>

=head1 LICENSE

This library is free software . You can redistribute it and/or modify it under
the same terms as perl itself.

=cut

1;
Commit	Line	Data
fc7ec1d9	1	package Catalyst::Helper;
	2
	3	use strict;
	4	use base 'Class::Accessor::Fast';
f1d0b7ea	5	use Config;
fc7ec1d9	6	use File::Spec;
	7	use File::Path;
	8	use IO::File;
	9	use FindBin;
	10
	11	=head1 NAME
	12
	13	Catalyst::Helper - Bootstrap a Catalyst application
	14
	15	=head1 SYNOPSIS
	16
	17	See L<Catalyst::Manual::Intro>
	18
	19	=head1 DESCRIPTION
	20
	21	Bootstrap a Catalyst application.
	22
	23	=head2 METHODS
	24
	25	=head3 mk_app
	26
	27	=cut
	28
	29	sub mk_app {
	30	my ( $self, $name ) = @_;
	31	return 0 if $name =~ /[^\w\:]/;
	32	$self->{name} = $name;
	33	$self->{dir} = $name;
	34	$self->{dir} =~ s/\:\:/-/g;
	35	$self->_mk_dirs;
	36	$self->_mk_appclass;
	37	$self->_mk_makefile;
91864987	38	$self->_mk_readme;
91864987	39	$self->_mk_changes;
fc7ec1d9	40	$self->_mk_apptest;
bc024080	41	$self->_mk_cgi;
d8ab1b45	42	$self->_mk_nphcgi;
cb8d90e5	43	$self->_mk_fcgi;
fc7ec1d9	44	$self->_mk_server;
	45	$self->_mk_test;
	46	$self->_mk_create;
	47	return 1;
	48	}
	49
ad41e777	50	=head3 mk_component
	51
	52	=cut
	53
	54	sub mk_component {
b5524568	55	my $self = shift;
	56	my $app = shift;
	57	$self->{app} = $app;
	58	$self->{base} = File::Spec->catdir( $FindBin::Bin, '..' );
	59	unless ( $_[0] =~ /^model\|m\|view\|v\|controller\|c\$/i ) {
	60	my $helper = shift;
	61	my @args = @_;
	62	my $class = "Catalyst::Helper::$helper";
ad41e777	63	eval "require $class";
ad41e777	64	die qq/Couldn't load helper "$class", "$@"/ if $@;
b5524568	65	if ( $class->can('mk_stuff') ) {
b5524568	66	return 1 unless $class->mk_stuff( $self, @args );
ad41e777	67	}
ad41e777	68	}
ad41e777	69	else {
b5524568	70	my $type = shift;
	71	my $name = shift;
	72	my $helper = shift;
	73	my @args = @_;
	74	return 0 if $name =~ /[^\w\:]/;
	75	$type = 'M' if $type =~ /model\|m/i;
	76	$type = 'V' if $type =~ /view\|v/i;
	77	$type = 'C' if $type =~ /controller\|c/i;
	78	$self->{type} = $type;
	79	$self->{name} = $name;
	80	$self->{class} = "$app\::$type\::$name";
	81
	82	# Class
	83	my $appdir = File::Spec->catdir( split /\:\:/, $app );
	84	my $path =
	85	File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type );
	86	my $file = $name;
	87	if ( $name =~ /\:/ ) {
	88	my @path = split /\:\:/, $name;
	89	$file = pop @path;
	90	$path = File::Spec->catdir( $path, @path );
	91	mkpath $path;
	92	}
	93	$file = File::Spec->catfile( $path, "$file.pm" );
	94	$self->{file} = $file;
	95
	96	# Test
	97	$self->{test_dir} = File::Spec->catdir( $FindBin::Bin, '..', 't' );
	98	$self->{test} = $self->next_test;
	99
	100	# Helper
	101	if ($helper) {
	102	my $comp = 'Model';
	103	$comp = 'View' if $type eq 'V';
	104	$comp = 'Controller' if $type eq 'C';
	105	my $class = "Catalyst::Helper::$comp\::$helper";
	106	eval "require $class";
	107	die qq/Couldn't load helper "$class", "$@"/ if $@;
	108	if ( $class->can('mk_compclass') ) {
	109	return 1 unless $class->mk_compclass( $self, @args );
	110	}
	111	else { return 1 unless $self->_mk_compclass }
	112
	113	if ( $class->can('mk_comptest') ) {
	114	$class->mk_comptest( $self, @args );
	115	}
	116	else { $self->_mk_comptest }
	117	}
	118
	119	# Fallback
	120	else {
	121	return 1 unless $self->_mk_compclass;
	122	$self->_mk_comptest;
	123	}
ad41e777	124	}
	125	return 1;
	126	}
	127
	128	=head3 mk_dir
	129
	130	=cut
	131
	132	sub mk_dir {
	133	my ( $self, $dir ) = @_;
	134	if ( -d $dir ) {
	135	print qq/ exists "$dir"\n/;
	136	return 0;
	137	}
	138	if ( mkpath $dir) {
	139	print qq/created "$dir"\n/;
	140	return 1;
	141	}
	142	die qq/Couldn't create "$dir", "$!"/;
	143	}
	144
	145	=head3 mk_file
	146
	147	=cut
	148
	149	sub mk_file {
	150	my ( $self, $file, $content ) = @_;
	151	if ( -e $file ) {
	152	print qq/ exists "$file"\n/;
	153	return 0;
	154	}
	155	if ( my $f = IO::File->new("> $file") ) {
	156	print $f $content;
	157	print qq/created "$file"\n/;
	158	return 1;
	159	}
	160	die qq/Couldn't create "$file", "$!"/;
	161	}
	162
	163	=head3 next_test
	164
	165	=cut
	166
	167	sub next_test {
	168	my ( $self, $tname ) = @_;
3cb1db8c	169	if ($tname) { $tname = "$tname.t" }
ad41e777	170	else {
ad41e777	171	my $name = $self->{name};
ad41e777	172	my $prefix = $name;
	173	$prefix =~ s/::/_/g;
	174	$prefix = lc $prefix;
3cb1db8c	175	$tname = $prefix . '.t';
ad41e777	176	$self->{prefix} = $prefix;
ad41e777	177	}
3cb1db8c	178	my $dir = $self->{test_dir};
	179	my $type = lc $self->{type};
	180	return File::Spec->catfile( $dir, $type, $tname );
ad41e777	181	}
ad41e777	182
fc7ec1d9	183	sub _mk_dirs {
fc7ec1d9	184	my $self = shift;
ad41e777	185	$self->mk_dir( $self->{dir} );
91864987	186	$self->{script} = File::Spec->catdir( $self->{dir}, 'script' );
91864987	187	$self->mk_dir( $self->{script} );
fc7ec1d9	188	$self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
ad41e777	189	$self->mk_dir( $self->{lib} );
fc7ec1d9	190	$self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
ad41e777	191	$self->mk_dir( $self->{root} );
fc7ec1d9	192	$self->{t} = File::Spec->catdir( $self->{dir}, 't' );
ad41e777	193	$self->mk_dir( $self->{t} );
3cb1db8c	194	$self->mk_dir( File::Spec->catdir( $self->{t}, 'm' ) );
	195	$self->mk_dir( File::Spec->catdir( $self->{t}, 'v' ) );
	196	$self->mk_dir( File::Spec->catdir( $self->{t}, 'c' ) );
fc7ec1d9	197	$self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
fc7ec1d9	198	$self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
ad41e777	199	$self->mk_dir( $self->{mod} );
fc7ec1d9	200	$self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
ad41e777	201	$self->mk_dir( $self->{m} );
fc7ec1d9	202	$self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
ad41e777	203	$self->mk_dir( $self->{v} );
fc7ec1d9	204	$self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
ad41e777	205	$self->mk_dir( $self->{c} );
fc7ec1d9	206	$self->{base} = File::Spec->rel2abs( $self->{dir} );
	207	}
	208
	209	sub _mk_appclass {
ad41e777	210	my $self = shift;
	211	my $mod = $self->{mod};
	212	my $name = $self->{name};
	213	my $base = $self->{base};
	214	$self->mk_file( "$mod.pm", <<"EOF");
fc7ec1d9	215	package $name;
	216
	217	use strict;
	218	use Catalyst qw/-Debug/;
	219
	220	our \$VERSION = '0.01';
	221
	222	$name->config(
	223	name => '$name',
	224	root => '$base/root',
	225	);
	226
	227	$name->action(
	228
	229	'!default' => sub {
	230	my ( \$self, \$c ) = \@_;
	231	\$c->res->output('Congratulations, $name is on Catalyst!');
	232	},
	233
	234	);
	235
	236	=head1 NAME
	237
	238	$name - A very nice application
	239
	240	=head1 SYNOPSIS
	241
	242	Very simple to use
	243
	244	=head1 DESCRIPTION
	245
	246	Very nice application.
	247
	248	=head1 AUTHOR
	249
	250	Clever guy
	251
	252	=head1 LICENSE
	253
	254	This library is free software . You can redistribute it and/or modify it under
	255	the same terms as perl itself.
	256
	257	=cut
	258
	259	1;
	260	EOF
	261	}
	262
	263	sub _mk_makefile {
ad41e777	264	my $self = shift;
	265	my $name = $self->{name};
	266	my $dir = $self->{dir};
	267	my $class = $self->{class};
	268	$self->mk_file( "$dir\/Makefile.PL", <<"EOF");
fc7ec1d9	269	use ExtUtils::MakeMaker;
	270
	271	WriteMakefile(
	272	NAME => '$name',
	273	VERSION_FROM => 'lib/$class.pm',
3cb1db8c	274	PREREQ_PM => { Catalyst => 0 },
3cb1db8c	275	test => { TESTS => join ' ', ( glob('t/.t'), glob('t//*.t') ) }
fc7ec1d9	276	);
	277	EOF
	278	}
	279
91864987	280	sub _mk_readme {
	281	my $self = shift;
	282	my $dir = $self->{dir};
	283	$self->mk_file( "$dir\/README", <<"EOF");
	284	Run script/server.pl to test the application.
	285	EOF
	286	}
	287
	288	sub _mk_changes {
	289	my $self = shift;
	290	my $name = $self->{name};
	291	my $dir = $self->{dir};
	292	my $time = localtime time;
	293	$self->mk_file( "$dir\/Changes", <<"EOF");
	294	This file documents the revision history for Perl extension $name.
	295
	296	0.01 $time
	297	- initial revision, generated by Catalyst
	298	EOF
	299	}
	300
fc7ec1d9	301	sub _mk_apptest {
	302	my $self = shift;
	303	my $t = $self->{t};
	304	my $name = $self->{name};
ad41e777	305	$self->mk_file( "$t\/01app.t", <<"EOF");
fc7ec1d9	306	use Test::More tests => 2;
	307	use_ok( Catalyst::Test, '$name' );
	308
	309	ok( request('/')->is_success );
	310	EOF
5a8fd7e9	311	$self->mk_file( "$t\/02pod.t", <<"EOF");
	312	use Test::More;
	313
	314	eval "use Test::Pod 1.14";
	315	plan skip_all => 'Test::Pod 1.14 required' if $@;
	316	plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
	317
	318	all_pod_files_ok();
	319	EOF
	320	$self->mk_file( "$t\/03podcoverage.t", <<"EOF");
1df125c9	321	use Test::More;
	322
	323	eval "use Test::Pod::Coverage 1.04";
	324	plan skip_all => 'Test::Pod::Coverage 1.04 required' if \$@;
	325	plan skip_all => 'set TEST_POD to enable this test' unless \$ENV{TEST_POD};
	326
	327	all_pod_coverage_ok();
	328	EOF
fc7ec1d9	329	}
fc7ec1d9	330
bc024080	331	sub _mk_cgi {
	332	my $self = shift;
	333	my $name = $self->{name};
	334	my $script = $self->{script};
d8ab1b45	335	$self->mk_file( "$script\/cgi.pl", <<"EOF");
	336	$Config{startperl} -w
	337
	338	BEGIN { \$ENV{CATALYST_ENGINE} = 'CGI' }
	339
	340	use strict;
	341	use FindBin;
	342	use lib "\$FindBin::Bin/../lib";
	343	use $name;
	344
	345	$name->run;
	346
	347	1;
	348	__END__
	349
	350	=head1 NAME
	351
	352	cgi - Catalyst CGI
	353
	354	=head1 SYNOPSIS
	355
	356	See L<Catalyst::Manual>
	357
	358	=head1 DESCRIPTION
	359
	360	Run a Catalyst application as cgi.
	361
	362	=head1 AUTHOR
	363
	364	Sebastian Riedel, C<sri\@oook.de>
	365
	366	=head1 COPYRIGHT
	367
	368	Copyright 2004 Sebastian Riedel. All rights reserved.
	369
	370	This library is free software. You can redistribute it and/or modify it under
	371	the same terms as perl itself.
	372
	373	=cut
	374	EOF
	375	chmod 0700, "$script/cgi.pl";
	376	}
	377
	378	sub _mk_nphcgi {
	379	my $self = shift;
	380	my $name = $self->{name};
	381	my $script = $self->{script};
3fde004f	382	$self->mk_file( "$script\/nph-cgi.pl", <<"EOF");
bc024080	383	$Config{startperl} -w
bc024080	384
e646f111	385	BEGIN { \$ENV{CATALYST_ENGINE} = 'CGI::NPH' }
e4b4c2b6	386
bc024080	387	use strict;
	388	use FindBin;
	389	use lib "\$FindBin::Bin/../lib";
	390	use $name;
	391
	392	$name->run;
	393
	394	1;
	395	__END__
	396
	397	=head1 NAME
	398
3fde004f	399	nph-cgi - Catalyst CGI
bc024080	400
	401	=head1 SYNOPSIS
	402
	403	See L<Catalyst::Manual>
	404
	405	=head1 DESCRIPTION
	406
d8ab1b45	407	Run a Catalyst application as nph cgi.
bc024080	408
	409	=head1 AUTHOR
	410
	411	Sebastian Riedel, C<sri\@oook.de>
	412
	413	=head1 COPYRIGHT
	414
	415	Copyright 2004 Sebastian Riedel. All rights reserved.
	416
	417	This library is free software. You can redistribute it and/or modify it under
	418	the same terms as perl itself.
	419
	420	=cut
	421	EOF
3fde004f	422	chmod 0700, "$script/nph-cgi.pl";
bc024080	423	}
bc024080	424
cb8d90e5	425	sub _mk_fcgi {
	426	my $self = shift;
	427	my $name = $self->{name};
	428	my $script = $self->{script};
	429	$self->mk_file( "$script\/fcgi.pl", <<"EOF");
	430	$Config{startperl} -w
	431
ffb41d94	432	BEGIN { \$ENV{CATALYST_ENGINE} = 'FCGI' }
cb8d90e5	433
	434	use strict;
	435	use FindBin;
	436	use lib "\$FindBin::Bin/../lib";
cb8d90e5	437	use $name;
cb8d90e5	438
ffb41d94	439	$name->run;
cb8d90e5	440
	441	1;
	442	__END__
	443
	444	=head1 NAME
	445
	446	fcgi - Catalyst FCGI
	447
	448	=head1 SYNOPSIS
	449
	450	See L<Catalyst::Manual>
	451
	452	=head1 DESCRIPTION
	453
	454	Run a Catalyst application as fcgi.
	455
	456	=head1 AUTHOR
	457
	458	Sebastian Riedel, C<sri\@oook.de>
	459
	460	=head1 COPYRIGHT
	461
	462	Copyright 2004 Sebastian Riedel. All rights reserved.
	463
	464	This library is free software. You can redistribute it and/or modify it under
	465	the same terms as perl itself.
	466
	467	=cut
	468	EOF
	469	chmod 0700, "$script/fcgi.pl";
	470	}
	471
fc7ec1d9	472	sub _mk_server {
91864987	473	my $self = shift;
	474	my $name = $self->{name};
	475	my $script = $self->{script};
	476	$self->mk_file( "$script\/server.pl", <<"EOF");
f1d0b7ea	477	$Config{startperl} -w
fc7ec1d9	478
ffb41d94	479	BEGIN { \$ENV{CATALYST_ENGINE} = 'Server' }
585893b9	480
fc7ec1d9	481	use strict;
	482	use Getopt::Long;
	483	use Pod::Usage;
	484	use FindBin;
	485	use lib "\$FindBin::Bin/../lib";
585893b9	486	use $name;
fc7ec1d9	487
	488	my \$help = 0;
	489	my \$port = 3000;
	490
	491	GetOptions( 'help\|?' => \\\$help, 'port=s' => \\\$port );
	492
	493	pod2usage(1) if \$help;
	494
585893b9	495	$name->run(\$port);
fc7ec1d9	496
	497	1;
	498	__END__
	499
	500	=head1 NAME
	501
	502	server - Catalyst Testserver
	503
	504	=head1 SYNOPSIS
	505
91864987	506	server.pl [options]
fc7ec1d9	507
fc7ec1d9	508	Options:
ad41e777	509	-? -help display this help and exits
ad41e777	510	-p -port port (defaults to 3000)
fc7ec1d9	511
03a53815	512	See also:
	513	perldoc Catalyst::Manual
	514	perldoc Catalyst::Manual::Intro
	515
fc7ec1d9	516	=head1 DESCRIPTION
	517
	518	Run a Catalyst Testserver for this application.
	519
	520	=head1 AUTHOR
	521
	522	Sebastian Riedel, C<sri\@oook.de>
	523
	524	=head1 COPYRIGHT
	525
	526	Copyright 2004 Sebastian Riedel. All rights reserved.
	527
	528	This library is free software. You can redistribute it and/or modify it under
	529	the same terms as perl itself.
	530
	531	=cut
	532	EOF
91864987	533	chmod 0700, "$script/server.pl";
fc7ec1d9	534	}
	535
	536	sub _mk_test {
91864987	537	my $self = shift;
	538	my $name = $self->{name};
	539	my $script = $self->{script};
	540	$self->mk_file( "$script/test.pl", <<"EOF");
f1d0b7ea	541	$Config{startperl} -w
fc7ec1d9	542
e646f111	543	BEGIN { \$ENV{CATALYST_ENGINE} = 'Test' }
e646f111	544
fc7ec1d9	545	use strict;
	546	use Getopt::Long;
	547	use Pod::Usage;
	548	use FindBin;
	549	use lib "\$FindBin::Bin/../lib";
e646f111	550	use $name;
fc7ec1d9	551
	552	my \$help = 0;
	553
	554	GetOptions( 'help\|?' => \\\$help );
	555
	556	pod2usage(1) if ( \$help \|\| !\$ARGV[0] );
	557
e646f111	558	print $name->run(\$ARGV[0])->content . "\n";
fc7ec1d9	559
	560	1;
	561	__END__
	562
	563	=head1 NAME
	564
	565	test - Catalyst Test
	566
	567	=head1 SYNOPSIS
	568
91864987	569	test.pl [options] uri
fc7ec1d9	570
	571	Options:
	572	-help display this help and exits
	573
	574	Examples:
91864987	575	test.pl http://localhost/some_action
91864987	576	test.pl /some_action
fc7ec1d9	577
03a53815	578	See also:
	579	perldoc Catalyst::Manual
	580	perldoc Catalyst::Manual::Intro
	581
fc7ec1d9	582	=head1 DESCRIPTION
	583
	584	Run a Catalyst action from the comand line.
	585
	586	=head1 AUTHOR
	587
	588	Sebastian Riedel, C<sri\@oook.de>
	589
	590	=head1 COPYRIGHT
	591
	592	Copyright 2004 Sebastian Riedel. All rights reserved.
	593
	594	This library is free software. You can redistribute it and/or modify it under
	595	the same terms as perl itself.
	596
	597	=cut
	598	EOF
91864987	599	chmod 0700, "$script/test.pl";
fc7ec1d9	600	}
	601
	602	sub _mk_create {
91864987	603	my $self = shift;
	604	my $name = $self->{name};
	605	my $script = $self->{script};
	606	$self->mk_file( "$script\/create.pl", <<"EOF");
f1d0b7ea	607	$Config{startperl} -w
fc7ec1d9	608
	609	use strict;
	610	use Getopt::Long;
	611	use Pod::Usage;
	612	use Catalyst::Helper;
	613
	614	my \$help = 0;
	615
	616	GetOptions( 'help\|?' => \$help );
	617
b5524568	618	pod2usage(1) if ( \$help \|\| !\$ARGV[0] );
fc7ec1d9	619
	620	my \$helper = Catalyst::Helper->new;
	621	pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV );
	622
	623	1;
	624	__END__
	625
	626	=head1 NAME
	627
	628	create - Create a new Catalyst Component
	629
	630	=head1 SYNOPSIS
	631
91864987	632	create.pl [options] model\|view\|controller name [helper] [options]
fc7ec1d9	633
	634	Options:
	635	-help display this help and exits
	636
	637	Examples:
91864987	638	create.pl controller My::Controller
	639	create.pl view My::View
	640	create.pl view MyView TT
	641	create.pl view TT TT
	642	create.pl model My::Model
	643	create.pl model SomeDB CDBI dbi:SQLite:/tmp/my.db
	644	create.pl model AnotherDB CDBI dbi:Pg:dbname=foo root 4321
b5524568	645	create.pl Ajax
03a53815	646
	647	See also:
	648	perldoc Catalyst::Manual
	649	perldoc Catalyst::Manual::Intro
fc7ec1d9	650
	651	=head1 DESCRIPTION
	652
	653	Create a new Catalyst Component.
	654
	655	=head1 AUTHOR
	656
	657	Sebastian Riedel, C<sri\@oook.de>
	658
	659	=head1 COPYRIGHT
	660
	661	Copyright 2004 Sebastian Riedel. All rights reserved.
	662
	663	This library is free software. You can redistribute it and/or modify it under
	664	the same terms as perl itself.
	665
	666	=cut
	667	EOF
91864987	668	chmod 0700, "$script/create.pl";
fc7ec1d9	669	}
fc7ec1d9	670
fc7ec1d9	671	sub _mk_compclass {
	672	my $self = shift;
	673	my $app = $self->{app};
	674	my $class = $self->{class};
	675	my $type = $self->{type};
	676	my $action = '';
	677	$action = <<"EOF" if $type eq 'C';
	678
	679	$app->action(
	680
	681	'!?default' => sub {
	682	my ( \$self, \$c ) = \@_;
	683	\$c->res->output('Congratulations, $class is on Catalyst!');
	684	},
	685
	686	);
	687	EOF
	688	my $file = $self->{file};
ad41e777	689	return $self->mk_file( "$file", <<"EOF");
fc7ec1d9	690	package $class;
	691
	692	use strict;
	693	use base 'Catalyst::Base';
	694	$action
	695	=head1 NAME
	696
	697	$class - A Component
	698
	699	=head1 SYNOPSIS
	700
	701	Very simple to use
	702
	703	=head1 DESCRIPTION
	704
	705	Very nice component.
	706
	707	=head1 AUTHOR
	708
	709	Clever guy
	710
	711	=head1 LICENSE
	712
	713	This library is free software . You can redistribute it and/or modify it under
	714	the same terms as perl itself.
	715
	716	=cut
	717
	718	1;
	719	EOF
	720	}
	721
	722	sub _mk_comptest {
	723	my $self = shift;
	724	my $prefix = $self->{prefix};
	725	my $type = $self->{type};
	726	my $class = $self->{class};
	727	my $app = $self->{app};
	728	my $test = $self->{test};
fc7ec1d9	729	if ( $self->{type} eq 'C' ) {
ad41e777	730	$self->mk_file( "$test", <<"EOF");
fc7ec1d9	731	use Test::More tests => 3;
	732	use_ok( Catalyst::Test, '$app' );
	733	use_ok('$class');
	734
	735	ok( request('$prefix')->is_success );
	736	EOF
	737	}
	738	else {
ad41e777	739	$self->mk_file( "$test", <<"EOF");
fc7ec1d9	740	use Test::More tests => 1;
	741	use_ok('$class');
	742	EOF
	743	}
	744	}
	745
7833fdfc	746	=head1 HELPERS
	747
	748	Helpers are classes that provide two methods.
	749
	750	* mk_compclass - creates the Component class
	751	* mk_comptest - creates the Component test
	752
	753	So when you call C<bin/create view MyView TT>, create would try to execute
	754	Catalyst::Helper::View::TT->mk_compclass and
	755	Catalyst::Helper::View::TT->mk_comptest.
	756
	757	See L<Catalyst::Helper::View::TT> and L<Catalyst::Helper::Model::CDBI> for
	758	examples.
	759
	760	All helper classes should be under one of the following namespaces.
	761
	762	Catalyst::Helper::Model::
	763	Catalyst::Helper::View::
	764	Catalyst::Helper::Controller::
	765
fc7ec1d9	766	=head1 SEE ALSO
	767
	768	L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
	769	L<Catalyst::Response>, L<Catalyst>
	770
	771	=head1 AUTHOR
	772
	773	Sebastian Riedel, C<sri@oook.de>
	774
	775	=head1 LICENSE
	776
	777	This library is free software . You can redistribute it and/or modify it under
	778	the same terms as perl itself.
	779
	780	=cut
	781
	782	1;