[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/;
use Moose;
use aliased 'Path::Class::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 $dist_dir;
    if (-d "inc/.author") { # Can't use sharedir if we're in a checkout
                            # this feels horrible, better ideas?
        $dist_dir = 'share';
    }
    else {
        $dist_dir = dist_dir('Catalyst-Devel');
    }
    my $file = file( $dist_dir, @filename);
    my $contents = $file->slurp;
    return $contents;
}

# Do not touch this method, *EVER*, it is needed for back compat.
sub get_file {
    my ( $self, $class, $file ) = @_;
    unless ( $cache{$class} ) {
        local $/;
        $cache{$class} = eval "package $class; <DATA>";
    }
    my $data = $cache{$class};
    my @files = split /^__(.+)__\r?\n/m, $data;
    shift @files;
    while (@files) {
        my ( $name, $content ) = splice @files, 0, 2;
        return $content if $name eq $file;
    }
    return 0;
}


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

# Do not touch this method, *EVER*, it is needed for back compat.

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_sharedir_file("root", "$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", "$!"/ );
    }
}


## this is so you don't have to do make install after every change to test
sub _find_share_dir {
  my ($self, $args) = @_;
  my $share_name = $self->name;
  if ($share_name =~ s!^/(.*?)/!!) {
    my $dist = $1;
    $args->{share_base_dir} = eval {
        Dir->new(File::ShareDir::dist_dir($dist))
           ->subdir('share');
    };
    if ($@) {
        # not installed
        my $file = __FILE__;
        my $dir = Dir->new(dirname($file));
        my $share_base;
        while ($dir->parent) {
            if (-d $dir->subdir('share') && -d $dir->subdir('share')->subdir('root')) {
                $share_base = $dir->subdir('share')->subdir('root');
                last;
            }
            $dir = $dir->parent;
        }
        confess "could not find sharebase by recursion. ended up at $dir, from $file"
          unless $share_base;
        $args->{share_base_dir} = $share_base; 
    }
  }
  my $base = $args->{share_base_dir}->subdir($share_name);
  confess "No such share base directory ${base}"
    unless -d $base;
  $self->share_dir($base);
};


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