[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
}

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
153	}
154
155	sub _mk_server {
156	my $self = shift;
157	my $name = $self->{name};
158	my $bin = $self->{bin};
159	my $server = IO::File->new("> $bin/server")
160	or die qq/Could't open "$bin\/server", "$!"/;
161	print $server <<"EOF";
162	#!/usr/bin/perl -w
163
164	use strict;
165	use Getopt::Long;
166	use Pod::Usage;
167	use FindBin;
168	use lib "\$FindBin::Bin/../lib";
169	use Catalyst::Test '$name';
170
171	my \$help = 0;
172	my \$port = 3000;
173
174	GetOptions( 'help\|?' => \\\$help, 'port=s' => \\\$port );
175
176	pod2usage(1) if \$help;
177
178	Catalyst::Test::server(\$port);
179
180	1;
181	__END__
182
183	=head1 NAME
184
185	server - Catalyst Testserver
186
187	=head1 SYNOPSIS
188
189	server [options]
190
191	Options:
192	-help display this help and exits
193	-port port (defaults to 3000)
194
03a53815	195	See also:
	196	perldoc Catalyst::Manual
	197	perldoc Catalyst::Manual::Intro
	198
fc7ec1d9	199	=head1 DESCRIPTION
	200
	201	Run a Catalyst Testserver for this application.
	202
	203	=head1 AUTHOR
	204
	205	Sebastian Riedel, C<sri\@oook.de>
	206
	207	=head1 COPYRIGHT
	208
	209	Copyright 2004 Sebastian Riedel. All rights reserved.
	210
	211	This library is free software. You can redistribute it and/or modify it under
	212	the same terms as perl itself.
	213
	214	=cut
	215	EOF
	216	chmod 0700, "$bin/server";
	217	}
	218
	219	sub _mk_test {
	220	my $self = shift;
	221	my $name = $self->{name};
	222	my $bin = $self->{bin};
	223	my $test = IO::File->new("> $bin/test")
	224	or die qq/Could't open "$bin\/test", "$!"/;
	225	print $test <<"EOF";
	226	#!/usr/bin/perl -w
	227
	228	use strict;
	229	use Getopt::Long;
	230	use Pod::Usage;
	231	use FindBin;
	232	use lib "\$FindBin::Bin/../lib";
	233
	234	my \$help = 0;
	235
	236	GetOptions( 'help\|?' => \\\$help );
	237
	238	pod2usage(1) if ( \$help \|\| !\$ARGV[0] );
	239
	240	require Catalyst::Test;
	241	import Catalyst::Test '$name';
	242
	243	print get(\$ARGV[0]) . "\n";
	244
	245	1;
	246	__END__
	247
	248	=head1 NAME
	249
	250	test - Catalyst Test
	251
	252	=head1 SYNOPSIS
	253
	254	test [options] uri
	255
	256	Options:
	257	-help display this help and exits
	258
	259	Examples:
d7c505f3	260	perl test http://localhost/some_action
d7c505f3	261	perl test /some_action
fc7ec1d9	262
03a53815	263	See also:
	264	perldoc Catalyst::Manual
	265	perldoc Catalyst::Manual::Intro
	266
fc7ec1d9	267	=head1 DESCRIPTION
	268
	269	Run a Catalyst action from the comand line.
	270
	271	=head1 AUTHOR
	272
	273	Sebastian Riedel, C<sri\@oook.de>
	274
	275	=head1 COPYRIGHT
	276
	277	Copyright 2004 Sebastian Riedel. All rights reserved.
	278
	279	This library is free software. You can redistribute it and/or modify it under
	280	the same terms as perl itself.
	281
	282	=cut
	283	EOF
	284	chmod 0700, "$bin/test";
	285	}
	286
	287	sub _mk_create {
	288	my $self = shift;
	289	my $name = $self->{name};
	290	my $bin = $self->{bin};
	291	my $create = IO::File->new("> $bin/create")
	292	or die qq/Could't open "$bin\/create", "$!"/;
	293	print $create <<"EOF";
	294	#!/usr/bin/perl -w
	295
	296	use strict;
	297	use Getopt::Long;
	298	use Pod::Usage;
	299	use Catalyst::Helper;
	300
	301	my \$help = 0;
	302
	303	GetOptions( 'help\|?' => \$help );
	304
	305	pod2usage(1) if ( \$help \|\| !\$ARGV[1] );
	306
	307	my \$helper = Catalyst::Helper->new;
	308	pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV );
	309
	310	1;
	311	__END__
	312
	313	=head1 NAME
	314
	315	create - Create a new Catalyst Component
	316
	317	=head1 SYNOPSIS
	318
03a53815	319	create [options] model\|view\|controller name [helper] [options]
fc7ec1d9	320
	321	Options:
	322	-help display this help and exits
	323
	324	Examples:
d7c505f3	325	perl create controller My::Controller
	326	perl create view My::View
	327	perl create view MyView TT
	328	perl create view TT TT
	329	perl create model My::Model
	330	perl create model SomeDB CDBI dbi:SQLite:/tmp/my.db
	331	perl create model AnotherDB CDBI dbi:Pg:dbname=foo root 4321
03a53815	332
	333	See also:
	334	perldoc Catalyst::Manual
	335	perldoc Catalyst::Manual::Intro
fc7ec1d9	336
	337	=head1 DESCRIPTION
	338
	339	Create a new Catalyst Component.
	340
	341	=head1 AUTHOR
	342
	343	Sebastian Riedel, C<sri\@oook.de>
	344
	345	=head1 COPYRIGHT
	346
	347	Copyright 2004 Sebastian Riedel. All rights reserved.
	348
	349	This library is free software. You can redistribute it and/or modify it under
	350	the same terms as perl itself.
	351
	352	=cut
	353	EOF
	354	chmod 0700, "$bin/create";
	355	}
	356
	357	=head3 mk_component
	358
	359	=cut
	360
	361	sub mk_component {
	362	my ( $self, $app, $type, $name, $helper, @args ) = @_;
	363	return 0
	364	if ( $name =~ /[^\w\:]/ \|\| !\$type =~ /^model\|m\|view\|v\|controller\|c\$/i );
	365	return 0 if $name =~ /[^\w\:]/;
	366	$type = 'M' if $type =~ /model\|m/i;
	367	$type = 'V' if $type =~ /view\|v/i;
	368	$type = 'C' if $type =~ /controller\|c/i;
	369	$self->{type} = $type;
	370	$self->{name} = $name;
	371	$self->{class} = "$app\::$type\::$name";
	372	$self->{app} = $app;
	373
	374	# Class
	375	my $appdir = File::Spec->catdir( split /\:\:/, $app );
	376	my $path = File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type );
	377	my $file = $name;
	378	if ( $name =~ /\:/ ) {
	379	my @path = split /\:\:/, $name;
	380	$file = pop @path;
	381	$path = File::Spec->catdir( $path, @path );
	382	mkpath $path;
	383	}
	384	$file = File::Spec->catfile( $path, "$file.pm" );
	385	$self->{file} = $file;
	386
	387	# Test
	388	my $dir = File::Spec->catdir( $FindBin::Bin, '..', 't' );
	389	my $num = '01';
	390	for my $i (<$dir/*.t>) {
	391	$i =~ /(\d+)[^\/]*.t$/;
	392	my $j = $1 \|\| $num;
	393	$num = $j if $j > $num;
	394	}
	395	$num++;
	396	$num = sprintf '%02d', $num;
	397	my $prefix = $name;
	398	$prefix =~ s/::/_/g;
	399	$prefix = lc $prefix;
400	my $tname = lc( $num . $type . '_' . $prefix . '.t' );
401	$self->{prefix} = $prefix;
402	$self->{test_dir} = $dir;
403	$self->{test} = "$dir/$tname";
404
405	# Helper
406	if ($helper) {
407	my $comp = 'Model';
408	$comp = 'View' if $type eq 'V';
409	$comp = 'Controller' if $type eq 'C';
410	my $class = "Catalyst::Helper::$comp\::$helper";
411	eval "require $class";
412	die qq/Couldn't load helper "$class", "$@"/ if $@;
413	if ( $class->can('mk_compclass') ) {
414	$class->mk_compclass( $self, @args );
415	}
416	else { $self->_mk_compclass }
417
418	if ( $class->can('mk_comptest') ) {
419	$class->mk_comptest( $self, @args );
420	}
421	else { $self->_mk_comptest }
422	}
423
424	# Fallback
425	else {
426	$self->_mk_compclass;
427	$self->_mk_comptest;
428	}
429	return 1;
430	}
431
432	sub _mk_compclass {
433	my $self = shift;
434	my $app = $self->{app};
435	my $class = $self->{class};
436	my $type = $self->{type};
437	my $action = '';
438	$action = <<"EOF" if $type eq 'C';
439
440	$app->action(
441
442	'!?default' => sub {
443	my ( \$self, \$c ) = \@_;
444	\$c->res->output('Congratulations, $class is on Catalyst!');
445	},
446
447	);
448	EOF
449	my $file = $self->{file};
450	my $comp = IO::File->new("> $file")
451	or die qq/Couldn't open "$file", "$!"/;
452	print $comp <<"EOF";
453	package $class;
454
455	use strict;
456	use base 'Catalyst::Base';
457	$action
458	=head1 NAME
459
460	$class - A Component
461
462	=head1 SYNOPSIS
463
464	Very simple to use
465
466	=head1 DESCRIPTION
467
468	Very nice component.
469
470	=head1 AUTHOR
471
472	Clever guy
473
474	=head1 LICENSE
475
476	This library is free software . You can redistribute it and/or modify it under
477	the same terms as perl itself.
478
479	=cut
480
481	1;
482	EOF
483	}
484
485	sub _mk_comptest {
486	my $self = shift;
487	my $prefix = $self->{prefix};
488	my $type = $self->{type};
489	my $class = $self->{class};
490	my $app = $self->{app};
491	my $test = $self->{test};
492	my $t = IO::File->new("> $test") or die qq/Couldn't open "$test", "$!"/;
493
494	if ( $self->{type} eq 'C' ) {
495	print $t <<"EOF";
496	use Test::More tests => 3;
497	use_ok( Catalyst::Test, '$app' );
498	use_ok('$class');
499
500	ok( request('$prefix')->is_success );
501	EOF
502	}
503	else {
504	print $t <<"EOF";
505	use Test::More tests => 1;
506	use_ok('$class');
507	EOF
508	}
509	}
510
7833fdfc	511	=head1 HELPERS
	512
	513	Helpers are classes that provide two methods.
	514
	515	* mk_compclass - creates the Component class
	516	* mk_comptest - creates the Component test
	517
	518	So when you call C<bin/create view MyView TT>, create would try to execute
	519	Catalyst::Helper::View::TT->mk_compclass and
	520	Catalyst::Helper::View::TT->mk_comptest.
	521
	522	See L<Catalyst::Helper::View::TT> and L<Catalyst::Helper::Model::CDBI> for
	523	examples.
	524
	525	All helper classes should be under one of the following namespaces.
	526
	527	Catalyst::Helper::Model::
	528	Catalyst::Helper::View::
	529	Catalyst::Helper::Controller::
	530
fc7ec1d9	531	=head1 SEE ALSO
	532
	533	L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
	534	L<Catalyst::Response>, L<Catalyst>
	535
	536	=head1 AUTHOR
	537
	538	Sebastian Riedel, C<sri@oook.de>
	539
	540	=head1 LICENSE
	541
	542	This library is free software . You can redistribute it and/or modify it under
	543	the same terms as perl itself.
	544
	545	=cut
	546
	547	1;