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

package Catalyst::Helper;

use strict;
use warnings;
use base 'Class::Accessor::Fast';
use Config;
use File::Spec;
use File::Path;
use FindBin;
use IO::File;
use POSIX 'strftime';
use Template;
use Catalyst::Devel;
use Catalyst::Utils;
use Catalyst::Exception;
use Path::Class qw/dir file/;
use File::ShareDir qw/dist_dir/;

my %cache;

=head1 NAME

Catalyst::Helper - Bootstrap a Catalyst application

=head1 SYNOPSIS

  catalyst.pl <myappname>

=cut

sub get_sharedir_file {
    my ($self, @filename) = @_;
    my $file = file( dist_dir('Catalyst-Devel'), @filename);
    warn $file;
    my $contents = $file->slurp;
    return $contents;
}

sub get_file {
    my ( $self, $file ) = @_;
   
    return $self->get_sharedir_file($file);
}

sub mk_app {
    my ( $self, $name ) = @_;

    # Needs to be here for PAR
    require Catalyst;

    if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) {
        warn "Error: Invalid application name.\n";
        return 0;
    }
    $self->{name            } = $name;
    $self->{dir             } = $name;
    $self->{dir             } =~ s/\:\:/-/g;
    $self->{script          } = File::Spec->catdir( $self->{dir}, 'script' );
    $self->{appprefix       } = Catalyst::Utils::appprefix($name);
    $self->{appenv          } = Catalyst::Utils::class2env($name);
    $self->{startperl       } = -r '/usr/bin/env'
                                ? '#!/usr/bin/env perl'
                                : "#!$Config{perlpath} -w";
    $self->{scriptgen       } = $Catalyst::Devel::CATALYST_SCRIPT_GEN || 4;
    $self->{catalyst_version} = $Catalyst::VERSION;
    $self->{author          } = $self->{author} = $ENV{'AUTHOR'}
      || eval { @{ [ getpwuid($<) ] }[6] }
      || 'Catalyst developer';

    my $gen_scripts  = ( $self->{makefile} ) ? 0 : 1;
    my $gen_makefile = ( $self->{scripts} )  ? 0 : 1;
    my $gen_app = ( $self->{scripts} || $self->{makefile} ) ? 0 : 1;

    if ($gen_app) {
        $self->_mk_dirs;
        $self->_mk_config;
        $self->_mk_appclass;
        $self->_mk_rootclass;
        $self->_mk_readme;
        $self->_mk_changes;
        $self->_mk_apptest;
        $self->_mk_images;
        $self->_mk_favicon;
    }
    if ($gen_makefile) {
        $self->_mk_makefile;
    }
    if ($gen_scripts) {
        $self->_mk_cgi;
        $self->_mk_fastcgi;
        $self->_mk_server;
        $self->_mk_test;
        $self->_mk_create;
        $self->_mk_information;
    }
    return $self->{dir};
}

sub mk_component {
    my $self = shift;
    my $app  = shift;
    $self->{app} = $app;
    $self->{author} = $self->{author} = $ENV{'AUTHOR'}
      || eval { @{ [ getpwuid($<) ] }[6] }
      || 'A clever guy';
    $self->{base} ||= File::Spec->catdir( $FindBin::Bin, '..' );
    unless ( $_[0] =~ /^(?:model|view|controller)$/i ) {
        my $helper = shift;
        my @args   = @_;
        my $class  = "Catalyst::Helper::$helper";
        eval "require $class";

        if ($@) {
            Catalyst::Exception->throw(
                message => qq/Couldn't load helper "$class", "$@"/ );
        }

        if ( $class->can('mk_stuff') ) {
            return 1 unless $class->mk_stuff( $self, @args );
        }
    }
    else {
        my $type   = shift;
        my $name   = shift || "Missing name for model/view/controller";
        my $helper = shift;
        my @args   = @_;
       return 0 if $name =~ /[^\w\:]/;
        $type              = lc $type;
        $self->{long_type} = ucfirst $type;
        $type              = 'M' if $type =~ /model/i;
        $type              = 'V' if $type =~ /view/i;
        $type              = 'C' if $type =~ /controller/i;
        my $appdir = File::Spec->catdir( split /\:\:/, $app );
        my $test_path =
          File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, 'C' );
        $type = $self->{long_type} unless -d $test_path;
        $self->{type}  = $type;
        $self->{name}  = $name;
        $self->{class} = "$app\::$type\::$name";

        # Class
        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 );
        }
        $self->mk_dir($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  = $self->{long_type};
            my $class = "Catalyst::Helper::$comp\::$helper";
            eval "require $class";

            if ($@) {
                Catalyst::Exception->throw(
                    message => qq/Couldn't load helper "$class", "$@"/ );
            }

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

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

    Catalyst::Exception->throw( message => qq/Couldn't create "$dir", "$!"/ );
}

sub mk_file {
    my ( $self, $file, $content ) = @_;
    if ( -e $file ) {
        print qq/ exists "$file"\n/;
        return 0
          unless ( $self->{'.newfiles'}
            || $self->{scripts}
            || $self->{makefile} );
        if ( $self->{'.newfiles'} ) {
            if ( my $f = IO::File->new("< $file") ) {
                my $oldcontent = join( '', (<$f>) );
                return 0 if $content eq $oldcontent;
            }
            $file .= '.new';
        }
    }
    if ( my $f = IO::File->new("> $file") ) {
        binmode $f;
        print $f $content;
        print qq/created "$file"\n/;
        return 1;
    }

    Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ );
}

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

sub render_file {
    my ( $self, $file, $path, $vars ) = @_;
    $vars ||= {};
    my $t = Template->new;
    my $template = $self->get_sharedir_file( 'root', $file );
    return 0 unless $template;
    my $output;
    $t->process( \$template, { %{$self}, %$vars }, \$output )
      || Catalyst::Exception->throw(
        message => qq/Couldn't process "$file", / . $t->error() );
    $self->mk_file( $path, $output );
}

sub _mk_information {
    my $self = shift;
    print qq/Change to application directory and Run "perl Makefile.PL" to make sure your install is complete\n/;
}

sub _mk_dirs {
    my $self = shift;
    $self->mk_dir( $self->{dir} );
    $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->{static} = File::Spec->catdir( $self->{root}, 'static' );
    $self->mk_dir( $self->{static} );
    $self->{images} = File::Spec->catdir( $self->{static}, 'images' );
    $self->mk_dir( $self->{images} );
    $self->{t} = File::Spec->catdir( $self->{dir}, 't' );
    $self->mk_dir( $self->{t} );

    $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
    $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
    $self->mk_dir( $self->{mod} );

    if ( $self->{short} ) {
        $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} );
    }
    else {
        $self->{m} = File::Spec->catdir( $self->{mod}, 'Model' );
        $self->mk_dir( $self->{m} );
        $self->{v} = File::Spec->catdir( $self->{mod}, 'View' );
        $self->mk_dir( $self->{v} );
        $self->{c} = File::Spec->catdir( $self->{mod}, 'Controller' );
        $self->mk_dir( $self->{c} );
    }
    my $name = $self->{name};
    $self->{rootname} =
      $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root";
    $self->{base} = File::Spec->rel2abs( $self->{dir} );
}

sub _mk_appclass {
    my $self = shift;
    my $mod  = $self->{mod};
    $self->render_file( 'appclass.tt', "$mod.pm" );
}

sub _mk_rootclass {
    my $self = shift;
    $self->render_file( 'rootclass.tt',
        File::Spec->catfile( $self->{c}, "Root.pm" ) );
}

sub _mk_makefile {
    my $self = shift;
    $self->{path} = File::Spec->catfile( 'lib', split( '::', $self->{name} ) );
    $self->{path} .= '.pm';
    my $dir = $self->{dir};
    $self->render_file( 'makefile.tt', "$dir\/Makefile.PL" );

    if ( $self->{makefile} ) {

        # deprecate the old Build.PL file when regenerating Makefile.PL
        $self->_deprecate_file(
            File::Spec->catdir( $self->{dir}, 'Build.PL' ) );
    }
}

sub _mk_config {
    my $self      = shift;
    my $dir       = $self->{dir};
    my $appprefix = $self->{appprefix};
    $self->render_file( 'config.tt',
        File::Spec->catfile( $dir, "$appprefix.conf" ) );
}

sub _mk_readme {
    my $self = shift;
    my $dir  = $self->{dir};
    $self->render_file( 'readme.tt', "$dir\/README" );
}

sub _mk_changes {
    my $self = shift;
    my $dir  = $self->{dir};
    my $time = strftime('%Y-%m-%d %H:%M:%S', localtime time);
    $self->render_file( 'changes.tt', "$dir\/Changes", { time => $time } );
}

sub _mk_apptest {
    my $self = shift;
    my $t    = $self->{t};
    $self->render_file( 'apptest.tt',         "$t\/01app.t" );
    $self->render_file( 'podtest.tt',         "$t\/02pod.t" );
    $self->render_file( 'podcoveragetest.tt', "$t\/03podcoverage.t" );
}

sub _mk_cgi {
    my $self      = shift;
    my $script    = $self->{script};
    my $appprefix = $self->{appprefix};
    $self->render_file( 'cgi.tt', "$script\/$appprefix\_cgi.pl" );
    chmod 0700, "$script/$appprefix\_cgi.pl";
}

sub _mk_fastcgi {
    my $self      = shift;
    my $script    = $self->{script};
    my $appprefix = $self->{appprefix};
    $self->render_file( 'fastcgi.tt', "$script\/$appprefix\_fastcgi.pl" );
    chmod 0700, "$script/$appprefix\_fastcgi.pl";
}

sub _mk_server {
    my $self      = shift;
    my $script    = $self->{script};
    my $appprefix = $self->{appprefix};
    $self->render_file( 'server.tt', "$script\/$appprefix\_server.pl" );
    chmod 0700, "$script/$appprefix\_server.pl";
}

sub _mk_test {
    my $self      = shift;
    my $script    = $self->{script};
    my $appprefix = $self->{appprefix};
    $self->render_file( 'test.tt', "$script/$appprefix\_test.pl" );
    chmod 0700, "$script/$appprefix\_test.pl";
}

sub _mk_create {
    my $self      = shift;
    my $script    = $self->{script};
    my $appprefix = $self->{appprefix};
    $self->render_file( 'create.tt', "$script\/$appprefix\_create.pl" );
    chmod 0700, "$script/$appprefix\_create.pl";
}

sub _mk_compclass {
    my $self = shift;
    my $file = $self->{file};
    return $self->render_file( 'compclass.tt', "$file" );
}

sub _mk_comptest {
    my $self = shift;
    my $test = $self->{test};
    $self->render_file( 'comptest.tt', "$test" );
}

sub _mk_images {
    my $self   = shift;
    my $images = $self->{images};
    my @images =
      qw/catalyst_logo btn_120x50_built btn_120x50_built_shadow
      btn_120x50_powered btn_120x50_powered_shadow btn_88x31_built
      btn_88x31_built_shadow btn_88x31_powered btn_88x31_powered_shadow/;
    for my $name (@images) {
        my $image = $self->get_file("$name.png");
        $self->mk_file( File::Spec->catfile( $images, "$name.png" ), $image );
    }
}

sub _mk_favicon {
    my $self    = shift;
    my $root    = $self->{root};
    my $favicon = $self->get_sharedir_file( 'root', 'favicon.ico' );
    my $dest = File::Spec->catfile( $root, "favicon.ico" );
    $self->mk_file( $dest, $favicon );

}

sub _deprecate_file {
    my ( $self, $file ) = @_;
    if ( -e $file ) {
        my $oldcontent;
        if ( my $f = IO::File->new("< $file") ) {
            $oldcontent = join( '', (<$f>) );
        }
        my $newfile = $file . '.deprecated';
        if ( my $f = IO::File->new("> $newfile") ) {
            binmode $f;
            print $f $oldcontent;
            print qq/created "$newfile"\n/;
            unlink $file;
            print qq/removed "$file"\n/;
            return 1;
        }
        Catalyst::Exception->throw(
            message => qq/Couldn't create "$file", "$!"/ );
    }
}

=head1 DESCRIPTION

This module is used by B<catalyst.pl> to create a set of scripts for a
new catalyst application. The scripts each contain documentation and
will output help on how to use them if called incorrectly or in some
cases, with no arguments.

It also provides some useful methods for a Helper module to call when
creating a component. See L</METHODS>.

=head1 SCRIPTS

=head2 _create.pl

Used to create new components for a catalyst application at the
development stage.

=head2 _server.pl

The catalyst test server, starts an HTTPD which outputs debugging to
the terminal.

=head2 _test.pl

A script for running tests from the command-line.

=head2 _cgi.pl

Run your application as a CGI.

=head2 _fastcgi.pl

Run the application as a fastcgi app. Either by hand, or call this
from FastCgiServer in your http server config.

=head1 HELPERS

The L</_create.pl> script creates application components using Helper
modules. The Catalyst team provides a good number of Helper modules
for you to use. You can also add your own.

Helpers are classes that provide two methods.

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

So when you call C<scripts/myapp_create.pl view MyView TT>, create
will 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::DBIC::Schema> for examples.

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

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

=head2 COMMON HELPERS

=over

=item *

L<Catalyst::Helper::Model::DBIC::Schema> - DBIx::Class models

=item *

L<Catalyst::Helper::View::TT> - Template Toolkit view

=item *

L<Catalyst::Helper::Model::LDAP>

=item *

L<Catalyst::Helper::Model::Adaptor> - wrap any class into a Catalyst model

=back

=head3 NOTE

The helpers will read author name from /etc/passwd by default. + To override, please export the AUTHOR variable.

=head1 METHODS

=head2 mk_compclass

This method in your Helper module is called with C<$helper>
which is a L<Catalyst::Helper> object, and whichever other arguments
the user added to the command-line. You can use the $helper to call methods
described below.

If the Helper module does not contain a C<mk_compclass> method, it
will fall back to calling L</render_file>, with an argument of
C<compclass>.

=head2 mk_comptest

This method in your Helper module is called with C<$helper>
which is a L<Catalyst::Helper> object, and whichever other arguments
the user added to the command-line. You can use the $helper to call methods
described below.

If the Helper module does not contain a C<mk_compclass> method, it
will fall back to calling L</render_file>, with an argument of
C<comptest>.

=head2 mk_stuff

This method is called if the user does not supply any of the usual
component types C<view>, C<controller>, C<model>. It is passed the
C<$helper> object (an instance of L<Catalyst::Helper>), and any other
arguments the user typed.

There is no fallback for this method.

=head1 INTERNAL METHODS

These are the methods that the Helper classes can call on the
<$helper> object passed to them.

=head2 render_file ($file, $path, $vars)

Render and create a file from a template in DATA using Template
Toolkit. $file is the relevent chunk of the __DATA__ section, $path is
the path to the file and $vars is the hashref as expected by
L<Template Toolkit|Template>.

=head2 get_file ($class, $file)

Fetch file contents from the DATA section. This is used internally by
L</render_file>.  $class is the name of the class to get the DATA
section from.  __PACKAGE__ or ( caller(0) )[0] might be sensible
values for this.

=head2 mk_app

Create the main application skeleton. This is called by L<catalyst.pl>.

=head2 mk_component ($app)

This method is called by L<create.pl> to make new components
for your application.

=head3 mk_dir ($path)

Surprisingly, this function makes a directory.

=head2 mk_file ($file, $content)

Writes content to a file. Called by L</render_file>.

=head2 next_test ($test_name)

Calculates the name of the next numbered test file and returns it.
Don't give the number or the .t suffix for the test name.

=head1 NOTE

The helpers will read author name from /etc/passwd by default.
To override, please export the AUTHOR variable.

=head1 SEE ALSO

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

=head1 AUTHORS

Catalyst Contributors, see Catalyst.pm

=head1 LICENSE

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

=begin pod_to_ignore

=cut

1;
Commit	Line	Data
68ccb5e5	1	package Catalyst::Helper;
	2
	3	use strict;
c93c671b	4	use warnings;
b8dea4e7	5	use base 'Class::Accessor::Fast';
68ccb5e5	6	use Config;
	7	use File::Spec;
	8	use File::Path;
68ccb5e5	9	use FindBin;
2415f774	10	use IO::File;
2415f774	11	use POSIX 'strftime';
68ccb5e5	12	use Template;
9ffb6b83	13	use Catalyst::Devel;
68ccb5e5	14	use Catalyst::Utils;
68ccb5e5	15	use Catalyst::Exception;
afd739f1	16	use Path::Class qw/dir file/;
afd739f1	17	use File::ShareDir qw/dist_dir/;
68ccb5e5	18
	19	my %cache;
	20
	21	=head1 NAME
	22
	23	Catalyst::Helper - Bootstrap a Catalyst application
	24
	25	=head1 SYNOPSIS
	26
fab70e0a	27	catalyst.pl <myappname>
68ccb5e5	28
	29	=cut
	30
afd739f1	31	sub get_sharedir_file {
	32	my ($self, @filename) = @_;
	33	my $file = file( dist_dir('Catalyst-Devel'), @filename);
	34	warn $file;
	35	my $contents = $file->slurp;
	36	return $contents;
	37	}
	38
68ccb5e5	39	sub get_file {
3c24e97e	40	my ( $self, $file ) = @_;
	41
	42	return $self->get_sharedir_file($file);
68ccb5e5	43	}
68ccb5e5	44
68ccb5e5	45	sub mk_app {
	46	my ( $self, $name ) = @_;
	47
	48	# Needs to be here for PAR
	49	require Catalyst;
	50
555cab18	51	if ( $name =~ /[^\w:]/ \|\| $name =~ /^\d/ \|\| $name =~ /\b:\b\|:{3,}/) {
68ccb5e5	52	warn "Error: Invalid application name.\n";
	53	return 0;
	54	}
902763f2	55	$self->{name } = $name;
	56	$self->{dir } = $name;
	57	$self->{dir } =~ s/\:\:/-/g;
	58	$self->{script } = File::Spec->catdir( $self->{dir}, 'script' );
	59	$self->{appprefix } = Catalyst::Utils::appprefix($name);
e9345225	60	$self->{appenv } = Catalyst::Utils::class2env($name);
675fef06	61	$self->{startperl } = -r '/usr/bin/env'
675fef06	62	? '#!/usr/bin/env perl'
9bc8b354	63	: "#!$Config{perlpath} -w";
9ffb6b83	64	$self->{scriptgen } = $Catalyst::Devel::CATALYST_SCRIPT_GEN \|\| 4;
902763f2	65	$self->{catalyst_version} = $Catalyst::VERSION;
902763f2	66	$self->{author } = $self->{author} = $ENV{'AUTHOR'}
68ccb5e5	67	\|\| eval { @{ [ getpwuid($<) ] }[6] }
	68	\|\| 'Catalyst developer';
	69
	70	my $gen_scripts = ( $self->{makefile} ) ? 0 : 1;
	71	my $gen_makefile = ( $self->{scripts} ) ? 0 : 1;
	72	my $gen_app = ( $self->{scripts} \|\| $self->{makefile} ) ? 0 : 1;
	73
	74	if ($gen_app) {
	75	$self->_mk_dirs;
	76	$self->_mk_config;
	77	$self->_mk_appclass;
	78	$self->_mk_rootclass;
	79	$self->_mk_readme;
	80	$self->_mk_changes;
	81	$self->_mk_apptest;
	82	$self->_mk_images;
	83	$self->_mk_favicon;
	84	}
	85	if ($gen_makefile) {
	86	$self->_mk_makefile;
	87	}
	88	if ($gen_scripts) {
	89	$self->_mk_cgi;
	90	$self->_mk_fastcgi;
	91	$self->_mk_server;
	92	$self->_mk_test;
	93	$self->_mk_create;
45d74601	94	$self->_mk_information;
68ccb5e5	95	}
	96	return $self->{dir};
	97	}
	98
68ccb5e5	99	sub mk_component {
	100	my $self = shift;
	101	my $app = shift;
	102	$self->{app} = $app;
	103	$self->{author} = $self->{author} = $ENV{'AUTHOR'}
	104	\|\| eval { @{ [ getpwuid($<) ] }[6] }
	105	\|\| 'A clever guy';
	106	$self->{base} \|\|= File::Spec->catdir( $FindBin::Bin, '..' );
	107	unless ( $_[0] =~ /^(?:model\|view\|controller)$/i ) {
	108	my $helper = shift;
	109	my @args = @_;
	110	my $class = "Catalyst::Helper::$helper";
	111	eval "require $class";
	112
	113	if ($@) {
	114	Catalyst::Exception->throw(
	115	message => qq/Couldn't load helper "$class", "$@"/ );
	116	}
	117
	118	if ( $class->can('mk_stuff') ) {
	119	return 1 unless $class->mk_stuff( $self, @args );
	120	}
	121	}
	122	else {
	123	my $type = shift;
	124	my $name = shift \|\| "Missing name for model/view/controller";
	125	my $helper = shift;
	126	my @args = @_;
fab70e0a	127	return 0 if $name =~ /[^\w\:]/;
68ccb5e5	128	$type = lc $type;
	129	$self->{long_type} = ucfirst $type;
	130	$type = 'M' if $type =~ /model/i;
	131	$type = 'V' if $type =~ /view/i;
	132	$type = 'C' if $type =~ /controller/i;
	133	my $appdir = File::Spec->catdir( split /\:\:/, $app );
	134	my $test_path =
	135	File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, 'C' );
	136	$type = $self->{long_type} unless -d $test_path;
	137	$self->{type} = $type;
	138	$self->{name} = $name;
	139	$self->{class} = "$app\::$type\::$name";
	140
	141	# Class
	142	my $path =
	143	File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type );
	144	my $file = $name;
	145	if ( $name =~ /\:/ ) {
	146	my @path = split /\:\:/, $name;
	147	$file = pop @path;
	148	$path = File::Spec->catdir( $path, @path );
	149	}
	150	$self->mk_dir($path);
	151	$file = File::Spec->catfile( $path, "$file.pm" );
	152	$self->{file} = $file;
	153
	154	# Test
	155	$self->{test_dir} = File::Spec->catdir( $FindBin::Bin, '..', 't' );
	156	$self->{test} = $self->next_test;
	157
	158	# Helper
	159	if ($helper) {
	160	my $comp = $self->{long_type};
	161	my $class = "Catalyst::Helper::$comp\::$helper";
	162	eval "require $class";
	163
	164	if ($@) {
	165	Catalyst::Exception->throw(
	166	message => qq/Couldn't load helper "$class", "$@"/ );
	167	}
	168
	169	if ( $class->can('mk_compclass') ) {
	170	return 1 unless $class->mk_compclass( $self, @args );
	171	}
	172	else { return 1 unless $self->_mk_compclass }
	173
	174	if ( $class->can('mk_comptest') ) {
	175	$class->mk_comptest( $self, @args );
	176	}
	177	else { $self->_mk_comptest }
	178	}
	179
	180	# Fallback
	181	else {
	182	return 1 unless $self->_mk_compclass;
	183	$self->_mk_comptest;
	184	}
	185	}
	186	return 1;
	187	}
	188
68ccb5e5	189	sub mk_dir {
	190	my ( $self, $dir ) = @_;
	191	if ( -d $dir ) {
	192	print qq/ exists "$dir"\n/;
	193	return 0;
	194	}
	195	if ( mkpath [$dir] ) {
	196	print qq/created "$dir"\n/;
	197	return 1;
	198	}
	199
	200	Catalyst::Exception->throw( message => qq/Couldn't create "$dir", "$!"/ );
	201	}
	202
68ccb5e5	203	sub mk_file {
	204	my ( $self, $file, $content ) = @_;
	205	if ( -e $file ) {
	206	print qq/ exists "$file"\n/;
	207	return 0
	208	unless ( $self->{'.newfiles'}
	209	\|\| $self->{scripts}
	210	\|\| $self->{makefile} );
	211	if ( $self->{'.newfiles'} ) {
	212	if ( my $f = IO::File->new("< $file") ) {
	213	my $oldcontent = join( '', (<$f>) );
	214	return 0 if $content eq $oldcontent;
	215	}
	216	$file .= '.new';
	217	}
	218	}
	219	if ( my $f = IO::File->new("> $file") ) {
	220	binmode $f;
	221	print $f $content;
	222	print qq/created "$file"\n/;
	223	return 1;
	224	}
	225
	226	Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ );
	227	}
	228
68ccb5e5	229	sub next_test {
	230	my ( $self, $tname ) = @_;
	231	if ($tname) { $tname = "$tname.t" }
	232	else {
	233	my $name = $self->{name};
	234	my $prefix = $name;
	235	$prefix =~ s/::/-/g;
	236	$prefix = $prefix;
	237	$tname = $prefix . '.t';
	238	$self->{prefix} = $prefix;
	239	$prefix = lc $prefix;
	240	$prefix =~ s/-/\//g;
	241	$self->{uri} = "/$prefix";
	242	}
	243	my $dir = $self->{test_dir};
	244	my $type = lc $self->{type};
	245	$self->mk_dir($dir);
	246	return File::Spec->catfile( $dir, "$type\_$tname" );
	247	}
	248
68ccb5e5	249	sub render_file {
	250	my ( $self, $file, $path, $vars ) = @_;
	251	$vars \|\|= {};
	252	my $t = Template->new;
3c24e97e	253	my $template = $self->get_sharedir_file( 'root', $file );
68ccb5e5	254	return 0 unless $template;
	255	my $output;
	256	$t->process( \$template, { %{$self}, %$vars }, \$output )
	257	\|\| Catalyst::Exception->throw(
	258	message => qq/Couldn't process "$file", / . $t->error() );
	259	$self->mk_file( $path, $output );
	260	}
	261
45d74601	262	sub _mk_information {
	263	my $self = shift;
	264	print qq/Change to application directory and Run "perl Makefile.PL" to make sure your install is complete\n/;
	265	}
	266
68ccb5e5	267	sub _mk_dirs {
	268	my $self = shift;
	269	$self->mk_dir( $self->{dir} );
	270	$self->mk_dir( $self->{script} );
	271	$self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
	272	$self->mk_dir( $self->{lib} );
	273	$self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
	274	$self->mk_dir( $self->{root} );
	275	$self->{static} = File::Spec->catdir( $self->{root}, 'static' );
	276	$self->mk_dir( $self->{static} );
	277	$self->{images} = File::Spec->catdir( $self->{static}, 'images' );
	278	$self->mk_dir( $self->{images} );
	279	$self->{t} = File::Spec->catdir( $self->{dir}, 't' );
	280	$self->mk_dir( $self->{t} );
	281
	282	$self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
	283	$self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
	284	$self->mk_dir( $self->{mod} );
	285
	286	if ( $self->{short} ) {
	287	$self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
	288	$self->mk_dir( $self->{m} );
	289	$self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
	290	$self->mk_dir( $self->{v} );
	291	$self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
	292	$self->mk_dir( $self->{c} );
	293	}
	294	else {
	295	$self->{m} = File::Spec->catdir( $self->{mod}, 'Model' );
	296	$self->mk_dir( $self->{m} );
	297	$self->{v} = File::Spec->catdir( $self->{mod}, 'View' );
	298	$self->mk_dir( $self->{v} );
	299	$self->{c} = File::Spec->catdir( $self->{mod}, 'Controller' );
	300	$self->mk_dir( $self->{c} );
	301	}
	302	my $name = $self->{name};
	303	$self->{rootname} =
	304	$self->{short} ? "$name\::C::Root" : "$name\::Controller::Root";
	305	$self->{base} = File::Spec->rel2abs( $self->{dir} );
	306	}
	307
	308	sub _mk_appclass {
	309	my $self = shift;
	310	my $mod = $self->{mod};
3c24e97e	311	$self->render_file( 'appclass.tt', "$mod.pm" );
68ccb5e5	312	}
	313
	314	sub _mk_rootclass {
	315	my $self = shift;
3c24e97e	316	$self->render_file( 'rootclass.tt',
68ccb5e5	317	File::Spec->catfile( $self->{c}, "Root.pm" ) );
	318	}
	319
	320	sub _mk_makefile {
	321	my $self = shift;
	322	$self->{path} = File::Spec->catfile( 'lib', split( '::', $self->{name} ) );
	323	$self->{path} .= '.pm';
	324	my $dir = $self->{dir};
3c24e97e	325	$self->render_file( 'makefile.tt', "$dir\/Makefile.PL" );
68ccb5e5	326
	327	if ( $self->{makefile} ) {
	328
	329	# deprecate the old Build.PL file when regenerating Makefile.PL
	330	$self->_deprecate_file(
	331	File::Spec->catdir( $self->{dir}, 'Build.PL' ) );
	332	}
	333	}
	334
	335	sub _mk_config {
	336	my $self = shift;
	337	my $dir = $self->{dir};
	338	my $appprefix = $self->{appprefix};
3c24e97e	339	$self->render_file( 'config.tt',
a4e6d745	340	File::Spec->catfile( $dir, "$appprefix.conf" ) );
68ccb5e5	341	}
	342
	343	sub _mk_readme {
	344	my $self = shift;
	345	my $dir = $self->{dir};
3c24e97e	346	$self->render_file( 'readme.tt', "$dir\/README" );
68ccb5e5	347	}
	348
	349	sub _mk_changes {
	350	my $self = shift;
	351	my $dir = $self->{dir};
5b1ec88b	352	my $time = strftime('%Y-%m-%d %H:%M:%S', localtime time);
3c24e97e	353	$self->render_file( 'changes.tt', "$dir\/Changes", { time => $time } );
68ccb5e5	354	}
	355
	356	sub _mk_apptest {
	357	my $self = shift;
	358	my $t = $self->{t};
3c24e97e	359	$self->render_file( 'apptest.tt', "$t\/01app.t" );
	360	$self->render_file( 'podtest.tt', "$t\/02pod.t" );
	361	$self->render_file( 'podcoveragetest.tt', "$t\/03podcoverage.t" );
68ccb5e5	362	}
	363
	364	sub _mk_cgi {
	365	my $self = shift;
	366	my $script = $self->{script};
	367	my $appprefix = $self->{appprefix};
3c24e97e	368	$self->render_file( 'cgi.tt', "$script\/$appprefix\_cgi.pl" );
68ccb5e5	369	chmod 0700, "$script/$appprefix\_cgi.pl";
	370	}
	371
	372	sub _mk_fastcgi {
	373	my $self = shift;
	374	my $script = $self->{script};
	375	my $appprefix = $self->{appprefix};
3c24e97e	376	$self->render_file( 'fastcgi.tt', "$script\/$appprefix\_fastcgi.pl" );
68ccb5e5	377	chmod 0700, "$script/$appprefix\_fastcgi.pl";
	378	}
	379
	380	sub _mk_server {
	381	my $self = shift;
	382	my $script = $self->{script};
	383	my $appprefix = $self->{appprefix};
3c24e97e	384	$self->render_file( 'server.tt', "$script\/$appprefix\_server.pl" );
68ccb5e5	385	chmod 0700, "$script/$appprefix\_server.pl";
	386	}
	387
	388	sub _mk_test {
	389	my $self = shift;
	390	my $script = $self->{script};
	391	my $appprefix = $self->{appprefix};
3c24e97e	392	$self->render_file( 'test.tt', "$script/$appprefix\_test.pl" );
68ccb5e5	393	chmod 0700, "$script/$appprefix\_test.pl";
	394	}
	395
	396	sub _mk_create {
	397	my $self = shift;
	398	my $script = $self->{script};
	399	my $appprefix = $self->{appprefix};
3c24e97e	400	$self->render_file( 'create.tt', "$script\/$appprefix\_create.pl" );
68ccb5e5	401	chmod 0700, "$script/$appprefix\_create.pl";
	402	}
	403
	404	sub _mk_compclass {
	405	my $self = shift;
	406	my $file = $self->{file};
3c24e97e	407	return $self->render_file( 'compclass.tt', "$file" );
68ccb5e5	408	}
	409
	410	sub _mk_comptest {
	411	my $self = shift;
	412	my $test = $self->{test};
3c24e97e	413	$self->render_file( 'comptest.tt', "$test" );
68ccb5e5	414	}
	415
	416	sub _mk_images {
	417	my $self = shift;
	418	my $images = $self->{images};
	419	my @images =
	420	qw/catalyst_logo btn_120x50_built btn_120x50_built_shadow
	421	btn_120x50_powered btn_120x50_powered_shadow btn_88x31_built
	422	btn_88x31_built_shadow btn_88x31_powered btn_88x31_powered_shadow/;
	423	for my $name (@images) {
3c24e97e	424	my $image = $self->get_file("$name.png");
68ccb5e5	425	$self->mk_file( File::Spec->catfile( $images, "$name.png" ), $image );
	426	}
	427	}
	428
	429	sub _mk_favicon {
	430	my $self = shift;
	431	my $root = $self->{root};
afd739f1	432	my $favicon = $self->get_sharedir_file( 'root', 'favicon.ico' );
	433	my $dest = File::Spec->catfile( $root, "favicon.ico" );
	434	$self->mk_file( $dest, $favicon );
68ccb5e5	435
	436	}
	437
	438	sub _deprecate_file {
	439	my ( $self, $file ) = @_;
	440	if ( -e $file ) {
	441	my $oldcontent;
	442	if ( my $f = IO::File->new("< $file") ) {
	443	$oldcontent = join( '', (<$f>) );
	444	}
	445	my $newfile = $file . '.deprecated';
	446	if ( my $f = IO::File->new("> $newfile") ) {
	447	binmode $f;
	448	print $f $oldcontent;
	449	print qq/created "$newfile"\n/;
	450	unlink $file;
	451	print qq/removed "$file"\n/;
	452	return 1;
	453	}
	454	Catalyst::Exception->throw(
	455	message => qq/Couldn't create "$file", "$!"/ );
	456	}
	457	}
	458
fab70e0a	459	=head1 DESCRIPTION
	460
	461	This module is used by B<catalyst.pl> to create a set of scripts for a
	462	new catalyst application. The scripts each contain documentation and
	463	will output help on how to use them if called incorrectly or in some
	464	cases, with no arguments.
	465
	466	It also provides some useful methods for a Helper module to call when
	467	creating a component. See L</METHODS>.
	468
	469	=head1 SCRIPTS
	470
	471	=head2 _create.pl
	472
	473	Used to create new components for a catalyst application at the
	474	development stage.
	475
	476	=head2 _server.pl
	477
	478	The catalyst test server, starts an HTTPD which outputs debugging to
	479	the terminal.
	480
	481	=head2 _test.pl
	482
	483	A script for running tests from the command-line.
	484
	485	=head2 _cgi.pl
	486
	487	Run your application as a CGI.
	488
	489	=head2 _fastcgi.pl
	490
	491	Run the application as a fastcgi app. Either by hand, or call this
	492	from FastCgiServer in your http server config.
	493
68ccb5e5	494	=head1 HELPERS
68ccb5e5	495
fab70e0a	496	The L</_create.pl> script creates application components using Helper
	497	modules. The Catalyst team provides a good number of Helper modules
	498	for you to use. You can also add your own.
	499
68ccb5e5	500	Helpers are classes that provide two methods.
	501
	502	* mk_compclass - creates the Component class
	503	* mk_comptest - creates the Component test
	504
fab70e0a	505	So when you call C<scripts/myapp_create.pl view MyView TT>, create
fab70e0a	506	will try to execute Catalyst::Helper::View::TT->mk_compclass and
68ccb5e5	507	Catalyst::Helper::View::TT->mk_comptest.
68ccb5e5	508
c4c50c2d	509	See L<Catalyst::Helper::View::TT> and
c4c50c2d	510	L<Catalyst::Helper::Model::DBIC::Schema> for examples.
68ccb5e5	511
	512	All helper classes should be under one of the following namespaces.
	513
	514	Catalyst::Helper::Model::
	515	Catalyst::Helper::View::
	516	Catalyst::Helper::Controller::
	517
675fef06	518	=head2 COMMON HELPERS
bc8d7994	519
	520	=over
	521
	522	=item *
	523
	524	L<Catalyst::Helper::Model::DBIC::Schema> - DBIx::Class models
	525
	526	=item *
	527
	528	L<Catalyst::Helper::View::TT> - Template Toolkit view
	529
	530	=item *
	531
	532	L<Catalyst::Helper::Model::LDAP>
	533
	534	=item *
	535
	536	L<Catalyst::Helper::Model::Adaptor> - wrap any class into a Catalyst model
	537
	538	=back
	539
	540	=head3 NOTE
	541
675fef06	542	The helpers will read author name from /etc/passwd by default. + To override, please export the AUTHOR variable.
bc8d7994	543
	544	=head1 METHODS
	545
fab70e0a	546	=head2 mk_compclass
	547
	548	This method in your Helper module is called with C<$helper>
	549	which is a L<Catalyst::Helper> object, and whichever other arguments
	550	the user added to the command-line. You can use the $helper to call methods
	551	described below.
	552
	553	If the Helper module does not contain a C<mk_compclass> method, it
	554	will fall back to calling L</render_file>, with an argument of
	555	C<compclass>.
	556
	557	=head2 mk_comptest
	558
	559	This method in your Helper module is called with C<$helper>
	560	which is a L<Catalyst::Helper> object, and whichever other arguments
	561	the user added to the command-line. You can use the $helper to call methods
	562	described below.
	563
	564	If the Helper module does not contain a C<mk_compclass> method, it
	565	will fall back to calling L</render_file>, with an argument of
	566	C<comptest>.
	567
	568	=head2 mk_stuff
	569
	570	This method is called if the user does not supply any of the usual
	571	component types C<view>, C<controller>, C<model>. It is passed the
	572	C<$helper> object (an instance of L<Catalyst::Helper>), and any other
	573	arguments the user typed.
	574
	575	There is no fallback for this method.
	576
bc8d7994	577	=head1 INTERNAL METHODS
fab70e0a	578
	579	These are the methods that the Helper classes can call on the
	580	<$helper> object passed to them.
	581
28eb1300	582	=head2 render_file ($file, $path, $vars)
fab70e0a	583
28eb1300	584	Render and create a file from a template in DATA using Template
	585	Toolkit. $file is the relevent chunk of the __DATA__ section, $path is
	586	the path to the file and $vars is the hashref as expected by
	587	L<Template Toolkit\|Template>.
fab70e0a	588
28eb1300	589	=head2 get_file ($class, $file)
fab70e0a	590
fab70e0a	591	Fetch file contents from the DATA section. This is used internally by
28eb1300	592	L</render_file>. $class is the name of the class to get the DATA
	593	section from. __PACKAGE__ or ( caller(0) )[0] might be sensible
	594	values for this.
fab70e0a	595
	596	=head2 mk_app
	597
	598	Create the main application skeleton. This is called by L<catalyst.pl>.
	599
28eb1300	600	=head2 mk_component ($app)
fab70e0a	601
	602	This method is called by L<create.pl> to make new components
	603	for your application.
	604
28eb1300	605	=head3 mk_dir ($path)
fab70e0a	606
	607	Surprisingly, this function makes a directory.
	608
28eb1300	609	=head2 mk_file ($file, $content)
fab70e0a	610
	611	Writes content to a file. Called by L</render_file>.
	612
28eb1300	613	=head2 next_test ($test_name)
fab70e0a	614
fab70e0a	615	Calculates the name of the next numbered test file and returns it.
28eb1300	616	Don't give the number or the .t suffix for the test name.
fab70e0a	617
68ccb5e5	618	=head1 NOTE
	619
	620	The helpers will read author name from /etc/passwd by default.
	621	To override, please export the AUTHOR variable.
	622
	623	=head1 SEE ALSO
	624
	625	L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
	626	L<Catalyst::Response>, L<Catalyst>
	627
f64c718c	628	=head1 AUTHORS
68ccb5e5	629
f64c718c	630	Catalyst Contributors, see Catalyst.pm
68ccb5e5	631
	632	=head1 LICENSE
	633
7cd3b67e	634	This library is free software. You can redistribute it and/or modify
68ccb5e5	635	it under the same terms as Perl itself.
68ccb5e5	636
64d4433e	637	=begin pod_to_ignore
64d4433e	638
68ccb5e5	639	=cut
	640
	641	1;
68ccb5e5	642