File Coverage

lib/Hyper/Developer/Generator/Environment.pm

Criterion	Covered	Total	%
statement	12	12	100.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	16	16	100.0

package Hyper::Developer::Generator::Environment;

use strict;
use warnings;
use version; our $VERSION = qv('0.01');

use base qw(Hyper::Developer::Generator);
use Class::Std;
use File::Path ();

use Hyper::Functions;
use Hyper::Error;

sub create {
    my $self    = shift;
    my $arg_ref = shift;

    my $base_path = $self->get_base_path();
    my $namespace = $self->get_namespace();
    my $lc_path   = Hyper::Functions::class_to_path(lc $namespace);
    my $template  = $self->get_template();

    File::Path::mkpath([
            map {
                my $path = "$base_path/$_/$namespace";
                $self->verbose_message("creating path >$path<");
                $path;
            } qw(lib var etc t)
        ], 0, 0770
    );


    for my $dir ( qw(cgi-bin htdocs bin) ) {
        my $path = "$base_path/$dir/$lc_path";
        $self->verbose_message("creating path >$path<");
        File::Path::mkpath([$path], 0, 0770);
    }

    # Context.ini
    my $file = "$base_path/"
        . Hyper::Functions::get_path_for('config')
        . "/$namespace/Context.ini";
    if ( $self->get_force() || ! -e $file ) {
        $self->verbose_message("creating initial context >$file<");
        $template->process(
            "Generator/Environment/Context.ini.tpl",
            { this => $self },
            $file
        ) or throw($template->error());
    }
    else {
        print STDERR "won't create >$file< - file already exists. use param force to overwrite\n";
    }

    # index.pl
    $file = "$base_path/cgi-bin/$lc_path/index.pl";
    if ( $self->get_force() || ! -e $file ) {
        $self->verbose_message("creating default cgi script >$file<");
        $template->process(
            "Generator/Environment/index.pl.tpl",
            { this => $self },
            $file,
        ) or throw($template->error());
    }
    else {
        print STDERR "won't create >$file< - file already exists. use param force to overwrite\n";
    }

    # server.pl
    $file = "$base_path/bin/$lc_path/server.pl";
    if ( $self->get_force() || ! -e $file ) {
        $self->verbose_message("creating default server >$file<");
        $template->process(
            "Generator/Environment/server.pl.tpl",
            { this => $self },
            $file,
        ) or throw($template->error());
    }
    else {
        print STDERR "won't create >$file< - file already exists. use param force to overwrite\n";
    }


    return $self;
}

1;

__END__