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

package Catalyst::Helper;

use strict;
use base 'Class::Accessor::Fast';
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_apptest;
    $self->_mk_server;
    $self->_mk_test;
    $self->_mk_create;
    return 1;
}

sub _mk_dirs {
    my $self = shift;
    mkpath $self->{dir} unless -d $self->{dir};
    $self->{bin} = File::Spec->catdir( $self->{dir}, 'bin' );
    mkpath $self->{bin};
    $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
    mkpath $self->{lib};
    $self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
    mkpath $self->{root};
    $self->{t} = File::Spec->catdir( $self->{dir}, 't' );
    mkpath $self->{t};
    $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
    $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
    mkpath $self->{mod};
    $self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
    mkpath $self->{m};
    $self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
    mkpath $self->{v};
    $self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
    mkpath $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};
    my $class = IO::File->new("> $mod.pm")
      or die qq/Couldn't open "$mod.pm", "$!"/;
    print $class <<"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};
    my $makefile = IO::File->new("> $dir/Makefile.PL")
      or die qq/Couldn't open "$dir\/Makefile.PL", "$!"/;
    print $makefile <<"EOF";
use ExtUtils::MakeMaker;

WriteMakefile(
    NAME         => '$name',
    VERSION_FROM => 'lib/$class.pm',
    PREREQ_PM    => { Catalyst => 0 }
);
EOF
}

sub _mk_apptest {
    my $self = shift;
    my $t    = $self->{t};
    my $name = $self->{name};
    my $test = IO::File->new("> $t/01app.t")
      or die qq/Couldn't open "$t\/01app.t", "$!"/;
    print $test <<"EOF";
use Test::More tests => 2;
use_ok( Catalyst::Test, '$name' );

ok( request('/')->is_success );
EOF
    my $pc = IO::File->new("> $t/02podcoverage.t")
      or die qq/Couldn't open "$t\/02podcoverage.t", "$!"/;
    print $pc <<"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_server {
    my $self   = shift;
    my $name   = $self->{name};
    my $bin    = $self->{bin};
    my $server = IO::File->new("> $bin/server")
      or die qq/Could't open "$bin\/server", "$!"/;
    print $server <<"EOF";
#!/usr/bin/perl -w

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

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

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

pod2usage(1) if \$help;

Catalyst::Test::server(\$port);

1;
__END__

=head1 NAME

server - Catalyst Testserver

=head1 SYNOPSIS

server [options]

 Options:
   -help    display this help and exits
   -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, "$bin/server";
}

sub _mk_test {
    my $self = shift;
    my $name = $self->{name};
    my $bin  = $self->{bin};
    my $test = IO::File->new("> $bin/test")
      or die qq/Could't open "$bin\/test", "$!"/;
    print $test <<"EOF";
#!/usr/bin/perl -w

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

my \$help = 0;

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

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

require Catalyst::Test;
import Catalyst::Test '$name';

print get(\$ARGV[0]) . "\n";

1;
__END__

=head1 NAME

test - Catalyst Test

=head1 SYNOPSIS

test [options] uri

 Options:
   -help    display this help and exits

 Examples:
   perl test http://localhost/some_action
   perl test /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, "$bin/test";
}

sub _mk_create {
    my $self   = shift;
    my $name   = $self->{name};
    my $bin    = $self->{bin};
    my $create = IO::File->new("> $bin/create")
      or die qq/Could't open "$bin\/create", "$!"/;
    print $create <<"EOF";
#!/usr/bin/perl -w

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

my \$help = 0;

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

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

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 [options] model|view|controller name [helper] [options]

 Options:
   -help    display this help and exits

 Examples:
   perl create controller My::Controller
   perl create view My::View
   perl create view MyView TT
   perl create view TT TT
   perl create model My::Model
   perl create model SomeDB CDBI dbi:SQLite:/tmp/my.db
   perl create model AnotherDB CDBI dbi:Pg:dbname=foo root 4321

 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, "$bin/create";
}

=head3 mk_component

=cut

sub mk_component {
    my ( $self, $app, $type, $name, $helper, @args ) = @_;
    return 0
      if ( $name =~ /[^\w\:]/ || !\$type =~ /^model|m|view|v|controller|c\$/i );
    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";
    $self->{app}   = $app;

    # 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
    my $dir = File::Spec->catdir( $FindBin::Bin, '..', 't' );
    my $num = '01';
    for my $i (<$dir/*.t>) {
        $i =~ /(\d+)[^\/]*.t$/;
        my $j = $1 || $num;
        $num = $j if $j > $num;
    }
    $num++;
    $num = sprintf '%02d', $num;
    my $prefix = $name;
    $prefix =~ s/::/_/g;
    $prefix = lc $prefix;
    my $tname = lc( $num . $type . '_' . $prefix . '.t' );
    $self->{prefix}   = $prefix;
    $self->{test_dir} = $dir;
    $self->{test}     = "$dir/$tname";

    # 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') ) {
            $class->mk_compclass( $self, @args );
        }
        else { $self->_mk_compclass }

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

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

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};
    my $comp = IO::File->new("> $file")
      or die qq/Couldn't open "$file", "$!"/;
    print $comp <<"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};
    my $t = IO::File->new("> $test") or die qq/Couldn't open "$test", "$!"/;

    if ( $self->{type} eq 'C' ) {
        print $t <<"EOF";
use Test::More tests => 3;
use_ok( Catalyst::Test, '$app' );
use_ok('$class');

ok( request('$prefix')->is_success );
EOF
    }
    else {
        print $t <<"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';
	5	use File::Spec;
	6	use File::Path;
	7	use IO::File;
	8	use FindBin;
	9
	10	=head1 NAME
	11
	12	Catalyst::Helper - Bootstrap a Catalyst application
	13
	14	=head1 SYNOPSIS
	15
	16	See L<Catalyst::Manual::Intro>
	17
	18	=head1 DESCRIPTION
	19
	20	Bootstrap a Catalyst application.
	21
	22	=head2 METHODS
	23
	24	=head3 mk_app
	25
	26	=cut
	27
	28	sub mk_app {
	29	my ( $self, $name ) = @_;
	30	return 0 if $name =~ /[^\w\:]/;
	31	$self->{name} = $name;
	32	$self->{dir} = $name;
	33	$self->{dir} =~ s/\:\:/-/g;
	34	$self->_mk_dirs;
	35	$self->_mk_appclass;
	36	$self->_mk_makefile;
	37	$self->_mk_apptest;
	38	$self->_mk_server;
	39	$self->_mk_test;
	40	$self->_mk_create;
	41	return 1;
	42	}
	43
	44	sub _mk_dirs {
	45	my $self = shift;
	46	mkpath $self->{dir} unless -d $self->{dir};
	47	$self->{bin} = File::Spec->catdir( $self->{dir}, 'bin' );
	48	mkpath $self->{bin};
	49	$self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
	50	mkpath $self->{lib};
	51	$self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
	52	mkpath $self->{root};
	53	$self->{t} = File::Spec->catdir( $self->{dir}, 't' );
	54	mkpath $self->{t};
	55	$self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
	56	$self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
	57	mkpath $self->{mod};
	58	$self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
	59	mkpath $self->{m};
	60	$self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
	61	mkpath $self->{v};
	62	$self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
	63	mkpath $self->{c};
	64	$self->{base} = File::Spec->rel2abs( $self->{dir} );
65	}
66
67	sub _mk_appclass {
68	my $self = shift;
69	my $mod = $self->{mod};
70	my $name = $self->{name};
71	my $base = $self->{base};
72	my $class = IO::File->new("> $mod.pm")
73	or die qq/Couldn't open "$mod.pm", "$!"/;
74	print $class <<"EOF";
75	package $name;
76
77	use strict;
78	use Catalyst qw/-Debug/;
79
80	our \$VERSION = '0.01';
81
82	$name->config(
83	name => '$name',
84	root => '$base/root',
85	);
86
87	$name->action(
88
89	'!default' => sub {
90	my ( \$self, \$c ) = \@_;
91	\$c->res->output('Congratulations, $name is on Catalyst!');
92	},
93
94	);
95
96	=head1 NAME
97
98	$name - A very nice application
99
100	=head1 SYNOPSIS
101
102	Very simple to use
103
104	=head1 DESCRIPTION
105
106	Very nice application.
107
108	=head1 AUTHOR
109
110	Clever guy
111
112	=head1 LICENSE
113
114	This library is free software . You can redistribute it and/or modify it under
115	the same terms as perl itself.
116
117	=cut
118
119	1;
120	EOF
121	}
122
123	sub _mk_makefile {
124	my $self = shift;
125	my $name = $self->{name};
126	my $dir = $self->{dir};
127	my $class = $self->{class};
128	my $makefile = IO::File->new("> $dir/Makefile.PL")
129	or die qq/Couldn't open "$dir\/Makefile.PL", "$!"/;
130	print $makefile <<"EOF";
131	use ExtUtils::MakeMaker;
132
133	WriteMakefile(
134	NAME => '$name',
135	VERSION_FROM => 'lib/$class.pm',
136	PREREQ_PM => { Catalyst => 0 }
137	);
138	EOF
139	}
140
141	sub _mk_apptest {
142	my $self = shift;
143	my $t = $self->{t};
144	my $name = $self->{name};
145	my $test = IO::File->new("> $t/01app.t")
146	or die qq/Couldn't open "$t\/01app.t", "$!"/;
147	print $test <<"EOF";
148	use Test::More tests => 2;
149	use_ok( Catalyst::Test, '$name' );
150
151	ok( request('/')->is_success );
152	EOF
1df125c9	153	my $pc = IO::File->new("> $t/02podcoverage.t")
	154	or die qq/Couldn't open "$t\/02podcoverage.t", "$!"/;
	155	print $pc <<"EOF";
	156	use Test::More;
	157
	158	eval "use Test::Pod::Coverage 1.04";
	159	plan skip_all => 'Test::Pod::Coverage 1.04 required' if \$@;
	160	plan skip_all => 'set TEST_POD to enable this test' unless \$ENV{TEST_POD};
	161
	162	all_pod_coverage_ok();
	163	EOF
fc7ec1d9	164	}
	165
	166	sub _mk_server {
	167	my $self = shift;
	168	my $name = $self->{name};
	169	my $bin = $self->{bin};
	170	my $server = IO::File->new("> $bin/server")
	171	or die qq/Could't open "$bin\/server", "$!"/;
	172	print $server <<"EOF";
	173	#!/usr/bin/perl -w
	174
	175	use strict;
	176	use Getopt::Long;
	177	use Pod::Usage;
	178	use FindBin;
	179	use lib "\$FindBin::Bin/../lib";
	180	use Catalyst::Test '$name';
	181
	182	my \$help = 0;
	183	my \$port = 3000;
	184
	185	GetOptions( 'help\|?' => \\\$help, 'port=s' => \\\$port );
	186
	187	pod2usage(1) if \$help;
	188
	189	Catalyst::Test::server(\$port);
	190
	191	1;
	192	__END__
	193
	194	=head1 NAME
	195
	196	server - Catalyst Testserver
	197
	198	=head1 SYNOPSIS
	199
	200	server [options]
	201
	202	Options:
	203	-help display this help and exits
	204	-port port (defaults to 3000)
	205
03a53815	206	See also:
	207	perldoc Catalyst::Manual
	208	perldoc Catalyst::Manual::Intro
	209
fc7ec1d9	210	=head1 DESCRIPTION
	211
	212	Run a Catalyst Testserver for this application.
	213
	214	=head1 AUTHOR
	215
	216	Sebastian Riedel, C<sri\@oook.de>
	217
	218	=head1 COPYRIGHT
	219
	220	Copyright 2004 Sebastian Riedel. All rights reserved.
	221
	222	This library is free software. You can redistribute it and/or modify it under
	223	the same terms as perl itself.
	224
	225	=cut
	226	EOF
	227	chmod 0700, "$bin/server";
	228	}
	229
	230	sub _mk_test {
	231	my $self = shift;
	232	my $name = $self->{name};
	233	my $bin = $self->{bin};
	234	my $test = IO::File->new("> $bin/test")
	235	or die qq/Could't open "$bin\/test", "$!"/;
	236	print $test <<"EOF";
	237	#!/usr/bin/perl -w
	238
	239	use strict;
	240	use Getopt::Long;
	241	use Pod::Usage;
	242	use FindBin;
	243	use lib "\$FindBin::Bin/../lib";
	244
	245	my \$help = 0;
	246
	247	GetOptions( 'help\|?' => \\\$help );
	248
	249	pod2usage(1) if ( \$help \|\| !\$ARGV[0] );
	250
	251	require Catalyst::Test;
	252	import Catalyst::Test '$name';
	253
	254	print get(\$ARGV[0]) . "\n";
	255
	256	1;
	257	__END__
	258
	259	=head1 NAME
	260
	261	test - Catalyst Test
	262
	263	=head1 SYNOPSIS
	264
	265	test [options] uri
	266
	267	Options:
	268	-help display this help and exits
	269
	270	Examples:
d7c505f3	271	perl test http://localhost/some_action
d7c505f3	272	perl test /some_action
fc7ec1d9	273
03a53815	274	See also:
	275	perldoc Catalyst::Manual
	276	perldoc Catalyst::Manual::Intro
	277
fc7ec1d9	278	=head1 DESCRIPTION
	279
	280	Run a Catalyst action from the comand line.
	281
	282	=head1 AUTHOR
	283
	284	Sebastian Riedel, C<sri\@oook.de>
	285
	286	=head1 COPYRIGHT
	287
	288	Copyright 2004 Sebastian Riedel. All rights reserved.
	289
	290	This library is free software. You can redistribute it and/or modify it under
	291	the same terms as perl itself.
	292
	293	=cut
	294	EOF
	295	chmod 0700, "$bin/test";
	296	}
	297
	298	sub _mk_create {
	299	my $self = shift;
	300	my $name = $self->{name};
	301	my $bin = $self->{bin};
	302	my $create = IO::File->new("> $bin/create")
	303	or die qq/Could't open "$bin\/create", "$!"/;
	304	print $create <<"EOF";
	305	#!/usr/bin/perl -w
	306
	307	use strict;
	308	use Getopt::Long;
	309	use Pod::Usage;
	310	use Catalyst::Helper;
	311
	312	my \$help = 0;
	313
	314	GetOptions( 'help\|?' => \$help );
	315
	316	pod2usage(1) if ( \$help \|\| !\$ARGV[1] );
	317
	318	my \$helper = Catalyst::Helper->new;
	319	pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV );
	320
	321	1;
	322	__END__
	323
	324	=head1 NAME
	325
	326	create - Create a new Catalyst Component
	327
	328	=head1 SYNOPSIS
	329
03a53815	330	create [options] model\|view\|controller name [helper] [options]
fc7ec1d9	331
	332	Options:
	333	-help display this help and exits
	334
	335	Examples:
d7c505f3	336	perl create controller My::Controller
	337	perl create view My::View
	338	perl create view MyView TT
	339	perl create view TT TT
	340	perl create model My::Model
	341	perl create model SomeDB CDBI dbi:SQLite:/tmp/my.db
	342	perl create model AnotherDB CDBI dbi:Pg:dbname=foo root 4321
03a53815	343
	344	See also:
	345	perldoc Catalyst::Manual
	346	perldoc Catalyst::Manual::Intro
fc7ec1d9	347
	348	=head1 DESCRIPTION
	349
	350	Create a new Catalyst Component.
	351
	352	=head1 AUTHOR
	353
	354	Sebastian Riedel, C<sri\@oook.de>
	355
	356	=head1 COPYRIGHT
	357
	358	Copyright 2004 Sebastian Riedel. All rights reserved.
	359
	360	This library is free software. You can redistribute it and/or modify it under
	361	the same terms as perl itself.
	362
	363	=cut
	364	EOF
	365	chmod 0700, "$bin/create";
	366	}
	367
	368	=head3 mk_component
	369
	370	=cut
	371
	372	sub mk_component {
	373	my ( $self, $app, $type, $name, $helper, @args ) = @_;
	374	return 0
	375	if ( $name =~ /[^\w\:]/ \|\| !\$type =~ /^model\|m\|view\|v\|controller\|c\$/i );
	376	return 0 if $name =~ /[^\w\:]/;
	377	$type = 'M' if $type =~ /model\|m/i;
	378	$type = 'V' if $type =~ /view\|v/i;
	379	$type = 'C' if $type =~ /controller\|c/i;
	380	$self->{type} = $type;
	381	$self->{name} = $name;
	382	$self->{class} = "$app\::$type\::$name";
	383	$self->{app} = $app;
	384
	385	# Class
	386	my $appdir = File::Spec->catdir( split /\:\:/, $app );
	387	my $path = File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type );
	388	my $file = $name;
	389	if ( $name =~ /\:/ ) {
	390	my @path = split /\:\:/, $name;
	391	$file = pop @path;
	392	$path = File::Spec->catdir( $path, @path );
	393	mkpath $path;
	394	}
	395	$file = File::Spec->catfile( $path, "$file.pm" );
	396	$self->{file} = $file;
	397
	398	# Test
	399	my $dir = File::Spec->catdir( $FindBin::Bin, '..', 't' );
	400	my $num = '01';
	401	for my $i (<$dir/*.t>) {
	402	$i =~ /(\d+)[^\/]*.t$/;
	403	my $j = $1 \|\| $num;
	404	$num = $j if $j > $num;
	405	}
	406	$num++;
	407	$num = sprintf '%02d', $num;
	408	my $prefix = $name;
	409	$prefix =~ s/::/_/g;
	410	$prefix = lc $prefix;
411	my $tname = lc( $num . $type . '_' . $prefix . '.t' );
412	$self->{prefix} = $prefix;
413	$self->{test_dir} = $dir;
414	$self->{test} = "$dir/$tname";
415
416	# Helper
417	if ($helper) {
418	my $comp = 'Model';
419	$comp = 'View' if $type eq 'V';
420	$comp = 'Controller' if $type eq 'C';
421	my $class = "Catalyst::Helper::$comp\::$helper";
422	eval "require $class";
423	die qq/Couldn't load helper "$class", "$@"/ if $@;
424	if ( $class->can('mk_compclass') ) {
425	$class->mk_compclass( $self, @args );
426	}
427	else { $self->_mk_compclass }
428
429	if ( $class->can('mk_comptest') ) {
430	$class->mk_comptest( $self, @args );
431	}
432	else { $self->_mk_comptest }
433	}
434
435	# Fallback
436	else {
437	$self->_mk_compclass;
438	$self->_mk_comptest;
439	}
440	return 1;
441	}
442
443	sub _mk_compclass {
444	my $self = shift;
445	my $app = $self->{app};
446	my $class = $self->{class};
447	my $type = $self->{type};
448	my $action = '';
449	$action = <<"EOF" if $type eq 'C';
450
451	$app->action(
452
453	'!?default' => sub {
454	my ( \$self, \$c ) = \@_;
455	\$c->res->output('Congratulations, $class is on Catalyst!');
456	},
457
458	);
459	EOF
460	my $file = $self->{file};
461	my $comp = IO::File->new("> $file")
462	or die qq/Couldn't open "$file", "$!"/;
463	print $comp <<"EOF";
464	package $class;
465
466	use strict;
467	use base 'Catalyst::Base';
468	$action
469	=head1 NAME
470
471	$class - A Component
472
473	=head1 SYNOPSIS
474
475	Very simple to use
476
477	=head1 DESCRIPTION
478
479	Very nice component.
480
481	=head1 AUTHOR
482
483	Clever guy
484
485	=head1 LICENSE
486
487	This library is free software . You can redistribute it and/or modify it under
488	the same terms as perl itself.
489
490	=cut
491
492	1;
493	EOF
494	}
495
496	sub _mk_comptest {
497	my $self = shift;
498	my $prefix = $self->{prefix};
499	my $type = $self->{type};
500	my $class = $self->{class};
501	my $app = $self->{app};
502	my $test = $self->{test};
503	my $t = IO::File->new("> $test") or die qq/Couldn't open "$test", "$!"/;
504
505	if ( $self->{type} eq 'C' ) {
506	print $t <<"EOF";
507	use Test::More tests => 3;
508	use_ok( Catalyst::Test, '$app' );
509	use_ok('$class');
510
511	ok( request('$prefix')->is_success );
512	EOF
513	}
514	else {
515	print $t <<"EOF";
516	use Test::More tests => 1;
517	use_ok('$class');
518	EOF
519	}
520	}
521
7833fdfc	522	=head1 HELPERS
	523
	524	Helpers are classes that provide two methods.
	525
	526	* mk_compclass - creates the Component class
	527	* mk_comptest - creates the Component test
	528
	529	So when you call C<bin/create view MyView TT>, create would try to execute
	530	Catalyst::Helper::View::TT->mk_compclass and
	531	Catalyst::Helper::View::TT->mk_comptest.
	532
	533	See L<Catalyst::Helper::View::TT> and L<Catalyst::Helper::Model::CDBI> for
	534	examples.
	535
	536	All helper classes should be under one of the following namespaces.
	537
	538	Catalyst::Helper::Model::
	539	Catalyst::Helper::View::
	540	Catalyst::Helper::Controller::
	541
fc7ec1d9	542	=head1 SEE ALSO
	543
	544	L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
	545	L<Catalyst::Response>, L<Catalyst>
	546
	547	=head1 AUTHOR
	548
	549	Sebastian Riedel, C<sri@oook.de>
	550
	551	=head1 LICENSE
	552
	553	This library is free software . You can redistribute it and/or modify it under
	554	the same terms as perl itself.
	555
	556	=cut
	557
	558	1;