lib/Catalyst/Helper/ComponentGen.pm

   1 package Catalyst::Helper::ComponentGen;
   2
   3 use Moose;
   4 use Moose::Util::TypeConstraints;
   5 use MooseX::Types -declare [qw/ TestDir LongComponentType ValidComponentName /];
   6 use namespace::autoclean;
   7
   8 extends { 'Catalyst::Helper' };
   9
  10 # subtypes and coercions
  11 # validate test dir, component name
  12 # make the check in $self->{test_dir} be less fucking stupid
  13
  14 has 'test_dir' => (
  15     is => 'ro',
  16     isa => TestDir,
  17 );
  18
  19 has 'long_comp_type' => (
  20     is => 'ro',
  21     isa => LongComponentType,
  22     initializer => 'long_type',
  23 );
  24
  25 has 'component_name' => (
  26     is => 'ro',
  27     isa => ValidComponentName,
  28     initializer => 'comp_name',
  29 );
  30
  31 # Test
  32 $self->{test_dir} = File::Spec->catdir( $FindBin::Bin, '..', 't' );
  33 $self->{test}     = $self->next_test;
  34
  35 # Helper
  36 if ($helper) {
  37     my $comp  = $self->{long_type};
  38     my $class = "Catalyst::Helper::$comp\::$helper";
  39     eval "require $class";
  40
  41     if ($@) {
  42         Catalyst::Exception->throw(
  43             message => qq/Couldn't load helper "$class", "$@"/ );
  44     }
  45
  46     ## NO TOUCHY ###############################################################
  47     if ( $class->can('mk_compclass') ) {
  48         return 1 unless $class->mk_compclass( $self, @args );
  49     }
  50     else { return 1 unless $self->_mk_compclass }
  51
  52     if ( $class->can('mk_comptest') ) {
  53         $class->mk_comptest( $self, @args );
  54     }
  55     else { $self->_mk_comptest }
  56     ## END NO TOUCHY ###########################################################
  57 }
  58
  59 sub mk_component {
  60     my $self = shift;
  61     my $app  = shift;
  62     $self->{app} = $app;
  63     $self->{author} = $self->{author} = $ENV{'AUTHOR'}
  64       || eval { @{ [ getpwuid($<) ] }[6] }
  65       || 'A clever guy';
  66     $self->{base} ||= File::Spec->catdir( $FindBin::Bin, '..' );
  67     unless ( $_[0] =~ /^(?:model|view|controller)$/i ) {
  68         my $helper = shift;
  69         my @args   = @_;
  70         my $class  = "Catalyst::Helper::$helper";
  71         eval "require $class";
  72
  73         if ($@) {
  74             Catalyst::Exception->throw(
  75                 message => qq/Couldn't load helper "$class", "$@"/ );
  76         }
  77
  78         if ( $class->can('mk_stuff') ) {
  79             return 1 unless $class->mk_stuff( $self, @args );
  80         }
  81     }
  82     else {
  83         my $type   = shift;
  84         my $name   = shift || "Missing name for model/view/controller";
  85         my $helper = shift;
  86         my @args   = @_;
  87        return 0 if $name =~ /[^\w\:]/;
  88         $type              = lc $type;
  89         $self->{long_type} = ucfirst $type;
  90         $type              = 'M' if $type =~ /model/i;
  91         $type              = 'V' if $type =~ /view/i;
  92         $type              = 'C' if $type =~ /controller/i;
  93         my $appdir = File::Spec->catdir( split /\:\:/, $app );
  94         my $test_path =
  95           File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, 'C' );
  96         $type = $self->{long_type} unless -d $test_path;
  97         $self->{type}  = $type;
  98         $self->{name}  = $name;
  99         $self->{class} = "$app\::$type\::$name";
 100
 101         # Class
 102         my $path =
 103           File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type );
 104         my $file = $name;
 105         if ( $name =~ /\:/ ) {
 106             my @path = split /\:\:/, $name;
 107             $file = pop @path;
 108             $path = File::Spec->catdir( $path, @path );
 109         }
 110         $self->mk_dir($path);
 111         $file = File::Spec->catfile( $path, "$file.pm" );
 112         $self->{file} = $file;
 113
 114         # Fallback
 115         else {
 116             return 1 unless $self->_mk_compclass;
 117             $self->_mk_comptest;
 118         }
 119     }
 120     return 1;
 121 }
 122
 123 1;