view release on metacpan or  search on metacpan

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

# 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};
    Carp::confess("Could not get data from __DATA__ segment for $class")
        unless $data;
    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 eq '.') {
        if(!-e 'META.yml') {
            system perl => 'Makefile.PL'
                and Catalyst::Exception->throw(message => q(
                    Failed to run "perl Makefile.PL".
                ));
        }

        $name = YAML::Tiny->read('META.yml')->[0]->{'name'};
        $name =~ s/-/::/g;
        $self->{dir} = '.';
    }

    if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) {
        warn "Error: Invalid application name.\n";
        return 0;
    }


    if(!defined $self->{'dir'}) {
        $self->{dir} = $name;
        $self->{dir} =~ s/\:\:/-/g;
    }

    $self->{name            } = $name;
    $self->{script          } = dir( $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}";
    $self->{scriptgen       } = $Catalyst::Devel::CATALYST_SCRIPT_GEN;
    $self->{catalyst_version} = $Catalyst::VERSION;
    $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) {
        for ( qw/ _mk_dirs _mk_config _mk_psgi _mk_appclass _mk_rootclass
              _mk_readme _mk_changes _mk_apptest _mk_podtest _mk_podcoveragetest
              _mk_images _mk_favicon/ ) {
            $self->$_;
        }
    }
    if ($gen_makefile) {
        $self->_mk_makefile;
    }
    if ($gen_scripts) {
        for ( qw/ _mk_cgi _mk_fastcgi _mk_server
                  _mk_test _mk_create _mk_information
        / ) {
              $self->$_;
        }
    }
    return $self->{dir};
}

## not much of this can really be changed, mk_compclass must be left for
## backcompat
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} ||= dir( $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 = dir( split /\:\:/, $app );
        my $test_path =
          dir( $self->{base}, '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 =
          dir( $self->{base}, 'lib', $appdir, $type );
        my $file = $name;
        if ( $name =~ /\:/ ) {
            my @path = split /\:\:/, $name;
            $file = pop @path;
            $path = dir( $path, @path );
        }
        $self->mk_dir($path);
        $file = file( $path, "$file.pm" );
        $self->{file} = $file;

        # Test
        $self->{test_dir} = dir( $self->{base}, 't' );
        $self->{test}     = $self->next_test;

        # Helper
        if ($helper) {
            my $comp  = $self->{long_type};
            my $class = "Catalyst::Helper::$comp\::$helper";
            eval "require $class";

            if ($@) {