Module::Starter::Plugin::CGIApp - template based module starter for CGI apps.

    use Module::Starter qw(
        Module::Starter::Simple
        Module::Starter::Plugin::Template
        Module::Starter::Plugin::CGIApp
    );

    Module::Starter->create_distro(%args);

    $data = ['a'. 'b', 'c'];

    $data = [
        { data_item => 'a' },
        { data_item => 'b' },
        { data_item => 'c' },
    ];

    <tmpl_loop data>
        <tmpl_var data_item>
    </tmpl_loop>

package Module::Starter::Plugin::CGIApp;

use warnings;
use strict;
use Carp qw( croak );
use English qw( -no_match_vars );
use File::Basename;
use File::Path qw( mkpath );
use File::Spec ();
use Module::Starter::BuilderSet;
use Module::Starter::Simple;
use HTML::Template;

our $VERSION = '0.30';

sub new {
    my ( $class, @opts ) = @_;
    my $self = $class->SUPER::new(@opts);

    $self->{templates} = { $self->templates };
    $self->{renderer}  = $self->renderer;
    return bless $self => $class;
}

sub create_distro {
    my ( $class, @opts ) = @_;

    my $self = $class->new(@opts);

    # Supposedly the *-starter scripts can handle multiple --builder options
    # but this doesn't work (and IMO doesn't make sense anyway.) So in the
    # case multiple builders were specified, we just pick the first one.
    if ( ref $self->{builder} eq 'ARRAY' ) {
        $self->{builder} = $self->{builder}->[0];
    }

    my @modules;
    foreach my $arg ( @{ $self->{modules} } ) {
        push @modules, ( split /[,]/msx, $arg );
    }
    if ( !@modules ) {
        croak "No modules specified.\n";
    }
    for (@modules) {
        if ( !/\A [[:alpha:]_] \w* (?: [:] [:] [\w]+ )* \Z /imsx ) {
            croak "Invalid module name: $_";
        }
    }
    $self->{modules} = \@modules;

    if ( !$self->{author} ) {
        croak "Must specify an author\n";
    }
    if ( !$self->{email} ) {
        croak "Must specify an email address\n";
    }
    ( $self->{email_obfuscated} = $self->{email} ) =~ s/@/ at /msx;

    $self->{license} ||= 'perl';

    $self->{main_module} = $self->{modules}->[0];
    if ( !$self->{distro} ) {
        $self->{distro} = $self->{main_module};
        $self->{distro} =~ s/::/-/gmsx;
    }

    $self->{basedir} = $self->{dir} || $self->{distro};
    $self->create_basedir;

    my @distroparts = split /-/msx, $self->{distro};
    $self->{templatedir} = join q{/}, ( 'lib', @distroparts, 'templates' );

    my @files;
    push @files, $self->create_modules( @{ $self->{modules} } );

    push @files, $self->create_t( @{ $self->{modules} } );
    push @files, $self->create_tmpl();
    my %build_results = $self->create_build();
    push @files, @{ $build_results{files} };

    push @files, $self->create_Changes;
    push @files, $self->create_LICENSE;
    push @files, $self->create_README( $build_results{instructions} );
    push @files, $self->create_MANIFEST_SKIP;
    push @files, $self->create_perlcriticrc;
    push @files, $self->create_server_pl;
    push @files, 'MANIFEST';
    $self->create_MANIFEST( grep { $_ ne 't/boilerplate.t' } @files );

    return;
}

sub create_LICENSE {    ## no critic 'NamingConventions::Capitalization'
    my $self = shift;

    my $fname = File::Spec->catfile( $self->{basedir}, 'LICENSE' );
    $self->create_file( $fname, $self->LICENSE_guts() );
    $self->progress("Created $fname");

    return 'LICENSE';
}

sub create_MANIFEST_SKIP {    ## no critic 'NamingConventions::Capitalization'
    my $self = shift;

    my $fname = File::Spec->catfile( $self->{basedir}, 'MANIFEST.SKIP' );
    $self->create_file( $fname, $self->MANIFEST_SKIP_guts() );
    $self->progress("Created $fname");

    return 'MANIFEST.SKIP';
}

sub create_modules {
    my ( $self, @modules ) = @_;

    my @files;

    my $rtname = lc $self->{distro};
    for my $module (@modules) {
        push @files, $self->_create_module( $module, $rtname );
    }

    return @files;
}

sub create_perlcriticrc {
    my $self = shift;

    my @dirparts = ( $self->{basedir}, 't' );
    my $tdir = File::Spec->catdir(@dirparts);
    if ( not -d $tdir ) {
        mkpath($tdir);
        $self->progress("Created $tdir");
    }

    my $fname = File::Spec->catfile( @dirparts, 'perlcriticrc' );
    $self->create_file( $fname, $self->perlcriticrc_guts() );
    $self->progress("Created $fname");

    return 't/perlcriticrc';
}

sub create_server_pl {
    my $self = shift;

    my $fname = File::Spec->catfile( $self->{basedir}, 'server.pl' );
    $self->create_file( $fname, $self->server_pl_guts() );
    $self->progress("Created $fname");

    return 'server.pl';
}

sub create_t {
    my ( $self, @modules ) = @_;

    my %t_files = $self->t_guts(@modules);

    my @files = map { $self->_create_t( $_, $t_files{$_} ) } keys %t_files;

    # This next part is for the static files dir t/www
    my @dirparts = ( $self->{basedir}, 't', 'www' );
    my $twdir = File::Spec->catdir(@dirparts);
    if ( not -d $twdir ) {
        mkpath($twdir);
        $self->progress("Created $twdir");
    }
    my $placeholder =
      File::Spec->catfile( @dirparts, 'PUT.STATIC.CONTENT.HERE' );
    $self->create_file( $placeholder, q{ } );
    $self->progress("Created $placeholder");
    push @files, 't/www/PUT.STATIC.CONTENT.HERE';

    return @files;
}

sub create_tmpl {
    my $self = shift;

    return $self->tmpl_guts();
}

sub render {
    my ( $self, $template, $options ) = @_;

    # we need a local copy of $options otherwise we get recursion in loops
    # because of [1]
    my %opts = %{$options};

    $opts{nummodules}    = scalar @{ $self->{modules} };
    $opts{year}          = $self->_thisyear();
    $opts{license_blurb} = $self->_license_blurb();
    $opts{datetime}      = scalar localtime;
    $opts{buildscript} =
      Module::Starter::BuilderSet->new()->file_for_builder( $self->{builder} );

    foreach my $key ( keys %{$self} ) {
        next if defined $opts{$key};
        $opts{$key} = $self->{$key};
    }

    # [1] HTML::Templates wants loops to be arrays of hashes not plain arrays
    foreach my $key ( keys %opts ) {
        if ( ref $opts{$key} eq 'ARRAY' ) {
            my @temp = ();
            for my $option ( @{ $opts{$key} } ) {
                push @temp, { "${key}_item" => $option };
            }
            $opts{$key} = [@temp];
        }
    }
    my $t = HTML::Template->new(
        die_on_bad_params => 0,
        scalarref         => \$template,
    ) or croak "Can't create template $template";
    $t->param( \%opts );
    return $t->output;
}

sub renderer {
    my ($self) = @_;
    return;
}

sub templates {
    my ($self) = @_;
    my %template;

    my $template_dir = ( $ENV{MODULE_TEMPLATE_DIR} || $self->{template_dir} )
      or croak 'template dir not defined';
    if ( !-d $template_dir ) {
        croak "template dir does not exist: $template_dir";
    }

    foreach ( glob "$template_dir/*" ) {
        my $basename = basename $_;
        next if ( not -f $_ ) or ( $basename =~ /\A [.]/msx );
        open my $template_file, '<', $_
          or croak "couldn't open template: $_";
        $template{$basename} = do {
            local $RS = undef;
            <$template_file>;
        };
        close $template_file or croak "couldn't close template: $_";
    }

    return %template;
}

sub Changes_guts {    ## no critic 'NamingConventions::Capitalization'
    my $self = shift;
    my %options;

    my $template = $self->{templates}{Changes};
    return $self->render( $template, \%options );
}

sub LICENSE_guts {    ## no critic 'NamingConventions::Capitalization'
    my $self = shift;
    my %options;

    my $template = $self->{templates}{LICENSE};
    return $self->render( $template, \%options );
}

sub _license_blurb {
    my $self = shift;
    my $license_blurb;

    if ( $self->{license} eq 'perl' ) {
        $license_blurb = <<'EOT';
This distribution is free software; you can redistribute it and/or modify it
under the terms of either:

a) the GNU General Public License as published by the Free Software
Foundation; either version 2, or (at your option) any later version, or

b) the Artistic License version 2.0.
EOT
    }
    else {
        $license_blurb = <<"EOT";
This program is released under the following license: $self->{license}
EOT
    }
    chomp $license_blurb;
    return $license_blurb;
}

sub MANIFEST_SKIP_guts {    ## no critic 'NamingConventions::Capitalization'
    my $self = shift;
    my %options;

    my $template = $self->{templates}{'MANIFEST.SKIP'};
    return $self->render( $template, \%options );
}

sub perlcriticrc_guts {
    my $self = shift;
    my %options;

    my $template = $self->{templates}{perlcriticrc};
    return $self->render( $template, \%options );
}

sub server_pl_guts {
    my $self = shift;
    my %options;
    $options{main_module} = $self->{main_module};

    my $template = $self->{templates}{'server.pl'};
    return $self->render( $template, \%options );
}

sub t_guts {
    my ( $self, @opts ) = @_;
    my %options;
    $options{modules}     = [@opts];
    $options{modulenames} = [];
    foreach ( @{ $options{modules} } ) {
        push @{ $options{module_pm_files} }, $self->_module_to_pm_file($_);
    }

    my %t_files;

    foreach ( grep { /[.]t\z/msx } keys %{ $self->{templates} } ) {
        my $template = $self->{templates}{$_};
        $t_files{$_} = $self->render( $template, \%options );
    }

    return %t_files;
}

sub tmpl_guts {
    my ($self) = @_;
    my %options;    # unused in this function.

    # we need the directory seperator to be / regardless of OS
    my $reldir = join q{/}, File::Spec->splitdir( $self->{templatedir} );
    my @dirparts = ( $self->{basedir}, $self->{templatedir} );
    my $tdir = File::Spec->catdir(@dirparts);
    if ( not -d $tdir ) {
        mkpath($tdir);
        $self->progress("Created $tdir");
    }

    my @t_files;
    foreach
      my $filename ( grep { /[.]html \z/msx } keys %{ $self->{templates} } )
    {
        my $template = $self->{templates}{$filename};
        my $fname = File::Spec->catfile( @dirparts, $filename );
        $self->create_file( $fname, $template );
        $self->progress("Created $fname");
        push @t_files, "$reldir/$filename";
    }

    return @t_files;
}

1;