view release on metacpan or  search on metacpan

lib/Catalyst/Helper.pm  view on Meta::CPAN

        }
    }

    if ( my $f = IO::File->new("> $file") ) {
        binmode $f;
        print $f $content;
        print qq/created "$file"\n/;
        return $file;
    }

    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( $dir, "$type\_$tname" );
}

# Do not touch this method, *EVER*, it is needed for back compat.
## addendum: we had to split this method so we could have backwards
## compatibility.  otherwise, we'd have no way to pass stuff from __DATA__

sub render_file {
    my ( $self, $file, $path, $vars, $perms ) = @_;
    my $template = $self->get_file( ( caller(0) )[0], $file );
    $self->render_file_contents($template, $path, $vars, $perms);
}

sub render_sharedir_file {
    my ( $self, $file, $path, $vars, $perms ) = @_;
    my $template = $self->get_sharedir_file( $file );
    die("Cannot get template from $file for $self\n") unless $template;
    $self->render_file_contents($template, $path, $vars, $perms);
}

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

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} = dir( $self->{dir}, 'lib' );
    $self->mk_dir( $self->{lib} );
    $self->{root} = dir( $self->{dir}, 'root' );
    $self->mk_dir( $self->{root} );
    $self->{static} = dir( $self->{root}, 'static' );
    $self->mk_dir( $self->{static} );
    $self->{images} = dir( $self->{static}, 'images' );
    $self->mk_dir( $self->{images} );
    $self->{t} = dir( $self->{dir}, 't' );
    $self->mk_dir( $self->{t} );

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

    if ( $self->{short} ) {
        $self->{m} = dir( $self->{mod}, 'M' );
        $self->mk_dir( $self->{m} );
        $self->{v} = dir( $self->{mod}, 'V' );
        $self->mk_dir( $self->{v} );
        $self->{c} = dir( $self->{mod}, 'C' );
        $self->mk_dir( $self->{c} );
    }
    else {
        $self->{m} = dir( $self->{mod}, 'Model' );
        $self->mk_dir( $self->{m} );
        $self->{v} = dir( $self->{mod}, 'View' );
        $self->mk_dir( $self->{v} );
        $self->{c} = dir( $self->{mod}, 'Controller' );
        $self->mk_dir( $self->{c} );
    }
    my $name = $self->{name};
    $self->{rootname} =
      $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root";
    $self->{base} = dir( $self->{dir} )->absolute;
}

sub _mk_appclass {
    my $self = shift;
    my $mod  = $self->{mod};
    $self->render_sharedir_file( file('lib', 'MyApp.pm.tt'), "$mod.pm" );
}

sub _mk_rootclass {
    my $self = shift;
    $self->render_sharedir_file( file('lib', 'MyApp', 'Controller', 'Root.pm.tt'),
        file( $self->{c}, "Root.pm" ) );
}