CGI-Application-Structured-Tools

 view release on metacpan or  search on metacpan

lib/CGI/Application/Structured/Tools/Starter.pm  view on Meta::CPAN

        };
        close $template_file or croak "couldn't close template: $_";
    }


    return %template;
}

=head2 create_MANIFEST_SKIP()

This method creates a C<MANIFEST.SKIP> file in the distribution's directory so 
that unneeded files can be skipped from inclusion in the distribution.
=cut

sub create_MANIFEST_SKIP {
    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';
}

=head2 create_perlcriticrc ()

This method creates a C<perlcriticrc> in the distribution's test directory so 
that the behavior of C<perl-critic.t> can be modified.

=cut

sub create_perlcriticrc {
    my $self = shift;

    my @dirparts = ( $self->{basedir}, 't' );
    my $tdir = File::Spec->catdir(@dirparts);
    if ( not -d $tdir ) {
        local @ARGV = $tdir;
        mkpath();
        $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';
}

=head2 create_server_pl ()

This method creates C<server.pl> in the distribution's root directory.

=cut

sub create_server_pl {
    my $self = shift;

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

    return 'server.pl';
}


=head2 create_debug_sh ()

This method creates C<debug.sh> in the distribution's root directory. Starts werver with environment set to display ::Plugin::DebugScreen on error

=cut

sub create_debug_sh {
    my $self = shift;

    my $fname = File::Spec->catfile( $self->{basedir}, 'debug.sh' );
    $self->create_file( $fname, $self->debug_sh_guts() );
    chmod 0755, ($fname);
    $self->progress("Created $fname");

    return 'debug.sh';
}

=head2 create_config_pl ()

This method creates C<config-test.pl> in the distribution's root/config directory.

=cut

sub create_config_pl {
    my $self = shift;

    #my $reldir = join q{/}, File::Spec->splitdir( $self->{templatedir} );

    my @dirparts = ( $self->{basedir}, "config" );
    my $tdir = File::Spec->catdir(@dirparts);

    if ( not -d $tdir ) {
        local @ARGV = $tdir;
        mkpath();
        $self->progress("Created $tdir");
    }

    my $fname = File::Spec->catfile( $tdir, 'config.pl' );
    $self->create_file( $fname, $self->config_pl_guts() );
    $self->progress("Created $fname");

    return 'config.pl';
}

=head2 create_create_pl ()

This method creates C<create_controller.pl> in the distribution's app/script directory.

=cut

sub create_create_pl {
    my $self = shift;

    my @dirparts = ( $self->{basedir}, "script" );
    my $tdir = File::Spec->catdir(@dirparts);

    if ( not -d $tdir ) {
        local @ARGV = $tdir;
        mkpath();
        $self->progress("Created $tdir");
    }

    # template needs template_path not just template dir
    $self->{template_path} = File::Spec->rel2abs( $self->{templatedir} );

    # Store template directory
    my $fname = File::Spec->catfile( $tdir, 'create_controller.pl' );
    $self->create_file( $fname, $self->create_pl_guts() );
    chmod 0755, ($fname);
    $self->progress("Created $fname");

    return 'script/create_controller.pl';
}

=head2 create_tmpl ()

This method takes all the template files ending in .tmpl (representing 
L<HTML::Template>'s and installs them into a directory under the distro tree.  
For instance if the distro was called C<Foo-Bar>, the templates would be 
installed in C<Foo-Bar/templates>.

Note the files will just be copied over not rendered.

=cut

sub create_tmpl {
    my $self = shift;

    return $self->tmpl_guts();
}

=head2 create_submodule ()

Implements a default "Home" subclass of the main module.  This module will be auto configured as the default module in the Dispatch subclass.

=cut
sub create_submodule {
    my $self = shift;

    my @distroparts = @{ $self->{distroparts} };

    my @dirparts = ( $self->{basedir}, 'lib', @distroparts, "C" );
    my $tdir = File::Spec->catdir(@dirparts);
    if ( not -d $tdir ) {
        local @ARGV = $tdir;
        mkpath();
        $self->progress("Created $tdir");
    }
    my $fname =
      File::Spec->catfile( $self->{basedir}, 'lib', @distroparts, "C",
        "Home.pm" );
    $self->create_file( $fname, $self->submodule_guts() );
    $self->progress("Created $fname");

    return $fname;
}


=head2 create_submodule ()

Implements a default controller baseclass (main module).  

=cut
sub create_mainmodule {
    my $self = shift;

    my @distroparts = @{ $self->{distroparts} };

    # 
    # For multi level main packages, separate out the path parts
    # from the main module file name part.
    #
    my $last_inx = $#distroparts - 1;
    my @distro_dirparts = @distroparts > 1? @distroparts[0..$last_inx]: ();
    my $distro_namepart = $distroparts[-1] . '.pm';

    my @dirparts = ( $self->{basedir}, 'lib', @distro_dirparts);
    my $tdir = File::Spec->catdir(@dirparts);
    if ( not -d $tdir ) {
        local @ARGV = $tdir;
        mkpath();
        $self->progress("Created $tdir");
    }
  
    
   
    my $fname =
      File::Spec->catfile( $self->{basedir}, 'lib',  @distro_dirparts, $distro_namepart );

    # need to delete the module starter default file for this customization
    if (-f $fname){unlink $fname;}

    $self->create_file( $fname, $self->mainmodule_guts() );
    $self->progress("Created $fname");

    return $fname;
}


=head2 create_dbic_pl ()

This method creates C<create_dbic_schema.pl> in the distribution's root/script/ directory.

=cut

sub create_create_dbic_pl {
    my $self = shift;

    # template needs path ucd nder lib to main module
    $self->{distrodir} = File::Spec->catdir( @{ $self->{distroparts} } );

    # Create the script directory if it is not there already

    my @dirparts = ( $self->{basedir}, "script" );
    my $tdir = File::Spec->catdir(@dirparts);

    if ( not -d $tdir ) {
        local @ARGV = $tdir;
        mkpath();
        $self->progress("Created $tdir");
    }

    # create the user script
    my $fname = File::Spec->catfile( $tdir, 'create_dbic_schema.pl' );
    $self->create_file( $fname, $self->create_create_dbic_guts() );
    chmod 0755, ($fname);
    $self->progress("Created $fname");

    return 'script/create_dbic_schema.pl';
}


=head2 create_dispatch ()

Implements a L<CGI::Application::Dispatch> subclass for this app in the lib directory under the main modules directory.

=cut

sub create_dispatch {
    my $self = shift;

    my @distroparts = split /::/, $self->{main_module};
    my @dirparts = ( $self->{basedir}, 'lib', @distroparts );
    my $tdir = File::Spec->catdir(@dirparts);

    if ( not -d $tdir ) {
        local @ARGV = $tdir;
        mkpath();
        $self->progress("Created $tdir");
    }
    my $fname =
      File::Spec->catfile( $self->{basedir}, 'lib', @distroparts,
        "Dispatch.pm" );
    $self->create_file( $fname, $self->dispatch_guts() );
    $self->progress("Created $fname");

    return $fname;

}



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

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


sub dispatch_guts {
    my $self = shift;
    my %options;
    $self->{config_file} =
      File::Spec->catfile( $self->{basedir}, "config", "config.pl" );

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

sub submodule_guts {
    my $self = shift;
    my %options;
    $self->{sub_module} = "C::Home";
    my $template = $self->{templates}{'submodule.pm'};



( run in 1.299 second using v1.01-cache-2.11-cpan-5b529ec07f3 )