use strict;
use base 'Class::Accessor::Fast';
+use Config;
use File::Spec;
use File::Path;
use IO::File;
$self->_mk_dirs;
$self->_mk_appclass;
$self->_mk_makefile;
+ $self->_mk_readme;
+ $self->_mk_changes;
$self->_mk_apptest;
+ $self->_mk_cgi;
$self->_mk_server;
+ $self->_mk_cgiserver;
$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;
- mkpath $self->{dir} unless -d $self->{dir};
- $self->{bin} = File::Spec->catdir( $self->{dir}, 'bin' );
- mkpath $self->{bin};
+ $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' );
- mkpath $self->{lib};
+ $self->mk_dir( $self->{lib} );
$self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
- mkpath $self->{root};
+ $self->mk_dir( $self->{root} );
$self->{t} = File::Spec->catdir( $self->{dir}, 't' );
- mkpath $self->{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} );
- mkpath $self->{mod};
+ $self->mk_dir( $self->{mod} );
$self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
- mkpath $self->{m};
+ $self->mk_dir( $self->{m} );
$self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
- mkpath $self->{v};
+ $self->mk_dir( $self->{v} );
$self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
- mkpath $self->{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};
- my $class = IO::File->new("> $mod.pm")
- or die qq/Couldn't open "$mod.pm", "$!"/;
- print $class <<"EOF";
+ 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;
}
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";
+ 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 }
+ 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};
- my $test = IO::File->new("> $t/01app.t")
- or die qq/Couldn't open "$t\/01app.t", "$!"/;
- print $test <<"EOF";
+ $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\/02podcoverage.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\/nph-cgi.pl", <<"EOF");
+$Config{startperl} -w
+
+BEGIN {
+ \$ENV{CATALYST_ENGINE} = 'CGI';
+ \$ENV{CATALYST_TEST = 1;
+}
+
+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 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_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
+ my $script = $self->{script};
+ $self->mk_file( "$script\/server.pl", <<"EOF");
+$Config{startperl} -w
+
+BEGIN {
+ \$ENV{CATALYST_ENGINE} = 'Server';
+ \$ENV{CATALYST_TEST} = 1;
+}
use strict;
use Getopt::Long;
use Pod::Usage;
use FindBin;
use lib "\$FindBin::Bin/../lib";
-use Catalyst::Test '$name';
+use $name;
my \$help = 0;
my \$port = 3000;
pod2usage(1) if \$help;
-Catalyst::Test::server(\$port);
+$name->run(\$port);
1;
__END__
=head1 SYNOPSIS
-server [options]
+server.pl [options]
Options:
- -help display this help and exits
- -port port (defaults to 3000)
+ -? -help display this help and exits
+ -p -port port (defaults to 3000)
See also:
perldoc Catalyst::Manual
=cut
EOF
- chmod 0700, "$bin/server";
+ chmod 0700, "$script/server.pl";
+}
+
+sub _mk_cgiserver {
+ my $self = shift;
+ my $name = $self->{name};
+ my $script = $self->{script};
+ $self->mk_file( "$script\/cgi-server.pl", <<"EOF");
+$Config{startperl} -w
+
+BEGIN {
+ \$ENV{CATALYST_ENGINE} = 'Server';
+ \$ENV{CATALYST_TEST} = 1;
+}
+
+use strict;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "\$FindBin::Bin/../lib";
+use File::Spec;
+use $name;
+
+my \$help = 0;
+my \$port = 3000;
+
+GetOptions( 'help|?' => \\\$help, 'port=s' => \\\$port );
+
+pod2usage(1) if \$help;
+
+$name->run( \$port, File::Spec->catfile( \$FindBin::Bin, 'nph-cgi.pl' ) );
+
+1;
+__END__
+
+=head1 NAME
+
+cgi-server - Catalyst CGI Testserver
+
+=head1 SYNOPSIS
+
+cgi-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 CGI Testserver for this application.
+
+Similar to the regular server but doesn't require a restart
+after code changes!
+
+=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-server.pl";
}
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
+ my $self = shift;
+ my $name = $self->{name};
+ my $script = $self->{script};
+ $self->mk_file( "$script/test.pl", <<"EOF");
+$Config{startperl} -w
use strict;
use Getopt::Long;
=head1 SYNOPSIS
-test [options] uri
+test.pl [options] uri
Options:
-help display this help and exits
Examples:
- test http://localhost/some_action
- test /some_action
+ test.pl http://localhost/some_action
+ test.pl /some_action
See also:
perldoc Catalyst::Manual
=cut
EOF
- chmod 0700, "$bin/test";
+ chmod 0700, "$script/test.pl";
}
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
+ my $script = $self->{script};
+ $self->mk_file( "$script\/create.pl", <<"EOF");
+$Config{startperl} -w
use strict;
use Getopt::Long;
GetOptions( 'help|?' => \$help );
-pod2usage(1) if ( \$help || !\$ARGV[1] );
+pod2usage(1) if ( \$help || !\$ARGV[0] );
my \$helper = Catalyst::Helper->new;
pod2usage(1) unless \$helper->mk_component( '$name', \@ARGV );
=head1 SYNOPSIS
-create [options] model|view|controller name [helper] [options]
+create.pl [options] model|view|controller name [helper] [options]
Options:
-help display this help and exits
Examples:
- create controller My::Controller
- create view My::View
- create view MyView TT
- create view TT TT
- create model My::Model
- create model SomeDB CDBI dbi:SQLite:/tmp/my.db
- create model AnotherDB CDBI dbi:Pg:dbname=foo root 4321
+ 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
=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;
+ chmod 0700, "$script/create.pl";
}
sub _mk_compclass {
);
EOF
my $file = $self->{file};
- my $comp = IO::File->new("> $file")
- or die qq/Couldn't open "$file", "$!"/;
- print $comp <<"EOF";
+ return $self->mk_file( "$file", <<"EOF");
package $class;
use strict;
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";
+ $self->mk_file( "$test", <<"EOF");
use Test::More tests => 3;
use_ok( Catalyst::Test, '$app' );
use_ok('$class');
EOF
}
else {
- print $t <<"EOF";
+ $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>,
projects / catagits/Catalyst-Runtime.git / blobdiff